]> code.delx.au - gnu-emacs/blobdiff - lisp/gnus/gnus-art.el
Merged from miles@gnu.org--gnu-2005 (patch 182-184, 691-699)
[gnu-emacs] / lisp / gnus / gnus-art.el
index 3821f9ecf1852f78772b4ea524eeed9ba3ee0b92..2b5cc46d936f13e8cb6dea6f76a31d0b419740ad 100644 (file)
@@ -225,7 +225,9 @@ only of boring text.  Boring text is controlled by
 This can also be a list of regexps.  In that case, it will be checked
 from head to tail looking for a separator.  Searches will be done from
 the end of the buffer."
-  :type '(repeat string)
+  :type '(choice :format "%{%t%}: %[Value Menu%]\n%v"
+                (regexp)
+                (repeat :tag "List of regexp" regexp))
   :group 'gnus-article-signature)
 
 (defcustom gnus-signature-limit nil
@@ -535,7 +537,8 @@ Gnus provides the following functions:
                (function-item gnus-summary-save-in-file)
                (function-item gnus-summary-save-body-in-file)
                (function-item gnus-summary-save-in-vm)
-               (function-item gnus-summary-write-to-file)))
+               (function-item gnus-summary-write-to-file)
+               (function)))
 
 (defcustom gnus-rmail-save-name 'gnus-plain-save-name
   "A function generating a file name to save articles in Rmail format.
@@ -821,7 +824,9 @@ This variable is only used when `gnus-inhibit-mime-unbuttonizing' is nil."
   "List of MIME types that should be given buttons when rendered inline.
 If set, this variable overrides `gnus-unbuttonized-mime-types'.
 To see e.g. security buttons you could set this to
-`(\"multipart/signed\")'.
+`(\"multipart/signed\")'.  You could also add \"multipart/alternative\" to
+this list to display radio buttons that allow you to choose one of two
+media types those mails include.  See also `mm-discouraged-alternatives'.
 This variable is only used when `gnus-inhibit-mime-unbuttonizing' is nil."
   :version "22.1"
   :group 'gnus-article-mime
@@ -1181,7 +1186,10 @@ See Info node `(gnus)Customizing Articles' for details."
 (defcustom gnus-treat-strip-trailing-blank-lines nil
   "Strip trailing blank lines.
 Valid values are nil, t, `head', `last', an integer or a predicate.
-See Info node `(gnus)Customizing Articles' for details."
+See Info node `(gnus)Customizing Articles' for details.
+
+When set to t, it also strips trailing blanks in all MIME parts.
+Consider to use `last' instead."
   :group 'gnus-article-treat
   :link '(custom-manual "(gnus)Customizing Articles")
   :type gnus-article-treat-custom)
@@ -1189,7 +1197,9 @@ See Info node `(gnus)Customizing Articles' for details."
 (defcustom gnus-treat-strip-leading-blank-lines nil
   "Strip leading blank lines.
 Valid values are nil, t, `head', `last', an integer or a predicate.
-See Info node `(gnus)Customizing Articles' for details."
+See Info node `(gnus)Customizing Articles' for details.
+
+When set to t, it also strips trailing blanks in all MIME parts."
   :group 'gnus-article-treat
   :link '(custom-manual "(gnus)Customizing Articles")
   :type gnus-article-treat-custom)
@@ -1622,10 +1632,24 @@ Initialized from `text-mode-syntax-table.")
   "Delete text of TYPE in the current buffer."
   (save-excursion
     (let ((b (point-min)))
-      (while (setq b (text-property-any b (point-max) 'article-type type))
-       (delete-region
-        b (or (text-property-not-all b (point-max) 'article-type type)
-              (point-max)))))))
+      (if (eq type 'multipart)
+         ;; Remove MIME buttons associated with multipart/alternative parts.
+         (progn
+           (goto-char b)
+           (while (if (get-text-property (point) 'gnus-part)
+                      (setq b (point))
+                    (when (setq b (next-single-property-change (point)
+                                                               'gnus-part))
+                      (goto-char b)
+                      t))
+             (end-of-line)
+             (skip-chars-forward "\n")
+             (when (eq (get-text-property b 'article-type) 'multipart)
+               (delete-region b (point)))))
+       (while (setq b (text-property-any b (point-max) 'article-type type))
+         (delete-region
+          b (or (text-property-not-all b (point-max) 'article-type type)
+                (point-max))))))))
 
 (defun gnus-article-delete-invisible-text ()
   "Delete all invisible text in the current buffer."
@@ -2333,20 +2357,22 @@ If PROMPT (the prefix), prompt for a coding system to use."
 (autoload 'idna-to-unicode "idna")
 
 (defun article-decode-idna-rhs ()
-  "Decode IDNA strings in RHS in From:, To: and Cc: headers in current buffer."
+  "Decode IDNA strings in RHS in various headers in current buffer.
+The following headers are decoded: From:, To:, Cc:, Reply-To:,
+Mail-Reply-To: and Mail-Followup-To:."
   (when gnus-use-idna
     (save-restriction
       (let ((inhibit-point-motion-hooks t)
            (inhibit-read-only t))
        (article-narrow-to-head)
        (goto-char (point-min))
-       (while (re-search-forward "@.*\\(xn--[-A-Za-z0-9.]*\\)[ \t\n\r,>]" nil t)
+       (while (re-search-forward "@[^ \t\n\r,>]*\\(xn--[-A-Za-z0-9.]*\\)[ \t\n\r,>]" nil t)
          (let (ace unicode)
            (when (save-match-data
                    (and (setq ace (match-string 1))
                         (save-excursion
                           (and (re-search-backward "^[^ \t]" nil t)
-                               (looking-at "From\\|To\\|Cc")))
+                               (looking-at "From\\|To\\|Cc\\|Reply-To\\|Mail-Reply-To\\|Mail-Followup-To")))
                         (setq unicode (idna-to-unicode ace))))
              (unless (string= ace unicode)
                (replace-match unicode nil nil nil 1)))))))))
@@ -2441,25 +2467,36 @@ If READ-CHARSET, ask for a coding system."
 
 (defun article-wash-html (&optional read-charset)
   "Format an HTML article.
-If READ-CHARSET, ask for a coding system."
+If READ-CHARSET, ask for a coding system.  If it is a number, the
+charset defined in `gnus-summary-show-article-charset-alist' is used."
   (interactive "P")
   (save-excursion
     (let ((inhibit-read-only t)
          charset)
-      (when (gnus-buffer-live-p gnus-original-article-buffer)
-       (with-current-buffer gnus-original-article-buffer
-         (let* ((ct (gnus-fetch-field "content-type"))
-                (ctl (and ct
-                          (ignore-errors
-                            (mail-header-parse-content-type ct)))))
-           (setq charset (and ctl
-                              (mail-content-type-get ctl 'charset)))
-           (when (stringp charset)
-             (setq charset (intern (downcase charset)))))))
-      (when read-charset
-       (setq charset (mm-read-coding-system "Charset: " charset)))
-      (unless charset
-       (setq charset gnus-newsgroup-charset))
+      (if read-charset
+         (if (or (and (numberp read-charset)
+                      (setq charset
+                            (cdr
+                             (assq read-charset
+                                   gnus-summary-show-article-charset-alist))))
+                 (setq charset (mm-read-coding-system "Charset: ")))
+             (let ((gnus-summary-show-article-charset-alist
+                    (list (cons 1 charset))))
+               (with-current-buffer gnus-summary-buffer
+                 (gnus-summary-show-article 1)))
+           (error "No charset is given"))
+       (when (gnus-buffer-live-p gnus-original-article-buffer)
+         (with-current-buffer gnus-original-article-buffer
+           (let* ((ct (gnus-fetch-field "content-type"))
+                  (ctl (and ct
+                            (ignore-errors
+                              (mail-header-parse-content-type ct)))))
+             (setq charset (and ctl
+                                (mail-content-type-get ctl 'charset)))
+             (when (stringp charset)
+               (setq charset (intern (downcase charset)))))))
+       (unless charset
+         (setq charset gnus-newsgroup-charset)))
       (article-goto-body)
       (save-window-excursion
        (save-restriction
@@ -2488,19 +2525,31 @@ If READ-CHARSET, ask for a coding system."
 (defun gnus-article-wash-html-with-w3m ()
   "Wash the current buffer with emacs-w3m."
   (mm-setup-w3m)
-  (save-restriction
-    (narrow-to-region (point) (point-max))
-    (let ((w3m-safe-url-regexp mm-w3m-safe-url-regexp)
-         w3m-force-redisplay)
-      (w3m-region (point-min) (point-max)))
-    (when (and mm-inline-text-html-with-w3m-keymap
-              (boundp 'w3m-minor-mode-map)
-              w3m-minor-mode-map)
-      (add-text-properties
-       (point-min) (point-max)
-       (list 'keymap w3m-minor-mode-map
-            ;; Put the mark meaning this part was rendered by emacs-w3m.
-            'mm-inline-text-html-with-w3m t)))))
+  (let ((w3m-safe-url-regexp mm-w3m-safe-url-regexp)
+       w3m-force-redisplay)
+    (w3m-region (point-min) (point-max)))
+  (when (and mm-inline-text-html-with-w3m-keymap
+            (boundp 'w3m-minor-mode-map)
+            w3m-minor-mode-map)
+    (add-text-properties
+     (point-min) (point-max)
+     (list 'keymap w3m-minor-mode-map
+          ;; Put the mark meaning this part was rendered by emacs-w3m.
+          'mm-inline-text-html-with-w3m t))))
+
+(eval-when-compile (defvar charset)) ;; Bound by `article-wash-html'.
+
+(defun gnus-article-wash-html-with-w3m-standalone ()
+  "Wash the current buffer with w3m."
+  (unless (mm-coding-system-p charset)
+    ;; The default.
+    (setq charset 'iso-8859-1))
+  (let ((coding-system-for-write charset)
+       (coding-system-for-read charset))
+    (call-process-region
+     (point-min) (point-max)
+     "w3m" t t nil "-dump" "-T" "text/html"
+     "-I" (symbol-name charset) "-O" (symbol-name charset))))
 
 (defun article-hide-list-identifiers ()
   "Remove list identifies from the Subject header.
@@ -3255,7 +3304,7 @@ This format is defined by the `gnus-article-time-format' variable."
                      ((null split-name)
                       (read-file-name
                        (concat prompt " (default "
-                               (file-name-nondirectory default-name) ") ")
+                               (file-name-nondirectory default-name) "): ")
                        (file-name-directory default-name)
                        default-name))
                      ;; A single group name is returned.
@@ -3265,7 +3314,7 @@ This format is defined by the `gnus-article-time-format' variable."
                                      (symbol-value variable)))
                       (read-file-name
                        (concat prompt " (default "
-                               (file-name-nondirectory default-name) ") ")
+                               (file-name-nondirectory default-name) "): ")
                        (file-name-directory default-name)
                        default-name))
                      ;; A single split name was found
@@ -3278,7 +3327,7 @@ This format is defined by the `gnus-article-time-format' variable."
                                         ((file-exists-p name) name)
                                         (t gnus-article-save-directory))))
                         (read-file-name
-                         (concat prompt " (default " name ") ")
+                         (concat prompt " (default " name "): ")
                          dir name)))
                      ;; A list of splits was found.
                      (t
@@ -3289,7 +3338,7 @@ This format is defined by the `gnus-article-time-format' variable."
                           (setq result
                                 (expand-file-name
                                  (read-file-name
-                                  (concat prompt " (`M-p' for defaults) ")
+                                  (concat prompt " (`M-p' for defaults): ")
                                   gnus-article-save-directory
                                   (car split-name))
                                  gnus-article-save-directory)))
@@ -3323,7 +3372,7 @@ This format is defined by the `gnus-article-time-format' variable."
 Optional argument FILENAME specifies file name.
 Directory to save to is default to `gnus-article-save-directory'."
   (setq filename (gnus-read-save-file-name
-                 "Save %s in rmail file:" filename
+                 "Save %s in rmail file" filename
                  gnus-rmail-save-name gnus-newsgroup-name
                  gnus-current-headers 'gnus-newsgroup-last-rmail))
   (gnus-eval-in-buffer-window gnus-save-article-buffer
@@ -3338,7 +3387,7 @@ Directory to save to is default to `gnus-article-save-directory'."
 Optional argument FILENAME specifies file name.
 Directory to save to is default to `gnus-article-save-directory'."
   (setq filename (gnus-read-save-file-name
-                 "Save %s in Unix mail file:" filename
+                 "Save %s in Unix mail file" filename
                  gnus-mail-save-name gnus-newsgroup-name
                  gnus-current-headers 'gnus-newsgroup-last-mail))
   (gnus-eval-in-buffer-window gnus-save-article-buffer
@@ -3357,7 +3406,7 @@ Directory to save to is default to `gnus-article-save-directory'."
 Optional argument FILENAME specifies file name.
 Directory to save to is default to `gnus-article-save-directory'."
   (setq filename (gnus-read-save-file-name
-                 "Save %s in file:" filename
+                 "Save %s in file" filename
                  gnus-file-save-name gnus-newsgroup-name
                  gnus-current-headers 'gnus-newsgroup-last-file))
   (gnus-eval-in-buffer-window gnus-save-article-buffer
@@ -3381,7 +3430,7 @@ The directory to save in defaults to `gnus-article-save-directory'."
 Optional argument FILENAME specifies file name.
 The directory to save in defaults to `gnus-article-save-directory'."
   (setq filename (gnus-read-save-file-name
-                 "Save %s body in file:" filename
+                 "Save %s body in file" filename
                  gnus-file-save-name gnus-newsgroup-name
                  gnus-current-headers 'gnus-newsgroup-last-file))
   (gnus-eval-in-buffer-window gnus-save-article-buffer
@@ -4694,11 +4743,15 @@ N is the numerical prefix."
          ;; We have to do this since selecting the window
          ;; may change the point.  So we set the window point.
          (set-window-point window point)))
-      (let* ((handles (or ihandles
-                         (mm-dissect-buffer nil gnus-article-loose-mime)
-                         (and gnus-article-emulate-mime
-                              (mm-uu-dissect))))
-            (inhibit-read-only t) handle name type b e display)
+      (let ((handles ihandles)
+           (inhibit-read-only t)
+           handle)
+       (cond (handles)
+             ((setq handles (mm-dissect-buffer nil gnus-article-loose-mime))
+              (when gnus-article-emulate-mime
+                (mm-uu-dissect-text-parts handles)))
+             (gnus-article-emulate-mime
+              (setq handles (mm-uu-dissect))))
        (when (and (not ihandles)
                   (not gnus-displaying-mime))
          ;; Top-level call; we clean up.
@@ -4864,14 +4917,17 @@ If displaying \"text/html\" is discouraged \(see
              (forward-line -1)
              (setq beg (point)))
            (gnus-article-insert-newline)
-           (mm-insert-inline handle
-                             (let ((charset
-                                    (mail-content-type-get
-                                     (mm-handle-type handle) 'charset)))
-                               (if (eq charset 'gnus-decoded)
-                                   (mm-get-part handle)
-                                 (mm-decode-string (mm-get-part handle)
-                                                   charset))))
+           (mm-insert-inline
+            handle
+            (let ((charset (mail-content-type-get (mm-handle-type handle)
+                                                  'charset)))
+              (cond ((not charset)
+                     (mm-string-as-multibyte (mm-get-part handle)))
+                    ((eq charset 'gnus-decoded)
+                     (with-current-buffer (mm-handle-buffer handle)
+                       (buffer-string)))
+                    (t
+                     (mm-decode-string (mm-get-part handle) charset)))))
            (goto-char (point-max))))
          ;; Do highlighting.
          (save-excursion
@@ -4941,7 +4997,7 @@ If displaying \"text/html\" is discouraged \(see
             ,gnus-mouse-face-prop ,gnus-article-mouse-face
             face ,gnus-article-button-face
             gnus-part ,id
-            gnus-data ,handle))
+            article-type multipart))
          (widget-convert-button 'link from (point)
                                 :action 'gnus-widget-press-button
                                 :button-keymap gnus-widget-button-keymap)