Synch to No Gnus 200406292138.

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

diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el
index 0e429eb..50363b6 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

@@ -246,7 +246,9 @@ that number.  If it is a floating point number, no signature may be
 longer (in lines) than that number.  If it is a function, the function
 will be called without any parameters, and if it returns nil, there is
 no signature in the buffer.  If it is a string, it will be used as a
 longer (in lines) than that number.  If it is a function, the function
 will be called without any parameters, and if it returns nil, there is
 no signature in the buffer.  If it is a string, it will be used as a

-regexp.  If it matches, the text in question is not a signature."
+regexp.  If it matches, the text in question is not a signature.
+
+This can also be a list of the above values."

   :type '(choice (integer :value 200)
                 (number :value 4.0)
                 (function :value fun)
   :type '(choice (integer :value 200)
                 (number :value 4.0)
                 (function :value fun)

@@ -379,8 +381,6 @@ advertisements.  For example:
            (format format (car spec) (car (cdr spec)))
            2 3 (intern (format "gnus-emphasis-%s" (nth 2 spec)))))
         types)
            (format format (car spec) (car (cdr spec)))
            2 3 (intern (format "gnus-emphasis-%s" (nth 2 spec)))))
         types)

-       ("\\(\\s-\\|^\\)\\(-\\(\\(\\w\\|-[^-]\\)+\\)-\\)\\(\\s-\\|[?!.,;]\\)"
-        2 3 gnus-emphasis-strikethru)

        ("\\(\\s-\\|^\\)\\(_\\(\\(\\w\\|_[^_]\\)+\\)_\\)\\(\\s-\\|[?!.,;]\\)"
         2 3 gnus-emphasis-underline)))
   "*Alist that says how to fontify certain phrases.
        ("\\(\\s-\\|^\\)\\(_\\(\\(\\w\\|_[^_]\\)+\\)_\\)\\(\\s-\\|[?!.,;]\\)"
         2 3 gnus-emphasis-underline)))
   "*Alist that says how to fontify certain phrases.

@@ -450,14 +450,14 @@ Example: (_/*word*/_)."
   "Face used for displaying highlighted words."
   :group 'gnus-article-emphasis)
 
   "Face used for displaying highlighted words."
   :group 'gnus-article-emphasis)
 

