*** empty log message ***
[gnus] / lisp / gnus-art.el
index cec51c0..e99e8c4 100644 (file)
@@ -33,6 +33,9 @@
 (require 'gnus-spec)
 (require 'gnus-int)
 (require 'browse-url)
+(require 'mm-bodies)
+(require 'drums)
+(require 'mm-decode)
 
 (defgroup gnus-article nil
   "Article display."
@@ -272,7 +275,6 @@ be fed to `format-time-string'."
   :group 'gnus-article-washing)
 
 (eval-and-compile
-  (autoload 'timezone-make-date-arpa-standard "timezone")
   (autoload 'mail-extract-address-components "mail-extr"))
 
 (defcustom gnus-save-all-headers t
@@ -374,23 +376,6 @@ be used as possible file names."
                         (cons :value ("" "") regexp (repeat string))
                         (sexp :value nil))))
 
-(defcustom gnus-strict-mime t
-  "*If nil, MIME-decode even if there is no Mime-Version header."
-  :group 'gnus-article-mime
-  :type 'boolean)
-
-(defcustom gnus-show-mime-method 'metamail-buffer
-  "Function to process a MIME message.
-The function is called from the article buffer."
-  :group 'gnus-article-mime
-  :type 'function)
-
-(defcustom gnus-decode-encoded-word-method 'gnus-article-de-quoted-unreadable
-  "*Function to decode MIME encoded words.
-The function is called from the article buffer."
-  :group 'gnus-article-mime
-  :type 'function)
-
 (defcustom gnus-page-delimiter "^\^L"
   "*Regexp describing what to use as article page delimiters.
 The default value is \"^\^L\", which is a form linefeed at the
@@ -398,7 +383,7 @@ beginning of a line."
   :type 'regexp
   :group 'gnus-article-various)
 
-(defcustom gnus-article-mode-line-format "Gnus: %%b %S"
+(defcustom gnus-article-mode-line-format "Gnus: %g %S"
   "*The format specification for the article mode line.
 See `gnus-summary-mode-line-format' for a closer description."
   :type 'string
@@ -545,8 +530,20 @@ displayed by the first non-nil matching CONTENT face."
                               (item :tag "skip" nil)
                               (face :value default)))))
 
+(defcustom gnus-article-decode-hook
+  '(article-decode-charset article-decode-rfc1522)
+  "*Hook run to decode charsets in articles."
+  :group 'gnus-article-headers
+  :type 'hook)
+
+(defcustom gnus-display-mime-function 'gnus-display-mime
+  "Function to display MIME articles."
+  :group 'gnus-article-headers
+  :type 'function)
+
 ;;; Internal variables
 
+(defvar gnus-article-mime-handles nil)
 (defvar article-lapsed-timer nil)
 (defvar gnus-article-current-summary nil)
 
@@ -768,7 +765,7 @@ always hide."
             ((eq elem 'date)
              (let ((date (message-fetch-field "date")))
                (when (and date
-                          (< (gnus-days-between (current-time-string) date)
+                          (< (days-between (current-time-string) date)
                              4))
                  (gnus-article-hide-header "date"))))
             ((eq elem 'long-to)
@@ -806,7 +803,7 @@ always hide."
 (defun article-treat-dumbquotes ()
   "Translate M******** sm*rtq**t*s into proper text."
   (interactive)
-  (article-translate-characters "\221\222\223\223" "`'\"\""))
+  (article-translate-characters "\221\222\223\224" "`'\"\""))
 
 (defun article-translate-characters (from to)
   "Translate all characters in the body of the article according to FROM and TO.
@@ -890,7 +887,9 @@ characters to translate to."
        (point)
        (progn
         (while (and (not (bobp))
-                    (looking-at "^[ \t]*$"))
+                    (looking-at "^[ \t]*$")
+                    (not (gnus-annotation-in-region-p
+                          (point) (gnus-point-at-eol))))
           (forward-line -1))
         (forward-line 1)
         (point))))))
@@ -945,14 +944,43 @@ characters to translate to."
                  (process-send-region "article-x-face" beg end)
                  (process-send-eof "article-x-face"))))))))))
 
