Synch to No Gnus 200405161305.

[elisp/gnus.git-] / lisp / gnus-art.el

diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el
index e095ef5..0d5d4cb 100644 (file)
--- a/lisp/gnus-art.el
+++ b/lisp/gnus-art.el
@@ -1,5 +1,5 @@
 ;;; gnus-art.el --- article mode commands for Semi-gnus
 ;;; gnus-art.el --- article mode commands for Semi-gnus

-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004

 ;;        Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;;        Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>

@@ -64,7 +64,7 @@
 
 (defgroup gnus-article nil
   "Article display."
 
 (defgroup gnus-article nil
   "Article display."

-  :link '(custom-manual "(gnus)The Article Buffer")
+  :link '(custom-manual "(gnus)Article Buffer")

   :group 'gnus)
 
 (defgroup gnus-article-treat nil
   :group 'gnus)
 
 (defgroup gnus-article-treat nil

@@ -304,7 +304,7 @@ asynchronously.      The compressed face will be piped to this command."
                         '(function-item
                           x-face-mule-gnus-article-display-x-face))
                     'function))))
                         '(function-item
                           x-face-mule-gnus-article-display-x-face))
                     'function))))

-  ;;:version "21.1"
+  :version "21.1"

   :group 'gnus-picon
   :group 'gnus-article-washing)
 
   :group 'gnus-picon
   :group 'gnus-article-washing)
 

@@ -811,6 +811,7 @@ When nil (the default value), then some MIME parts do not get buttons,
 as described by the variables `gnus-buttonized-mime-types' and
 `gnus-unbuttonized-mime-types'."
   :version "21.3"
 as described by the variables `gnus-buttonized-mime-types' and
 `gnus-unbuttonized-mime-types'."
   :version "21.3"

+  :group 'gnus-article-mime

   :type 'boolean)
 
 (defcustom gnus-body-boundary-delimiter "_"
   :type 'boolean)
 
 (defcustom gnus-body-boundary-delimiter "_"

@@ -850,7 +851,7 @@ on parts -- for instance, adding Vcard info to a database."
   "An alist of MIME types to functions to display them."
   :version "21.1"
   :group 'gnus-article-mime
   "An alist of MIME types to functions to display them."
   :version "21.1"
   :group 'gnus-article-mime

-  :type 'alist)
+  :type '(repeat (cons :format "%v" (string :tag "MIME type") function)))

 
 (defcustom gnus-article-date-lapsed-new-header nil
   "Whether the X-Sent and Date headers can coexist.
 
 (defcustom gnus-article-date-lapsed-new-header nil
   "Whether the X-Sent and Date headers can coexist.

@@ -1232,7 +1233,7 @@ Valid values are nil, t, `head', `last', an integer or a predicate.
 See Info node `(gnus)Customizing Articles' and Info node
 `(gnus)X-Face' for details."
   :group 'gnus-article-treat
 See Info node `(gnus)Customizing Articles' and Info node
 `(gnus)X-Face' for details."
   :group 'gnus-article-treat

-  ;;:version "21.1"
+  :version "21.1"

   :link '(custom-manual "(gnus)Customizing Articles")
   :link '(custom-manual "(gnus)X-Face")
   :type gnus-article-treat-head-custom
   :link '(custom-manual "(gnus)Customizing Articles")
   :link '(custom-manual "(gnus)X-Face")
   :type gnus-article-treat-head-custom

@@ -1318,7 +1319,7 @@ Valid values are nil, t, `head', `last', an integer or a predicate.
 See Info node `(gnus)Customizing Articles' and Info node
 `(gnus)Smileys' for details."
   :group 'gnus-article-treat
 See Info node `(gnus)Customizing Articles' and Info node
 `(gnus)Smileys' for details."
   :group 'gnus-article-treat

-  ;;:version "21.1"
+  :version "21.1"

   :link '(custom-manual "(gnus)Customizing Articles")
   :link '(custom-manual "(gnus)Smileys")
   :type gnus-article-treat-custom)
   :link '(custom-manual "(gnus)Customizing Articles")
   :link '(custom-manual "(gnus)Smileys")
   :type gnus-article-treat-custom)

@@ -1486,6 +1487,13 @@ This requires GNU Libidn, and by default only enabled if it is found."
   '("January" "February" "March" "April" "May" "June" "July" "August"
     "September" "October" "November" "December"))
 
   '("January" "February" "March" "April" "May" "June" "July" "August"
     "September" "October" "November" "December"))
 

+(defvar gnus-button-regexp nil)
+(defvar gnus-button-marker-list nil)
+;; Regexp matching any of the regexps from `gnus-button-alist'.
+
+(defvar gnus-button-last nil)
+;; The value of `gnus-button-alist' when `gnus-button-regexp' was build.
+

 (defvar article-goto-body-goes-to-point-min-p nil)
 (defvar gnus-article-wash-types nil)
 (defvar gnus-article-emphasis-alist nil)
 (defvar article-goto-body-goes-to-point-min-p nil)
 (defvar gnus-article-wash-types nil)
 (defvar gnus-article-emphasis-alist nil)