-(defcustom gnus-article-time-format "%a, %b %d %Y %T %Z"
+(defcustom gnus-article-time-format "%a, %d %b %Y %T %Z"

   "Format for display of Date headers in article bodies.
 See `format-time-string' for the possible values.
 
 The variable can also be function, which should return a complete Date
 header.  The function is called with one argument, the time, which can
 be fed to `format-time-string'."
   "Format for display of Date headers in article bodies.
 See `format-time-string' for the possible values.
 
 The variable can also be function, which should return a complete Date
 header.  The function is called with one argument, the time, which can
 be fed to `format-time-string'."

-  :type '(choice string symbol)
+  :type '(choice string function)

   :link '(custom-manual "(gnus)Article Date")
   :group 'gnus-article-washing)
 
   :link '(custom-manual "(gnus)Article Date")
   :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 "_"

@@ -821,7 +822,8 @@ be controlled by `gnus-treat-body-boundary'."
   :type '(choice (item :tag "None" :value nil)
                 string))
 
   :type '(choice (item :tag "None" :value nil)
                 string))
 

-(defcustom gnus-picon-databases '("/usr/lib/picon" "/usr/local/faces")
+(defcustom gnus-picon-databases '("/usr/lib/picon" "/usr/local/faces"
+                                 "/usr/share/picons")

   "Defines the location of the faces database.
 For information on obtaining this database of pretty pictures, please
 see http://www.cs.indiana.edu/picons/ftp/index.html"
   "Defines the location of the faces database.
 For information on obtaining this database of pretty pictures, please
 see http://www.cs.indiana.edu/picons/ftp/index.html"

@@ -850,7 +852,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.

@@ -1486,6 +1488,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)

@@ -1688,25 +1697,35 @@ Initialized from `text-mode-syntax-table.")
        (when (eq 1 (point-min))
          (set-window-start (get-buffer-window (current-buffer)) 1)))
     (unless gnus-inhibit-hiding
        (when (eq 1 (point-min))
          (set-window-start (get-buffer-window (current-buffer)) 1)))
     (unless gnus-inhibit-hiding

-      (save-excursion
-       (save-restriction
-         (let ((inhibit-read-only t)
-               (case-fold-search t)
-               (max (1+ (length gnus-sorted-header-list)))
-               (ignored (when (not gnus-visible-headers)
-                          (cond ((stringp gnus-ignored-headers)
-                                 gnus-ignored-headers)
-                                ((listp gnus-ignored-headers)
-                                 (mapconcat 'identity gnus-ignored-headers
-                                            "\\|")))))
-               (visible
-                (cond ((stringp gnus-visible-headers)
-                       gnus-visible-headers)
-                      ((and gnus-visible-headers
-                            (listp gnus-visible-headers))
-                       (mapconcat 'identity gnus-visible-headers "\\|"))))
-               (inhibit-point-motion-hooks t)
-               beg)
+      (let ((inhibit-read-only t)
+           (case-fold-search t)
+           (max (1+ (length gnus-sorted-header-list)))
+           (inhibit-point-motion-hooks t)
+           (cur (current-buffer))
+           ignored visible beg)
+       (save-excursion
+         ;; `gnus-ignored-headers' and `gnus-visible-headers' may be
+         ;; group parameters, so we should go to the summary buffer.
+         (when (prog1
+                   (condition-case nil
+                       (progn (set-buffer gnus-summary-buffer) t)
+                     (error nil))
+                 (setq ignored (when (not gnus-visible-headers)
+                                 (cond ((stringp gnus-ignored-headers)
+                                        gnus-ignored-headers)
+                                       ((listp gnus-ignored-headers)
+                                        (mapconcat 'identity
+                                                   gnus-ignored-headers
+                                                   "\\|"))))
+                       visible (cond ((stringp gnus-visible-headers)
+                                      gnus-visible-headers)
+                                     ((and gnus-visible-headers
+                                           (listp gnus-visible-headers))
+                                      (mapconcat 'identity
+                                                 gnus-visible-headers
+                                                 "\\|")))))
+           (set-buffer cur))
+         (save-restriction

            ;; First we narrow to just the headers.
            (article-narrow-to-head)
            ;; Hide any "From " lines at the beginning of (mail) articles.
            ;; First we narrow to just the headers.
            (article-narrow-to-head)
            ;; Hide any "From " lines at the beginning of (mail) articles.

@@ -2169,6 +2188,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)

@@ -2192,12 +2214,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")

@@ -2386,15 +2410,13 @@ If PROMPT (the prefix), prompt for a coding system to use."
            buffer-read-only)
        (article-narrow-to-head)
        (goto-char (point-min))
            buffer-read-only)
        (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 "@.*\\(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")))
          (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")))

-                        (save-excursion (backward-char)
-                                        (message-idna-inside-rhs-p))

                         (setq unicode (idna-to-unicode ace))))
              (unless (string= ace unicode)
                (replace-match unicode nil nil nil 1)))))))))
                         (setq unicode (idna-to-unicode ace))))
              (unless (string= ace unicode)
                (replace-match unicode nil nil nil 1)))))))))

@@ -2538,9 +2560,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 +2633,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."