-(defun gnus-article-decode-mime-words ()
+(defun article-decode-mime-words ()
   "Decode all MIME-encoded words in the article."
   (interactive)
   (save-excursion
     (set-buffer gnus-article-buffer)
     (let ((inhibit-point-motion-hooks t)
          buffer-read-only)
-      (mm-decode-words-region (point-min) (point-max)))))
+      (rfc2047-decode-region (point-min) (point-max)))))
+
+(defun article-decode-charset (&optional prompt)
+  "Decode charset-encoded text in the article.
+If PROMPT (the prefix), prompt for a coding system to use."
+  (interactive "P")
+  (save-excursion
+    (save-restriction
+      (message-narrow-to-head)
+      (let* ((inhibit-point-motion-hooks t)
+            (ct (message-fetch-field "Content-Type" t))
+            (cte (message-fetch-field "Content-Transfer-Encoding" t))
+            (ctl (and ct (drums-parse-content-type ct)))
+            (charset (cond
+                      (prompt
+                       (mm-read-coding-system "Charset to decode: "))
+                      (ct
+                       (drums-content-type-get ctl 'charset))
+                      (gnus-newsgroup-name
+                       (gnus-group-find-parameter
+                        gnus-newsgroup-name 'charset))))
+            buffer-read-only)
+       (goto-char (point-max))
+       (widen)
+       (narrow-to-region (point) (point-max))
+       (when (or (not ct)
+                 (equal (car ctl) "text/plain"))
+         (mm-decode-body
+          charset (and cte (intern (downcase
+                                    (gnus-strip-whitespace cte))))))))))
 
 (defalias 'gnus-decode-rfc1522 'article-decode-rfc1522)
 (defalias 'gnus-article-decode-rfc1522 'article-decode-rfc1522)
@@ -962,7 +990,7 @@ characters to translate to."
        (buffer-read-only nil))
     (save-restriction
       (message-narrow-to-head)
-      (mm-decode-words-region (point-min) (point-max)))))
+      (rfc2047-decode-region (point-min) (point-max)))))
 
 (defun article-de-quoted-unreadable (&optional force)
   "Translate a quoted-printable-encoded article.
@@ -972,7 +1000,7 @@ or not."
   (save-excursion
     (let ((buffer-read-only nil)
          (type (gnus-fetch-field "content-transfer-encoding")))
-      (gnus-article-decode-rfc1522)
+      ;;(gnus-article-decode-rfc1522)
       (when (or force
                (and type (string-match "quoted-printable" (downcase type))))
        (goto-char (point-min))
@@ -1086,7 +1114,9 @@ always hide."
       (goto-char (point-min))
       (search-forward "\n\n" nil t)
       (while (re-search-forward "\n\n\n+" nil t)
-       (replace-match "\n\n" t t)))))
+       (unless (gnus-annotation-in-region-p
+                (match-beginning 0) (match-end 0))
+         (replace-match "\n\n" t t))))))
 
 (defun article-strip-leading-space ()
   "Remove all white space from the beginning of the lines in the article."
@@ -1311,103 +1341,83 @@ how much time has lapsed since DATE."
 
 (defun article-make-date-line (date type)
   "Return a DATE line of TYPE."
-  (cond
-   ;; Convert to the local timezone.  We have to slap a
-   ;; `condition-case' round the calls to the timezone
-   ;; functions since they aren't particularly resistant to
-   ;; buggy dates.
-   ((eq type 'local)
-    (concat "Date: " (condition-case ()
-                        (timezone-make-date-arpa-standard date)
-                      (error date))))
-   ;; Convert to Universal Time.
-   ((eq type 'ut)
-    (concat "Date: "
-           (condition-case ()
-               (timezone-make-date-arpa-standard date nil "UT")
-             (error date))))
-   ;; Get the original date from the article.
-   ((eq type 'original)
-    (concat "Date: " date))
-   ;; Let the user define the format.
-   ((eq type 'user)
-    (if (gnus-functionp gnus-article-time-format)
-       (funcall
-        gnus-article-time-format
-        (ignore-errors
-          (gnus-encode-date
-           (timezone-make-date-arpa-standard
-            date nil "UT"))))
+  (let ((time (condition-case ()
+                 (date-to-time date)
+               (error '(0 0)))))
+    (cond
+     ;; Convert to the local timezone.  We have to slap a
+     ;; `condition-case' round the calls to the timezone
+     ;; functions since they aren't particularly resistant to
+     ;; buggy dates.
+     ((eq type 'local)
+      (concat "Date: " (current-time-string time)))
+     ;; Convert to Universal Time.
+     ((eq type 'ut)
+      (concat "Date: "
+             (current-time-string
+              (let ((e (parse-time-string date)))
+                (setcar (last e) 0)
+                (apply 'encode-time e)))))
+     ;; Get the original date from the article.
+     ((eq type 'original)
+      (concat "Date: " date))
+     ;; Let the user define the format.
+     ((eq type 'user)
+      (if (gnus-functionp gnus-article-time-format)
+         (funcall gnus-article-time-format time)
+       (concat
+        "Date: "
+        (format-time-string gnus-article-time-format time))))
+     ;; ISO 8601.
+     ((eq type 'iso8601)
       (concat
        "Date: "
-       (format-time-string gnus-article-time-format
-                          (ignore-errors
-                            (gnus-encode-date
-                             (timezone-make-date-arpa-standard
-                              date nil "UT")))))))
-   ;; ISO 8601.
-   ((eq type 'iso8601)
-    (concat
-     "Date: "
-     (format-time-string "%Y%M%DT%h%m%s"
-                        (ignore-errors
-                          (gnus-encode-date
-                           (timezone-make-date-arpa-standard
-                            date nil "UT"))))))
-   ;; Do an X-Sent lapsed format.
-   ((eq type 'lapsed)
-    ;; If the date is seriously mangled, the timezone functions are
-    ;; liable to bug out, so we ignore all errors.
-    (let* ((now (current-time))
-          (real-time
-           (ignore-errors
-             (gnus-time-minus
-              (gnus-encode-date
-               (timezone-make-date-arpa-standard
-                (current-time-string now)
-                (current-time-zone now) "UT"))
-              (gnus-encode-date
-               (timezone-make-date-arpa-standard
-                date nil "UT")))))
-          (real-sec (and real-time
-                         (+ (* (float (car real-time)) 65536)
-                            (cadr real-time))))
-          (sec (and real-time (abs real-sec)))
-          num prev)
-      (cond
-       ((null real-time)
-       "X-Sent: Unknown")
-       ((zerop sec)
-       "X-Sent: Now")
-       (t
-       (concat
-        "X-Sent: "
-        ;; This is a bit convoluted, but basically we go
-        ;; through the time units for years, weeks, etc,
-        ;; and divide things to see whether that results
-        ;; in positive answers.
-        (mapconcat
-         (lambda (unit)
-           (if (zerop (setq num (ffloor (/ sec (cdr unit)))))
-               ;; The (remaining) seconds are too few to
-               ;; be divided into this time unit.
-               ""
-             ;; It's big enough, so we output it.
-             (setq sec (- sec (* num (cdr unit))))
-             (prog1
-                 (concat (if prev ", " "") (int-to-string
-                                            (floor num))
-                         " " (symbol-name (car unit))
-                         (if (> num 1) "s" ""))
-               (setq prev t))))
-         article-time-units "")
-        ;; If dates are odd, then it might appear like the
-        ;; article was sent in the future.
-        (if (> real-sec 0)
-            " ago"
-          " in the future"))))))
-   (t
-    (error "Unknown conversion type: %s" type))))
+       (format-time-string "%Y%M%DT%h%m%s" time)))
+     ;; Do an X-Sent lapsed format.
+     ((eq type 'lapsed)
+      ;; If the date is seriously mangled, the timezone functions are
+      ;; liable to bug out, so we ignore all errors.
+      (let* ((now (current-time))
+            (real-time (subtract-time now time))
+            (real-sec (and real-time
+                           (+ (* (float (car real-time)) 65536)
+                              (cadr real-time))))
+            (sec (and real-time (abs real-sec)))
+            num prev)
+       (cond
+        ((null real-time)
+         "X-Sent: Unknown")
+        ((zerop sec)
+         "X-Sent: Now")
+        (t
+         (concat
+          "X-Sent: "
+          ;; This is a bit convoluted, but basically we go
+          ;; through the time units for years, weeks, etc,
+          ;; and divide things to see whether that results
+          ;; in positive answers.
+          (mapconcat
+           (lambda (unit)
+             (if (zerop (setq num (ffloor (/ sec (cdr unit)))))
+                 ;; The (remaining) seconds are too few to
+                 ;; be divided into this time unit.
+                 ""
+               ;; It's big enough, so we output it.
+               (setq sec (- sec (* num (cdr unit))))
+               (prog1
+                   (concat (if prev ", " "") (int-to-string
+                                              (floor num))
+                           " " (symbol-name (car unit))
+                           (if (> num 1) "s" ""))
+                 (setq prev t))))
+           article-time-units "")
+          ;; If dates are odd, then it might appear like the
+          ;; article was sent in the future.
+          (if (> real-sec 0)
+              " ago"
+            " in the future"))))))
+     (t
+      (error "Unknown conversion type: %s" type)))))
 
 (defun article-date-local (&optional highlight)
   "Convert the current article date to the local timezone."
@@ -1638,7 +1648,7 @@ Directory to save to is default to `gnus-article-save-directory'."
     (save-excursion
       (save-restriction
        (widen)
-       (gnus-output-to-rmail filename))))
+       (rmail-output-to-rmail-file filename))))
   filename)
 
 (defun gnus-summary-save-in-mail (&optional filename)
@@ -1655,7 +1665,7 @@ Directory to save to is default to `gnus-article-save-directory'."
        (widen)
        (if (and (file-readable-p filename)
                 (mail-file-babyl-p filename))
-           (gnus-output-to-rmail filename t)
+           (rmail-output-to-rmail-file filename t)
          (gnus-output-to-mail filename)))))
   filename)
 
@@ -1831,6 +1841,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is
      article-date-iso8601
      article-date-original
      article-date-ut
+     article-decode-mime-words
      article-date-user
      article-date-lapsed
      article-emphasize
@@ -1924,20 +1935,18 @@ commands:
   (setq mode-name "Article")
   (setq major-mode 'gnus-article-mode)
   (make-local-variable 'minor-mode-alist)
-  (unless (assq 'gnus-show-mime minor-mode-alist)
-    (push (list 'gnus-show-mime " MIME") minor-mode-alist))
   (use-local-map gnus-article-mode-map)
   (gnus-update-format-specifications nil 'article-mode)
   (set (make-local-variable 'page-delimiter) gnus-page-delimiter)
   (make-local-variable 'gnus-page-broken)
   (make-local-variable 'gnus-button-marker-list)
   (make-local-variable 'gnus-article-current-summary)
+  (make-local-variable 'gnus-article-mime-handles)
   (gnus-set-default-directory)
   (buffer-disable-undo (current-buffer))
   (setq buffer-read-only t)
   (set-syntax-table gnus-article-mode-syntax-table)
-  (when (fboundp 'set-buffer-multibyte)
-    (set-buffer-multibyte t))
+  (mm-enable-multibyte)
   (gnus-run-hooks 'gnus-article-mode-hook))
 
 (defun gnus-article-setup-buffer ()
@@ -1960,7 +1969,7 @@ commands:
     ;; Init original article buffer.
     (save-excursion
       (set-buffer (gnus-get-buffer-create gnus-original-article-buffer))
-      (buffer-disable-undo (current-buffer))
+      (mm-enable-multibyte)
       (setq major-mode 'gnus-original-article-mode)
       (make-local-variable 'gnus-original-article))
     (if (get-buffer name)
@@ -2090,14 +2099,8 @@ If ALL-HEADERS is non-nil, no headers are hidden."
              (let (buffer-read-only)
                (gnus-run-hooks 'gnus-tmp-internal-hook)
                (gnus-run-hooks 'gnus-article-prepare-hook)
-               ;; Decode MIME message.
-               (when gnus-show-mime
-                 (if (or (not gnus-strict-mime)
-                         (gnus-fetch-field "Mime-Version"))
-                     (let ((coding-system-for-write 'binary)
-                           (coding-system-for-read 'binary))
-                       (funcall gnus-show-mime-method))
-                   (funcall gnus-decode-encoded-word-method)))
+               (when gnus-display-mime-function
+                 (funcall gnus-display-mime-function))
                ;; Perform the article display hooks.
                (gnus-run-hooks 'gnus-article-display-hook))
              ;; Do page break.
@@ -2113,6 +2116,32 @@ If ALL-HEADERS is non-nil, no headers are hidden."
            (set-window-point (get-buffer-window (current-buffer)) (point))
            t))))))
 
+(defun gnus-display-mime ()
+  (let ((handles (mm-dissect-buffer))
+       handle name type)
+    (mapcar 'mm-destroy-part gnus-article-mime-handles)
+    (setq gnus-article-mime-handles nil)
+    (setq gnus-article-mime-handles (nconc gnus-article-mime-handles handles))
+    (when handles
+      (goto-char (point-min))
+      (search-forward "\n\n" nil t)
+      (delete-region (point) (point-max))
+      (while (setq handle (pop handles))
+       (setq name (drums-content-type-get (cadr handle) 'name)
+             type (caadr handle))
+       (gnus-article-add-button
+        (point)
+        (progn
+          (insert
+           (format "[%s%s]" type (if name (concat " (" name ")") "")))
+          (point))
+        'mm-display-part handle)
+       (insert "\n\n\n")
+       (when (mm-automatic-display-p type)
+         (forward-line -2)
+         (mm-display-part handle)
+         (goto-char (point-max)))))))
+
 (defun gnus-article-wash-status ()
   "Return a string which display status of article washing."
   (save-excursion
@@ -2124,15 +2153,13 @@ If ALL-HEADERS is non-nil, no headers are hidden."
          (pem (gnus-article-hidden-text-p 'pem))
          (signature (gnus-article-hidden-text-p 'signature))
          (overstrike (gnus-article-hidden-text-p 'overstrike))
-         (emphasis (gnus-article-hidden-text-p 'emphasis))
-         (mime gnus-show-mime))
+         (emphasis (gnus-article-hidden-text-p 'emphasis)))
       (format "%c%c%c%c%c%c%c"
              (if cite ?c ? )
              (if (or headers boring) ?h ? )
              (if (or pgp pem) ?p ? )
              (if signature ?s ? )
              (if overstrike ?o ? )
-             (if mime ?m ? )
              (if emphasis ?e ? )))))
 
 (fset 'gnus-article-hide-headers-if-wanted 'gnus-article-maybe-hide-headers)
@@ -2530,6 +2557,9 @@ If given a prefix, show the hidden text instead."
            (insert-buffer-substring gnus-article-buffer))
          (setq gnus-original-article (cons group article))))
 
+      ;; Decode charsets.
+      (run-hooks 'gnus-article-decode-hook)
+      
       ;; Update sparse articles.
       (when (and do-update-line
                 (or (numberp article)