@@ -1576,6 +1584,8 @@ Initialized from `text-mode-syntax-table.")
 
 (defvar gnus-inhibit-hiding nil)
 
 
 (defvar gnus-inhibit-hiding nil)
 

+(defvar gnus-article-edit-mode nil)
+

 ;;; Macros for dealing with the article buffer.
 
 (defmacro gnus-with-article-headers (&rest forms)
 ;;; Macros for dealing with the article buffer.
 
 (defmacro gnus-with-article-headers (&rest forms)

@@ -2167,6 +2177,9 @@ unfolded."
         (forward-line 1)
         (point))))))
 
         (forward-line 1)
         (point))))))
 

+(eval-when-compile
+  (defvar gnus-face-properties-alist))
+

 (defun article-display-face ()
   "Display any Face headers in the header."
   (interactive)
 (defun article-display-face ()
   "Display any Face headers in the header."
   (interactive)

@@ -2190,12 +2203,14 @@ unfolded."
            (save-restriction
              (mail-narrow-to-head)
              (while (gnus-article-goto-header "Face")
            (save-restriction
              (mail-narrow-to-head)
              (while (gnus-article-goto-header "Face")

-               (push (mail-header-field-value) faces))))
+               (setq faces (nconc faces (list (mail-header-field-value)))))))

          (while (setq face (pop faces))
            (let ((png (gnus-convert-face-to-png face))
                  image)
              (when png
          (while (setq face (pop faces))
            (let ((png (gnus-convert-face-to-png face))
                  image)
              (when png

-               (setq image (gnus-create-image png 'png t))
+               (setq image
+                     (apply 'gnus-create-image png 'png t
+                            (cdr (assq 'png gnus-face-properties-alist))))

                (gnus-article-goto-header "from")
                (when (bobp)
                  (insert "From: [no `from' set]\n")
                (gnus-article-goto-header "from")
                (when (bobp)
                  (insert "From: [no `from' set]\n")

@@ -2272,14 +2287,12 @@ unfolded."
 (defun article-decode-mime-words ()
   "Decode all MIME-encoded words in the article."
   (interactive)
 (defun article-decode-mime-words ()
   "Decode all MIME-encoded words in the article."
   (interactive)

-  (save-excursion
-    (set-buffer gnus-article-buffer)
+  (gnus-with-article-buffer

     (let ((inhibit-point-motion-hooks t)
     (let ((inhibit-point-motion-hooks t)

-         buffer-read-only

          (mail-parse-charset gnus-newsgroup-charset)
          (mail-parse-ignored-charsets
          (mail-parse-charset gnus-newsgroup-charset)
          (mail-parse-ignored-charsets

-          (save-excursion (set-buffer gnus-summary-buffer)
-                          gnus-newsgroup-ignored-charsets)))
+          (with-current-buffer gnus-summary-buffer
+            gnus-newsgroup-ignored-charsets)))

       (mail-decode-encoded-word-region (point-min) (point-max)))))
 
 (defun article-decode-charset (&optional prompt)
       (mail-decode-encoded-word-region (point-min) (point-max)))))
 
 (defun article-decode-charset (&optional prompt)

@@ -2538,9 +2551,7 @@ If READ-CHARSET, ask for a coding system."
   (mm-setup-w3m)
   (save-restriction
     (narrow-to-region (point) (point-max))
   (mm-setup-w3m)
   (save-restriction
     (narrow-to-region (point) (point-max))

-    (let ((w3m-safe-url-regexp (if mm-inline-text-html-with-images
-                                  nil
-                                "\\`cid:"))
+    (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
          w3m-force-redisplay)
       (w3m-region (point-min) (point-max)))
     (when (and mm-inline-text-html-with-w3m-keymap

@@ -2613,18 +2624,25 @@ always hide."
          (article-really-strip-banner
           (gnus-parameter-banner gnus-newsgroup-name)))
        (when gnus-article-address-banner-alist
          (article-really-strip-banner
           (gnus-parameter-banner gnus-newsgroup-name)))
        (when gnus-article-address-banner-alist

-         (article-really-strip-banner
-          (let ((from (save-restriction
-                        (widen)
-                        (article-narrow-to-head)
-                        (mail-fetch-field "from"))))
-            (when (and from
-                       (setq from
-                             (caar (mail-header-parse-addresses from))))
-              (catch 'found
-                (dolist (pair gnus-article-address-banner-alist)
-                  (when (string-match (car pair) from)
-                    (throw 'found (cdr pair)))))))))))))
+         ;; It is necessary to encode from fields before checking,
+         ;; because `mail-header-parse-addresses' does not work
+         ;; (reliably) on decoded headers.  And more, it is
+         ;; impossible to use `gnus-fetch-original-field' here,
+         ;; because `article-strip-banner' may be called in draft
+         ;; buffers to preview them.
+         (let ((from (save-restriction
+                       (widen)
+                       (article-narrow-to-head)
+                       (mail-fetch-field "from"))))
+           (when (and from
+                      (setq from
+                            (caar (mail-header-parse-addresses
+                                   (mail-encode-encoded-word-string from)))))
+             (catch 'found
+               (dolist (pair gnus-article-address-banner-alist)
+                 (when (string-match (car pair) from)
+                   (throw 'found
+                          (article-really-strip-banner (cdr pair)))))))))))))

 
 (defun article-really-strip-banner (banner)
   "Strip the banner specified by the argument."
 
 (defun article-really-strip-banner (banner)
   "Strip the banner specified by the argument."

@@ -2652,11 +2670,9 @@ always hide."
   "Translate article using an online translation service."
   (interactive)
   (require 'babel)
   "Translate article using an online translation service."
   (interactive)
   (require 'babel)

-  (save-excursion
-    (set-buffer gnus-article-buffer)
+  (gnus-with-article-buffer

     (when (article-goto-body)
     (when (article-goto-body)

-      (let* ((buffer-read-only nil)
-            (start (point))
+      (let* ((start (point))

             (end (point-max))
             (orig (buffer-substring start end))
             (trans (babel-as-string orig)))
             (end (point-max))
             (orig (buffer-substring start end))
             (trans (babel-as-string orig)))

@@ -4298,8 +4314,7 @@ General format specifiers can also be used.  See Info node
 (defun gnus-mime-view-all-parts (&optional handles)
   "View all the MIME parts."
   (interactive)
 (defun gnus-mime-view-all-parts (&optional handles)
   "View all the MIME parts."
   (interactive)

-  (save-current-buffer
-    (set-buffer gnus-article-buffer)
+  (with-current-buffer gnus-article-buffer

     (let ((handles (or handles gnus-article-mime-handles))
          (mail-parse-charset gnus-newsgroup-charset)
          (mail-parse-ignored-charsets
     (let ((handles (or handles gnus-article-mime-handles))
          (mail-parse-charset gnus-newsgroup-charset)
          (mail-parse-ignored-charsets

@@ -4313,76 +4328,95 @@ General format specifiers can also be used.  See Info node
          (delete-region (point) (point-max))
          (mm-display-parts handles))))))
 
          (delete-region (point) (point-max))
          (mm-display-parts handles))))))
 

+(eval-when-compile
+  (defsubst gnus-article-edit-part (handles)
+    "Edit an article in order to delete a mime part.
+This function is exclusively used by `gnus-mime-save-part-and-strip'
+and `gnus-mime-delete-part', and not provided at run-time normally."
+    (gnus-article-edit-article
+     `(lambda ()
+       (erase-buffer)
+       (let ((mail-parse-charset (or gnus-article-charset
+                                     ',gnus-newsgroup-charset))
+             (mail-parse-ignored-charsets
+              (or gnus-article-ignored-charsets
+                  ',gnus-newsgroup-ignored-charsets))
+             (mbl mml-buffer-list))
+         (setq mml-buffer-list nil)
+         (insert-buffer gnus-original-article-buffer)
+         (mime-to-mml ',handles)
+         (setq gnus-article-mime-handles nil)
+         (let ((mbl1 mml-buffer-list))
+           (setq mml-buffer-list mbl)
+           (set (make-local-variable 'mml-buffer-list) mbl1))
+         (gnus-make-local-hook 'kill-buffer-hook)
+         (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t)))
+     `(lambda (no-highlight)
+       (let ((mail-parse-charset (or gnus-article-charset
+                                     ',gnus-newsgroup-charset))
+             (message-options message-options)
+             (message-options-set-recipient)
+             (mail-parse-ignored-charsets
+              (or gnus-article-ignored-charsets
+                  ',gnus-newsgroup-ignored-charsets)))
+         (mml-to-mime)
+         (mml-destroy-buffers)
+         (remove-hook 'kill-buffer-hook
+                      'mml-destroy-buffers t)
+         (kill-local-variable 'mml-buffer-list))
+       (gnus-summary-edit-article-done
+        ,(or (mail-header-references gnus-current-headers) "")
+        ,(gnus-group-read-only-p)
+        ,gnus-summary-buffer no-highlight)))
+    (gnus-article-edit-done)
+    (gnus-summary-expand-window)
+    (gnus-summary-show-article)))
+

 (defun gnus-mime-save-part-and-strip ()
   "Save the MIME part under point then replace it with an external body."
   (interactive)
   (gnus-article-check-buffer)
 (defun gnus-mime-save-part-and-strip ()
   "Save the MIME part under point then replace it with an external body."
   (interactive)
   (gnus-article-check-buffer)

-  (let* ((data (get-text-property (point) 'gnus-data))
-        file param
-        (handles gnus-article-mime-handles))
-    (if (mm-multiple-handles gnus-article-mime-handles)
-       (error "This function is not implemented"))
-    (setq file (and data (mm-save-part data)))
-    (when file
-      (with-current-buffer (mm-handle-buffer data)
-       (erase-buffer)
-       (insert "Content-Type: " (mm-handle-media-type data))
-       (mml-insert-parameter-string (cdr (mm-handle-type data))
-                                    '(charset))
-       (insert "\n")
-       (insert "Content-ID: " (message-make-message-id) "\n")
-       (insert "Content-Transfer-Encoding: binary\n")
-       (insert "\n"))
-      (setcdr data
-             (cdr (mm-make-handle nil
-                                  `("message/external-body"
-                                    (access-type . "LOCAL-FILE")
-                                    (name . ,file)))))
-      (set-buffer gnus-summary-buffer)
-      (gnus-article-edit-article
-       `(lambda ()
+  (when (gnus-group-read-only-p)
+    (error "The current group does not support deleting of parts"))
+  (when (mm-complicated-handles gnus-article-mime-handles)
+    (error "\
+The current article has a complicated MIME structure, giving up..."))
+  (when (gnus-yes-or-no-p "\
+Deleting parts may malfunction or destroy the article; continue? ")
+    (let* ((data (get-text-property (point) 'gnus-data))
+          file param
+          (handles gnus-article-mime-handles))
+      (setq file (and data (mm-save-part data)))
+      (when file
+       (with-current-buffer (mm-handle-buffer data)

          (erase-buffer)
          (erase-buffer)

-         (let ((mail-parse-charset (or gnus-article-charset
-                                       ',gnus-newsgroup-charset))
-               (mail-parse-ignored-charsets
-                (or gnus-article-ignored-charsets
-                    ',gnus-newsgroup-ignored-charsets))
-               (mbl mml-buffer-list))
-           (setq mml-buffer-list nil)
-           (insert-buffer gnus-original-article-buffer)
-           (mime-to-mml ',handles)
-           (setq gnus-article-mime-handles nil)
-           (let ((mbl1 mml-buffer-list))
-             (setq mml-buffer-list mbl)
-             (set (make-local-variable 'mml-buffer-list) mbl1))
-           (gnus-make-local-hook 'kill-buffer-hook)
-           (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t)))
-       `(lambda (no-highlight)
-         (let ((mail-parse-charset (or gnus-article-charset
-                                       ',gnus-newsgroup-charset))
-               (message-options message-options)
-               (message-options-set-recipient)
-               (mail-parse-ignored-charsets
-                (or gnus-article-ignored-charsets
-                    ',gnus-newsgroup-ignored-charsets)))
-           (mml-to-mime)
-           (mml-destroy-buffers)
-           (remove-hook 'kill-buffer-hook
-                        'mml-destroy-buffers t)
-           (kill-local-variable 'mml-buffer-list))
-         (gnus-summary-edit-article-done
-          ,(or (mail-header-references gnus-current-headers) "")
-          ,(gnus-group-read-only-p)
-          ,gnus-summary-buffer no-highlight))))))
+         (insert "Content-Type: " (mm-handle-media-type data))
+         (mml-insert-parameter-string (cdr (mm-handle-type data))
+                                      '(charset))
+         (insert "\n")
+         (insert "Content-ID: " (message-make-message-id) "\n")
+         (insert "Content-Transfer-Encoding: binary\n")
+         (insert "\n"))
+       (setcdr data
+               (cdr (mm-make-handle nil
+                                    `("message/external-body"
+                                      (access-type . "LOCAL-FILE")
+                                      (name . ,file)))))
+       (set-buffer gnus-summary-buffer)
+       (gnus-article-edit-part handles)))))

 
 (defun gnus-mime-delete-part ()
   "Delete the MIME part under point.
 Replace it with some information about the removed part."
   (interactive)
   (gnus-article-check-buffer)
 
 (defun gnus-mime-delete-part ()
   "Delete the MIME part under point.
 Replace it with some information about the removed part."
   (interactive)
   (gnus-article-check-buffer)

-  (unless (and gnus-novice-user
-              (not (gnus-yes-or-no-p
-                    "Really delete attachment forever? ")))
+  (when (gnus-group-read-only-p)
+    (error "The current group does not support deleting of parts"))
+  (when (mm-complicated-handles gnus-article-mime-handles)
+    (error "\
+The current article has a complicated MIME structure, giving up..."))
+  (when (gnus-yes-or-no-p "\
+Deleting parts may malfunction or destroy the article; continue? ")

     (let* ((data (get-text-property (point) 'gnus-data))
           (handles gnus-article-mime-handles)
           (none "(none)")
     (let* ((data (get-text-property (point) 'gnus-data))
           (handles gnus-article-mime-handles)
           (none "(none)")

@@ -4394,8 +4428,8 @@ Replace it with some information about the removed part."
            (or (mail-content-type-get (mm-handle-disposition data) 'filename)
                none))
           (type (mm-handle-media-type data)))
            (or (mail-content-type-get (mm-handle-disposition data) 'filename)
                none))
           (type (mm-handle-media-type data)))

-      (if (mm-multiple-handles gnus-article-mime-handles)
-         (error "This function is not implemented"))
+      (unless data
+       (error "No MIME part under point"))

       (with-current-buffer (mm-handle-buffer data)
        (let ((bsize (format "%s" (buffer-size))))
          (erase-buffer)
       (with-current-buffer (mm-handle-buffer data)
        (let ((bsize (format "%s" (buffer-size))))
          (erase-buffer)

@@ -4415,47 +4449,7 @@ Replace it with some information about the removed part."
                        (list "attachment")
                        (format "Deleted attachment (%s bytes)" bsize))))))
       (set-buffer gnus-summary-buffer)
                        (list "attachment")
                        (format "Deleted attachment (%s bytes)" bsize))))))
       (set-buffer gnus-summary-buffer)

-      ;; FIXME: maybe some of the following code (borrowed from
-      ;; `gnus-mime-save-part-and-strip') isn't necessary?
-      (gnus-article-edit-article
-       `(lambda ()
-         (erase-buffer)
-         (let ((mail-parse-charset (or gnus-article-charset
-                                       ',gnus-newsgroup-charset))
-               (mail-parse-ignored-charsets
-                (or gnus-article-ignored-charsets
-                    ',gnus-newsgroup-ignored-charsets))
-               (mbl mml-buffer-list))
-           (setq mml-buffer-list nil)
-           (insert-buffer gnus-original-article-buffer)
-           (mime-to-mml ',handles)
-           (setq gnus-article-mime-handles nil)
-           (let ((mbl1 mml-buffer-list))
-             (setq mml-buffer-list mbl)
-             (set (make-local-variable 'mml-buffer-list) mbl1))
-           (gnus-make-local-hook 'kill-buffer-hook)
-           (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t)))
-       `(lambda (no-highlight)
-         (let ((mail-parse-charset (or gnus-article-charset
-                                       ',gnus-newsgroup-charset))
-               (message-options message-options)
-               (message-options-set-recipient)
-               (mail-parse-ignored-charsets
-                (or gnus-article-ignored-charsets
-                    ',gnus-newsgroup-ignored-charsets)))
-           (mml-to-mime)
-           (mml-destroy-buffers)
-           (remove-hook 'kill-buffer-hook
-                        'mml-destroy-buffers t)
-           (kill-local-variable 'mml-buffer-list))
-         (gnus-summary-edit-article-done
-          ,(or (mail-header-references gnus-current-headers) "")
-          ,(gnus-group-read-only-p)
-          ,gnus-summary-buffer no-highlight)))))
-  ;; Not in `gnus-mime-save-part-and-strip':
-  (gnus-article-edit-done)
-  (gnus-summary-expand-window)
-  (gnus-summary-show-article))
+      (gnus-article-edit-part handles))))

 
 (defun gnus-mime-save-part ()
   "Save the MIME part under point."
 
 (defun gnus-mime-save-part ()
   "Save the MIME part under point."

@@ -4662,8 +4656,8 @@ specified charset."
         (mm-inlined-types nil)
         (mail-parse-charset gnus-newsgroup-charset)
         (mail-parse-ignored-charsets
         (mm-inlined-types nil)
         (mail-parse-charset gnus-newsgroup-charset)
         (mail-parse-ignored-charsets

-         (save-excursion (set-buffer gnus-summary-buffer)
-                         gnus-newsgroup-ignored-charsets)))
+         (with-current-buffer gnus-summary-buffer
+           gnus-newsgroup-ignored-charsets)))

     (when handle
       (if (mm-handle-undisplayer handle)
          (mm-remove-part handle)
     (when handle
       (if (mm-handle-undisplayer handle)
          (mm-remove-part handle)

@@ -4679,8 +4673,8 @@ If no internal viewer is available, use an external viewer."
         (mm-inline-large-images t)
         (mail-parse-charset gnus-newsgroup-charset)
         (mail-parse-ignored-charsets
         (mm-inline-large-images t)
         (mail-parse-charset gnus-newsgroup-charset)
         (mail-parse-ignored-charsets

-         (save-excursion (set-buffer gnus-summary-buffer)
-                         gnus-newsgroup-ignored-charsets))
+         (with-current-buffer gnus-summary-buffer
+           gnus-newsgroup-ignored-charsets))

         buffer-read-only)
     (when handle
       (if (mm-handle-undisplayer handle)
         buffer-read-only)
     (when handle
       (if (mm-handle-undisplayer handle)

@@ -4697,8 +4691,7 @@ If no internal viewer is available, use an external viewer."
        (funcall (cdr action-pair)))))
 
 (defun gnus-article-part-wrapper (n function)
        (funcall (cdr action-pair)))))
 
 (defun gnus-article-part-wrapper (n function)

-  (save-current-buffer
-    (set-buffer gnus-article-buffer)
+  (with-current-buffer gnus-article-buffer

     (when (> n (length gnus-article-mime-handle-alist))
       (error "No such part"))
     (gnus-article-goto-part n)
     (when (> n (length gnus-article-mime-handle-alist))
       (error "No such part"))
     (gnus-article-goto-part n)

@@ -4764,8 +4757,7 @@ N is the numerical prefix."
 (defun gnus-article-view-part (&optional n)
   "View MIME part N, which is the numerical prefix."
   (interactive "P")
 (defun gnus-article-view-part (&optional n)
   "View MIME part N, which is the numerical prefix."
   (interactive "P")

-  (save-current-buffer
-    (set-buffer gnus-article-buffer)
+  (with-current-buffer gnus-article-buffer

     (or (numberp n) (setq n (gnus-article-mime-match-handle-first
                             gnus-article-mime-match-handle-function)))
     (when (> n (length gnus-article-mime-handle-alist))
     (or (numberp n) (setq n (gnus-article-mime-match-handle-first
                             gnus-article-mime-match-handle-function)))
     (when (> n (length gnus-article-mime-handle-alist))

@@ -4793,8 +4785,7 @@ N is the numerical prefix."
              (mail-parse-charset gnus-newsgroup-charset)
              (mail-parse-ignored-charsets
               (if (gnus-buffer-live-p gnus-summary-buffer)
              (mail-parse-charset gnus-newsgroup-charset)
              (mail-parse-ignored-charsets
               (if (gnus-buffer-live-p gnus-summary-buffer)

-                  (save-excursion
-                    (set-buffer gnus-summary-buffer)
+                  (with-current-buffer gnus-summary-buffer

                     gnus-newsgroup-ignored-charsets)
                 nil)))
          (save-excursion
                     gnus-newsgroup-ignored-charsets)
                 nil)))
          (save-excursion

@@ -5052,11 +5043,9 @@ If displaying \"text/html\" is discouraged \(see
          (push (cons id handle) gnus-article-mime-handle-alist)
          (when (or (not display)
                    (not (gnus-unbuttonized-mime-type-p type)))
          (push (cons id handle) gnus-article-mime-handle-alist)
          (when (or (not display)
                    (not (gnus-unbuttonized-mime-type-p type)))

-           ;(gnus-article-insert-newline)

            (gnus-insert-mime-button
             handle id (list (or display (and not-attachment text))))
            (gnus-article-insert-newline)
            (gnus-insert-mime-button
             handle id (list (or display (and not-attachment text))))
            (gnus-article-insert-newline)

-           ;(gnus-article-insert-newline)

            ;; Remember modify the number of forward lines.
            (setq move t))
          (setq beg (point))
            ;; Remember modify the number of forward lines.
            (setq move t))
          (setq beg (point))

@@ -5183,8 +5172,8 @@ If displaying \"text/html\" is discouraged \(see
              (gnus-display-mime preferred)
            (let ((mail-parse-charset gnus-newsgroup-charset)
                  (mail-parse-ignored-charsets
              (gnus-display-mime preferred)
            (let ((mail-parse-charset gnus-newsgroup-charset)
                  (mail-parse-ignored-charsets

-                  (save-excursion (set-buffer gnus-summary-buffer)
-                                  gnus-newsgroup-ignored-charsets)))
+                  (with-current-buffer gnus-summary-buffer
+                    gnus-newsgroup-ignored-charsets)))

              (mm-display-part preferred)
              ;; Do highlighting.
              (save-excursion
              (mm-display-part preferred)
              ;; Do highlighting.
              (save-excursion

@@ -5236,8 +5225,7 @@ is the string to use when it is inactive.")
 
 (defun gnus-article-wash-status ()
   "Return a string which display status of article washing."
 
 (defun gnus-article-wash-status ()
   "Return a string which display status of article washing."

-  (save-excursion
-    (set-buffer gnus-article-buffer)
+  (with-current-buffer gnus-article-buffer

     (let ((cite (memq 'cite gnus-article-wash-types))
          (headers (memq 'headers gnus-article-wash-types))
          (boring (memq 'boring-headers gnus-article-wash-types))
     (let ((cite (memq 'cite gnus-article-wash-types))
          (headers (memq 'headers gnus-article-wash-types))
          (boring (memq 'boring-headers gnus-article-wash-types))

@@ -5287,8 +5275,8 @@ is the string to use when it is inactive.")
   "Hide unwanted headers if `gnus-have-all-headers' is nil.
 Provided for backwards compatibility."
   (when (and (or (not (gnus-buffer-live-p gnus-summary-buffer))
   "Hide unwanted headers if `gnus-have-all-headers' is nil.
 Provided for backwards compatibility."
   (when (and (or (not (gnus-buffer-live-p gnus-summary-buffer))

-                (not (save-excursion (set-buffer gnus-summary-buffer)
-                                     gnus-have-all-headers)))
+                (not (with-current-buffer gnus-summary-buffer
+                       gnus-have-all-headers)))

             (not gnus-inhibit-hiding))
     (gnus-article-hide-headers)))
 
             (not gnus-inhibit-hiding))
     (gnus-article-hide-headers)))
 

@@ -5550,11 +5538,13 @@ not have a face in `gnus-article-boring-faces'."
       (let ((obuf (current-buffer))
            (owin (current-window-configuration))
            (opoint (point))
       (let ((obuf (current-buffer))
            (owin (current-window-configuration))
            (opoint (point))

-           (summary gnus-article-current-summary)
-           func in-buffer selected)
-       (if not-restore-window
-           (pop-to-buffer summary 'norecord)
-         (switch-to-buffer summary 'norecord))
+           win func in-buffer selected new-sum-start new-sum-hscroll)
+       (cond (not-restore-window
+              (pop-to-buffer gnus-article-current-summary 'norecord))
+             ((setq win (get-buffer-window gnus-article-current-summary))
+              (select-window win))
+             (t
+              (switch-to-buffer gnus-article-current-summary 'norecord)))

        (setq in-buffer (current-buffer))
        ;; We disable the pick minor mode commands.
        (if (and (setq func (let (gnus-pick-mode)
        (setq in-buffer (current-buffer))
        ;; We disable the pick minor mode commands.
        (if (and (setq func (let (gnus-pick-mode)

@@ -5562,7 +5552,10 @@ not have a face in `gnus-article-boring-faces'."
                 (functionp func))
            (progn
              (call-interactively func)
                 (functionp func))
            (progn
              (call-interactively func)

-             (setq new-sum-point (point))
+             (when (eq win (selected-window))
+               (setq new-sum-point (point)
+                     new-sum-start (window-start win)
+                     new-sum-hscroll (window-hscroll win))

              (when (eq in-buffer (current-buffer))
                (setq selected (gnus-summary-select-article))
                (set-buffer obuf)
              (when (eq in-buffer (current-buffer))
                (setq selected (gnus-summary-select-article))
                (set-buffer obuf)

@@ -5574,10 +5567,12 @@ not have a face in `gnus-article-boring-faces'."
                                    1)
                  (set-window-point (get-buffer-window (current-buffer))
                                    (point)))
                                    1)
                  (set-window-point (get-buffer-window (current-buffer))
                                    (point)))

-               (let ((win (get-buffer-window gnus-article-current-summary)))
-                 (when win
-                   (set-window-point win new-sum-point))))    )
-         (switch-to-buffer gnus-article-buffer)
+               (when (and (not not-restore-window)
+                          new-sum-point)
+                 (set-window-point win new-sum-point)
+                 (set-window-start win new-sum-start)
+                 (set-window-hscroll win new-sum-hscroll)))))
+         (set-window-configuration owin)

          (ding))))))
 
 (defun gnus-article-describe-key (key)
          (ding))))))
 
 (defun gnus-article-describe-key (key)

@@ -5748,16 +5743,14 @@ If given a prefix, show the hidden text instead."
                 gnus-summary-buffer
                 (get-buffer gnus-summary-buffer)
                 (gnus-buffer-exists-p gnus-summary-buffer)
                 gnus-summary-buffer
                 (get-buffer gnus-summary-buffer)
                 (gnus-buffer-exists-p gnus-summary-buffer)

-                (eq (cdr (save-excursion
-                           (set-buffer gnus-summary-buffer)
+                (eq (cdr (with-current-buffer gnus-summary-buffer

                            (assq article gnus-newsgroup-reads)))
                     gnus-canceled-mark))
            nil)
           ;; We first check `gnus-original-article-buffer'.
           ((and (get-buffer gnus-original-article-buffer)
                 (numberp article)
                            (assq article gnus-newsgroup-reads)))
                     gnus-canceled-mark))
            nil)
           ;; We first check `gnus-original-article-buffer'.
           ((and (get-buffer gnus-original-article-buffer)
                 (numberp article)

-                (save-excursion
-                  (set-buffer gnus-original-article-buffer)
+                (with-current-buffer gnus-original-article-buffer

                   (and (equal (car gnus-original-article) group)
                        (eq (cdr gnus-original-article) article))))
            (insert-buffer-substring gnus-original-article-buffer)
                   (and (equal (car gnus-original-article) group)
                        (eq (cdr gnus-original-article) article))))
            (insert-buffer-substring gnus-original-article-buffer)

@@ -5881,7 +5874,6 @@ If given a prefix, show the hidden text instead."
 (defvar gnus-article-edit-done-function nil)
 
 (defvar gnus-article-edit-mode-map nil)
 (defvar gnus-article-edit-done-function nil)
 
 (defvar gnus-article-edit-mode-map nil)

-(defvar gnus-article-edit-mode nil)

 
 ;; Should we be using derived.el for this?
 (unless gnus-article-edit-mode-map
 
 ;; Should we be using derived.el for this?
 (unless gnus-article-edit-mode-map

@@ -6565,7 +6557,7 @@ positives are possible."
     ("\\(<URL: *\\)mailto: *\\([^> \n\t]+\\)>"
      0 (>= gnus-button-message-level 0) gnus-url-mailto 2)
     ;; RFC 2368 (The mailto URL scheme)
     ("\\(<URL: *\\)mailto: *\\([^> \n\t]+\\)>"
      0 (>= gnus-button-message-level 0) gnus-url-mailto 2)
     ;; RFC 2368 (The mailto URL scheme)

-    ("mailto:\\([-a-z.@_+0-9%=?&]+\\)"
+    ("\\bmailto:\\([-a-z.@_+0-9%=?&/]+\\)"

      0 (>= gnus-button-message-level 0) gnus-url-mailto 1)
     ("\\bmailto:\\([^ \n\t]+\\)"
      0 (>= gnus-button-message-level 0) gnus-url-mailto 1)
      0 (>= gnus-button-message-level 0) gnus-url-mailto 1)
     ("\\bmailto:\\([^ \n\t]+\\)"
      0 (>= gnus-button-message-level 0) gnus-url-mailto 1)

@@ -6700,7 +6692,7 @@ variable it the real callback function."
      0 (>= gnus-button-browse-level 0) browse-url 0)
     ("^[^:]+:" gnus-button-url-regexp
      0 (>= gnus-button-browse-level 0) browse-url 0)
      0 (>= gnus-button-browse-level 0) browse-url 0)
     ("^[^:]+:" gnus-button-url-regexp
      0 (>= gnus-button-browse-level 0) browse-url 0)

-    ("^[^:]+:" "\\bmailto:\\([-a-z.@_+0-9%=?&]+\\)"
+    ("^[^:]+:" "\\bmailto:\\([-a-z.@_+0-9%=?&/]+\\)"

      0 (>= gnus-button-message-level 0) gnus-url-mailto 1)
     ("^[^:]+:" "\\(<\\(url: \\)?\\(nntp\\|news\\):\\([^>\n ]*\\)>\\)"
      1 (>= gnus-button-message-level 0) gnus-button-message-id 4))
      0 (>= gnus-button-message-level 0) gnus-url-mailto 1)
     ("^[^:]+:" "\\(<\\(url: \\)?\\(nntp\\|news\\):\\([^>\n ]*\\)>\\)"
      1 (>= gnus-button-message-level 0) gnus-button-message-id 4))

@@ -6724,13 +6716,6 @@ HEADER is a regexp to match a header.  For a fuller explanation, see
                               :inline t
                               (integer :tag "Regexp group")))))
 
                               :inline t
                               (integer :tag "Regexp group")))))
 

-(defvar gnus-button-regexp nil)
-(defvar gnus-button-marker-list nil)
-;; Regexp matching any of the regexps from `gnus-button-alist'.
-
-(defvar gnus-button-last nil)
-;; The value of `gnus-button-alist' when `gnus-button-regexp' was build.
-

 ;;; Commands:
 
 (defun gnus-article-push-button (event)
 ;;; Commands:
 
 (defun gnus-article-push-button (event)

@@ -6816,41 +6801,35 @@ do the highlighting.  See the documentation for those functions."
 (defun gnus-article-highlight-headers ()
   "Highlight article headers as specified by `gnus-header-face-alist'."
   (interactive)
 (defun gnus-article-highlight-headers ()
   "Highlight article headers as specified by `gnus-header-face-alist'."
   (interactive)

-  (save-excursion
-    (set-buffer gnus-article-buffer)
-    (save-restriction
-      (let ((alist gnus-header-face-alist)
-           (buffer-read-only nil)
-           (case-fold-search t)
-           (inhibit-point-motion-hooks t)
-           entry regexp header-face field-face from hpoints fpoints)
-       (article-narrow-to-head)
-       (while (setq entry (pop alist))
-         (goto-char (point-min))
-         (setq regexp (concat "^\\("
-                              (if (string-equal "" (nth 0 entry))
-                                  "[^\t ]"
-                                (nth 0 entry))
-                              "\\)")
-               header-face (nth 1 entry)
-               field-face (nth 2 entry))
-         (while (and (re-search-forward regexp nil t)
-                     (not (eobp)))
-           (beginning-of-line)
-           (setq from (point))
-           (unless (search-forward ":" nil t)
-             (forward-char 1))
-           (when (and header-face
-                      (not (memq (point) hpoints)))
-             (push (point) hpoints)
-             (gnus-put-text-property from (point) 'face header-face))
-           (when (and field-face
-                      (not (memq (setq from (point)) fpoints)))
-             (push from fpoints)
-             (if (re-search-forward "^[^ \t]" nil t)
-                 (forward-char -2)
-               (goto-char (point-max)))
-             (gnus-put-text-property from (point) 'face field-face))))))))
+  (gnus-with-article-headers
+    (let ((alist gnus-header-face-alist)
+         entry regexp header-face field-face from hpoints fpoints)
+      (while (setq entry (pop alist))
+       (goto-char (point-min))
+       (setq regexp (concat "^\\("
+                            (if (string-equal "" (nth 0 entry))
+                                "[^\t ]"
+                              (nth 0 entry))
+                            "\\)")
+             header-face (nth 1 entry)
+             field-face (nth 2 entry))
+       (while (and (re-search-forward regexp nil t)
+                   (not (eobp)))
+         (beginning-of-line)
+         (setq from (point))
+         (unless (search-forward ":" nil t)
+           (forward-char 1))
+         (when (and header-face
+                    (not (memq (point) hpoints)))
+           (push (point) hpoints)
+           (gnus-put-text-property from (point) 'face header-face))
+         (when (and field-face
+                    (not (memq (setq from (point)) fpoints)))
+           (push from fpoints)
+           (if (re-search-forward "^[^ \t]" nil t)
+               (forward-char -2)
+             (goto-char (point-max)))
+           (gnus-put-text-property from (point) 'face field-face)))))))

 
 (defun gnus-article-highlight-signature ()
   "Highlight the signature in an article.
 
 (defun gnus-article-highlight-signature ()
   "Highlight the signature in an article.

@@ -6858,10 +6837,8 @@ It does this by highlighting everything after
 `gnus-signature-separator' using `gnus-signature-face'."
   (interactive)
   (when gnus-signature-face
 `gnus-signature-separator' using `gnus-signature-face'."
   (interactive)
   (when gnus-signature-face

-    (save-excursion
-      (set-buffer gnus-article-buffer)
-      (let ((buffer-read-only nil)
-           (inhibit-point-motion-hooks t))
+    (gnus-with-article-buffer
+      (let ((inhibit-point-motion-hooks t))

        (save-restriction
          (when (gnus-article-narrow-to-signature)
            (gnus-overlay-put (gnus-make-overlay (point-min) (point-max))
        (save-restriction
          (when (gnus-article-narrow-to-signature)
            (gnus-overlay-put (gnus-make-overlay (point-min) (point-max))

@@ -6889,10 +6866,8 @@ It does this by highlighting everything after
 \"External references\" are things like Message-IDs and URLs, as
 specified by `gnus-button-alist'."
   (interactive (list 'force))
 \"External references\" are things like Message-IDs and URLs, as
 specified by `gnus-button-alist'."
   (interactive (list 'force))

-  (save-excursion
-    (set-buffer gnus-article-buffer)
-    (let ((buffer-read-only nil)
-         (inhibit-point-motion-hooks t)
+  (gnus-with-article-buffer
+    (let ((inhibit-point-motion-hooks t)

          (case-fold-search t)
          (alist gnus-button-alist)
          beg entry regexp)
          (case-fold-search t)
          (alist gnus-button-alist)
          beg entry regexp)

@@ -6933,40 +6908,33 @@ specified by `gnus-button-alist'."
 (defun gnus-article-add-buttons-to-head ()
   "Add buttons to the head of the article."
   (interactive)
 (defun gnus-article-add-buttons-to-head ()
   "Add buttons to the head of the article."
   (interactive)

-  (save-excursion
-    (set-buffer gnus-article-buffer)
-    (save-restriction
-      (let ((buffer-read-only nil)
-           (inhibit-point-motion-hooks t)
-           (case-fold-search t)
-           (alist gnus-header-button-alist)
-           entry beg end)
-       (article-narrow-to-head)
-       (while alist
-         ;; Each alist entry.
-         (setq entry (car alist)
-               alist (cdr alist))
-         (goto-char (point-min))
-         (while (re-search-forward (car entry) nil t)
-           ;; Each header matching the entry.
-           (setq beg (match-beginning 0))
-           (setq end (or (and (re-search-forward "^[^ \t]" nil t)
-                              (match-beginning 0))
-                         (point-max)))
-           (goto-char beg)
-           (while (re-search-forward (eval (nth 1 entry)) end t)
-             ;; Each match within a header.
-             (let* ((entry (cdr entry))
-                    (start (match-beginning (nth 1 entry)))
-                    (end (match-end (nth 1 entry)))
-                    (form (nth 2 entry)))
-               (goto-char (match-end 0))
-               (when (eval form)
-                 (gnus-article-add-button
-                  start end (nth 3 entry)
-                  (buffer-substring (match-beginning (nth 4 entry))
-                                    (match-end (nth 4 entry)))))))
-           (goto-char end)))))))
+  (gnus-with-article-headers
+    (let ((alist gnus-header-button-alist)
+         entry beg end)
+      (while alist
+       ;; Each alist entry.
+       (setq entry (pop alist))
+       (goto-char (point-min))
+       (while (re-search-forward (car entry) nil t)
+         ;; Each header matching the entry.
+         (setq beg (match-beginning 0))
+         (setq end (or (and (re-search-forward "^[^ \t]" nil t)
+                            (match-beginning 0))
+                       (point-max)))
+         (goto-char beg)
+         (while (re-search-forward (eval (nth 1 entry)) end t)
+           ;; Each match within a header.
+           (let* ((entry (cdr entry))
+                  (start (match-beginning (nth 1 entry)))
+                  (end (match-end (nth 1 entry)))
+                  (form (nth 2 entry)))
+             (goto-char (match-end 0))
+             (when (eval form)
+               (gnus-article-add-button
+                start end (nth 3 entry)
+                (buffer-substring (match-beginning (nth 4 entry))
+                                  (match-end (nth 4 entry)))))))
+         (goto-char end))))))

 
 ;;; External functions:
 
 
 ;;; External functions:
 

@@ -6982,22 +6950,17 @@ specified by `gnus-button-alist'."
          (list 'gnus-callback fun)
          (and data (list 'gnus-data data))))
   (widget-convert-button 'link from to :action 'gnus-widget-press-button
          (list 'gnus-callback fun)
          (and data (list 'gnus-data data))))
   (widget-convert-button 'link from to :action 'gnus-widget-press-button

-                        ;; Quote `:button-keymap' for Mule 2.3
-                        ;; but it won't work.
-                        ':button-keymap gnus-widget-button-keymap))
+                        :button-keymap gnus-widget-button-keymap))

 
 ;;; Internal functions:
 
 (defun gnus-article-set-globals ()
 
 ;;; Internal functions:
 
 (defun gnus-article-set-globals ()

-  (save-excursion
-    (set-buffer gnus-summary-buffer)
+  (with-current-buffer gnus-summary-buffer

     (gnus-set-global-variables)))
 
 (defun gnus-signature-toggle (end)
     (gnus-set-global-variables)))
 
 (defun gnus-signature-toggle (end)

-  (save-excursion
-    (set-buffer gnus-article-buffer)
-    (let ((buffer-read-only nil)
-         (inhibit-point-motion-hooks t)
+  (gnus-with-article-buffer
+    (let ((inhibit-point-motion-hooks t)

          (limit (next-single-property-change end 'mime-view-entity
                                              nil (point-max))))
       (if (text-property-any end limit 'article-type 'signature)
          (limit (next-single-property-change end 'mime-view-entity
                                              nil (point-max))))
       (if (text-property-any end limit 'article-type 'signature)

@@ -7135,8 +7098,7 @@ specified by `gnus-button-alist'."
 
 (defun gnus-button-message-id (message-id)
   "Fetch MESSAGE-ID."
 
 (defun gnus-button-message-id (message-id)
   "Fetch MESSAGE-ID."

-  (save-excursion
-    (set-buffer gnus-summary-buffer)
+  (with-current-buffer gnus-summary-buffer

     (gnus-summary-refer-article message-id)))
 
 (defun gnus-button-fetch-group (address)
     (gnus-summary-refer-article message-id)))
 
 (defun gnus-button-fetch-group (address)