@@ -2976,10 +3003,8 @@ should replace the \"Date:\" one, or should be added below it."
            (forward-line -1)
            ;; Do highlighting.
            (when (looking-at "\\([^:]+\\): *\\(.*\\)$")
            (forward-line -1)
            ;; Do highlighting.
            (when (looking-at "\\([^:]+\\): *\\(.*\\)$")

-             (put-text-property (match-beginning 1) (1+ (match-end 1))
-                                'original-date date)
-             (put-text-property (match-beginning 1) (1+ (match-end 1))
-                                'face bface)
+             (add-text-properties (match-beginning 1) (1+ (match-end 1))
+                                  (list 'original-date date 'face bface))

              (put-text-property (match-beginning 2) (match-end 2)
                                 'face eface))))))))
 
              (put-text-property (match-beginning 2) (match-end 2)
                                 'face eface))))))))
 

@@ -2992,22 +3017,21 @@ should replace the \"Date:\" one, or should be added below it."
        (cond
         ;; Convert to the local timezone.
         ((eq type 'local)
        (cond
         ;; Convert to the local timezone.
         ((eq type 'local)

-         (let ((tz (car (current-time-zone time))))
-           (format "Date: %s %s%02d%02d" (current-time-string time)
-                   (if (> tz 0) "+" "-") (/ (abs tz) 3600)
-                   (/ (% (abs tz) 3600) 60))))
+         (concat "Date: " (message-make-date time)))

         ;; Convert to Universal Time.
         ((eq type 'ut)
          (concat "Date: "
         ;; Convert to Universal Time.
         ((eq type 'ut)
          (concat "Date: "

-                 (current-time-string
-                  (let* ((e (parse-time-string date))
-                         (tm (apply 'encode-time e))
-                         (ms (car tm))
-                         (ls (- (cadr tm) (car (current-time-zone time)))))
-                    (cond ((< ls 0) (list (1- ms) (+ ls 65536)))
-                          ((> ls 65535) (list (1+ ms) (- ls 65536)))
-                          (t (list ms ls)))))
-                 " UT"))
+                 (substring
+                  (message-make-date
+                   (let* ((e (parse-time-string date))
+                          (tm (apply 'encode-time e))
+                          (ms (car tm))
+                          (ls (- (cadr tm) (car (current-time-zone time)))))
+                     (cond ((< ls 0) (list (1- ms) (+ ls 65536)))
+                           ((> ls 65535) (list (1+ ms) (- ls 65536)))
+                           (t (list ms ls)))))
+                  0 -5)
+                 "UT"))

         ;; Get the original date from the article.
         ((eq type 'original)
          (concat "Date: " (if (string-match "\n+$" date)
         ;; Get the original date from the article.
         ((eq type 'original)
          (concat "Date: " (if (string-match "\n+$" date)

@@ -3841,7 +3865,8 @@ commands:
   (make-local-variable 'gnus-article-ignored-charsets)
   (gnus-set-default-directory)
   (buffer-disable-undo)
   (make-local-variable 'gnus-article-ignored-charsets)
   (gnus-set-default-directory)
   (buffer-disable-undo)

-  (setq buffer-read-only t)
+  (setq buffer-read-only t
+       show-trailing-whitespace nil)

   (set-syntax-table gnus-article-mode-syntax-table)
   (gnus-run-hooks 'gnus-article-mode-hook))
 
   (set-syntax-table gnus-article-mode-syntax-table)
   (gnus-run-hooks 'gnus-article-mode-hook))
 

@@ -4310,76 +4335,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)")

@@ -4391,8 +4435,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)

@@ -4412,47 +4456,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."

@@ -5046,11 +5050,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))

@@ -5387,6 +5389,7 @@ Argument LINES specifies lines to be scrolled up."
              (save-excursion
                (save-restriction
                  (widen)
              (save-excursion
                (save-restriction
                  (widen)

+                 (forward-line)

                  (eobp)))) ;Real end-of-buffer?
          (progn
            (when gnus-article-over-scroll
                  (eobp)))) ;Real end-of-buffer?
          (progn
            (when gnus-article-over-scroll

@@ -5543,11 +5546,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)

@@ -5555,7 +5560,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)

@@ -5567,10 +5575,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)

@@ -5622,7 +5632,7 @@ the entire article will be yanked."
   (interactive "P")
   (let ((article (cdr gnus-article-current))
        contents)
   (interactive "P")
   (let ((article (cdr gnus-article-current))
        contents)

-    (if (not (gnus-mark-active-p))
+    (if (not (gnus-region-active-p))

        (with-current-buffer gnus-summary-buffer
          (gnus-summary-reply (list (list article)) wide))
       (setq contents (buffer-substring (point) (mark t)))
        (with-current-buffer gnus-summary-buffer
          (gnus-summary-reply (list (list article)) wide))
       (setq contents (buffer-substring (point) (mark t)))

@@ -5641,7 +5651,7 @@ the entire article will be yanked."
   (interactive)
   (let ((article (cdr gnus-article-current))
        contents)
   (interactive)
   (let ((article (cdr gnus-article-current))
        contents)

-      (if (not (gnus-mark-active-p))
+      (if (not (gnus-region-active-p))

          (with-current-buffer gnus-summary-buffer
            (gnus-summary-followup (list (list article))))
        (setq contents (buffer-substring (point) (mark t)))
          (with-current-buffer gnus-summary-buffer
            (gnus-summary-followup (list (list article))))
        (setq contents (buffer-substring (point) (mark t)))

@@ -6555,7 +6565,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)

@@ -6637,16 +6647,16 @@ positives are possible."
     (gnus-button-url-regexp
      0 (>= gnus-button-browse-level 0) browse-url 0)
     ;; man pages
     (gnus-button-url-regexp
      0 (>= gnus-button-browse-level 0) browse-url 0)
     ;; man pages

-    ("\\b\\([a-z][a-z]+\\)([1-9])\\W"
+    ("\\b\\([a-z][a-z]+([1-9])\\)\\W"

      0 (and (>= gnus-button-man-level 1) (< gnus-button-man-level 3))
      gnus-button-handle-man 1)
     ;; more man pages: resolv.conf(5), iso_8859-1(7), xterm(1x)
      0 (and (>= gnus-button-man-level 1) (< gnus-button-man-level 3))
      gnus-button-handle-man 1)
     ;; more man pages: resolv.conf(5), iso_8859-1(7), xterm(1x)

-    ("\\b\\([a-z][-_.a-z0-9]+\\)([1-9])\\W"
+    ("\\b\\([a-z][-_.a-z0-9]+([1-9])\\)\\W"

      0 (and (>= gnus-button-man-level 3) (< gnus-button-man-level 5))
      gnus-button-handle-man 1)
     ;; even more: Apache::PerlRun(3pm), PDL::IO::FastRaw(3pm),
     ;; SoWWWAnchor(3iv), XSelectInput(3X11), X(1), X(7)
      0 (and (>= gnus-button-man-level 3) (< gnus-button-man-level 5))
      gnus-button-handle-man 1)
     ;; even more: Apache::PerlRun(3pm), PDL::IO::FastRaw(3pm),
     ;; SoWWWAnchor(3iv), XSelectInput(3X11), X(1), X(7)

-    ("\\b\\([a-z][-+_.:a-z0-9]+\\)([1-9][X1a-z]*)\\W\\|\\b\\(X\\)([1-9])\\W"
+    ("\\b\\(\\(?:[a-z][-+_.:a-z0-9]+([1-9][X1a-z]*)\\)\\|\\b\\(?:X([1-9])\\)\\)\\W"

      0 (>= gnus-button-man-level 5) gnus-button-handle-man 1)
     ;; MID or mail: To avoid too many false positives we don't try to catch
     ;; all kind of allowed MIDs or mail addresses.  Domain part must contain
      0 (>= gnus-button-man-level 5) gnus-button-handle-man 1)
     ;; MID or mail: To avoid too many false positives we don't try to catch
     ;; all kind of allowed MIDs or mail addresses.  Domain part must contain

@@ -6690,7 +6700,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))

@@ -6714,13 +6724,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)

@@ -7058,6 +7061,10 @@ specified by `gnus-button-alist'."
 
 (defun gnus-button-handle-man (url)
   "Fetch a man page."
 
 (defun gnus-button-handle-man (url)
   "Fetch a man page."

+  (gnus-message 9 "`%s' `%s'" gnus-button-man-handler url)
+  (when (eq gnus-button-man-handler 'woman)
+    (setq url (gnus-replace-in-string url "([1-9][X1a-z]*).*\\'" "")))
+  (gnus-message 9 "`%s' `%s'" gnus-button-man-handler url)

   (funcall gnus-button-man-handler url))
 
 (defun gnus-button-handle-info-url (url)
   (funcall gnus-button-man-handler url))
 
 (defun gnus-button-handle-info-url (url)