2000-10-07 08:19:17 ShengHuo ZHU <zsh@cs.rochester.edu>
[gnus] / lisp / gnus-art.el
index e7547f6..d8f5fe0 100644 (file)
@@ -1,5 +1,5 @@
 ;;; gnus-art.el --- article mode commands for Gnus
-;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news
 
 (eval-when-compile (require 'cl))
 
-(require 'custom)
 (require 'gnus)
 (require 'gnus-sum)
 (require 'gnus-spec)
 (require 'gnus-int)
-(require 'browse-url)
 (require 'mm-bodies)
 (require 'mail-parse)
 (require 'mm-decode)
@@ -169,8 +167,8 @@ Possible values in this list are `empty', `newsgroups', `followup-to',
              (const :tag "Followup-to identical to newsgroups." followup-to)
              (const :tag "Reply-to identical to from." reply-to)
              (const :tag "Date less than four days old." date)
-             (const :tag "Very long To header." long-to)
-             (const :tag "Multiple To headers." many-to))
+             (const :tag "Very long To and/or Cc header." long-to)
+             (const :tag "Multiple To and/or Cc headers." many-to))
   :group 'gnus-article-hiding)
 
 (defcustom gnus-signature-separator '("^-- $" "^-- *$")
@@ -200,12 +198,20 @@ regexp.  If it matches, the text in question is not a signature."
   :type 'sexp
   :group 'gnus-article-hiding)
 
+;; Fixme: This isn't the right thing for mixed graphical and and
+;; non-graphical frames in a session.
+;; gnus-xmas.el overrides this for XEmacs.
 (defcustom gnus-article-x-face-command
-  "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | display -"
+  (if (and (fboundp 'image-type-available-p)
+          (image-type-available-p 'xbm))
+      'gnus-article-display-xface
+    "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | display -")
   "*String or function to be executed to display an X-Face header.
 If it is a string, the command will be executed in a sub-shell
 asynchronously.         The compressed face will be piped to this command."
-  :type 'string                                ;Leave function case to Lisp.
+  :type '(choice string
+                (function-item gnus-article-display-xface)
+                function)
   :group 'gnus-article-washing)
 
 (defcustom gnus-article-x-face-too-ugly nil
@@ -213,6 +219,13 @@ asynchronously.     The compressed face will be piped to this command."
   :type '(choice regexp (const nil))
   :group 'gnus-article-washing)
 
+(defcustom gnus-article-banner-alist nil
+  "Banner alist for stripping.
+For example, 
+     ((egroups . \"^[ \\t\\n]*-------------------+\\\\( eGroups Sponsor -+\\\\)?....\\n\\\\(.+\\n\\\\)+\"))"
+  :type '(repeat (cons symbol regexp))
+  :group 'gnus-article-washing)
+
 (defcustom gnus-emphasis-alist
   (let ((format
         "\\(\\s-\\|^\\|[-\"]\\|\\s(\\)\\(%s\\(\\w+\\(\\s-+\\w+\\)*[.,]?\\)%s\\)\\(\\s-\\|[-,;:\"]\\s-\\|[?!.]+\\s-\\|\\s)\\)")
@@ -249,6 +262,14 @@ is the face used for highlighting."
                       face))
   :group 'gnus-article-emphasis)
 
+(defcustom gnus-emphasize-whitespace-regexp "^[ \t]+\\|[ \t]*\n"
+  "A regexp to describe whitespace which should not be emphasized.
+Typical values are \"^[ \\t]+\\\\|[ \\t]*\\n\" and \"[ \\t]+\\\\|[ \\t]*\\n\".
+The former avoids underlining of leading and trailing whitespace,
+and the latter avoids underlining any whitespace at all."
+  :group 'gnus-article-emphasis
+  :type 'regexp)
+
 (defface gnus-emphasis-bold '((t (:bold t)))
   "Face used for displaying strong emphasized text (*word*)."
   :group 'gnus-article-emphasis)
@@ -633,6 +654,20 @@ used."
                :value undisplayed-alternative)
          (function)))
 
+(defcustom gnus-mime-action-alist
+  '(("save to file" . gnus-mime-save-part)
+    ("display as text" . gnus-mime-inline-part)
+    ("view the part" . gnus-mime-view-part)
+    ("pipe to command" . gnus-mime-pipe-part)
+    ("toggle display" . gnus-article-press-button)
+    ("view as type" . gnus-mime-view-part-as-type)
+    ("internalize type" . gnus-mime-internalize-part)
+    ("externalize type" . gnus-mime-externalize-part))
+  "An alist of actions that run on the MIME attachment."
+  :group 'gnus-article-mime
+  :type '(repeat (cons (string :tag "name")
+                      (function))))
+
 ;;;
 ;;; The treatment variables
 ;;;
@@ -857,8 +892,11 @@ See the manual for details."
   :type gnus-article-treat-custom)
 (put 'gnus-treat-overstrike 'highlight t)
 
-(defcustom gnus-treat-display-xface (if (and gnus-xemacs (featurep 'xface))
-                                       'head nil)
+(defcustom gnus-treat-display-xface 
+  (and (or (and (fboundp 'image-type-available-p)
+               (image-type-available-p 'xbm))
+          (and gnus-xemacs (featurep 'xface)))
+       'head)
   "Display X-Face headers.
 Valid values are nil, t, `head', `last', an integer or a predicate.
 See the manual for details."
@@ -1168,11 +1206,15 @@ always hide."
                              4))
                  (gnus-article-hide-header "date"))))
             ((eq elem 'long-to)
-             (let ((to (message-fetch-field "to")))
+             (let ((to (message-fetch-field "to"))
+                   (cc (message-fetch-field "cc")))
                (when (> (length to) 1024)
-                 (gnus-article-hide-header "to"))))
+                 (gnus-article-hide-header "to"))
+               (when (> (length cc) 1024)
+                 (gnus-article-hide-header "cc"))))
             ((eq elem 'many-to)
-             (let ((to-count 0))
+             (let ((to-count 0)
+                   (cc-count 0))
                (goto-char (point-min))
                (while (re-search-forward "^to:" nil t)
                  (setq to-count (1+ to-count)))
@@ -1184,7 +1226,19 @@ always hide."
                      (forward-line -1)
                      (narrow-to-region (point) (point-max))
                      (gnus-article-hide-header "to"))
-                   (setq to-count (1- to-count)))))))))))))
+                   (setq to-count (1- to-count))))
+               (goto-char (point-min))
+               (while (re-search-forward "^cc:" nil t)
+                 (setq cc-count (1+ cc-count)))
+               (when (> cc-count 1)
+                 (while (> cc-count 0)
+                   (goto-char (point-min))
+                   (save-restriction
+                     (re-search-forward "^cc:" nil nil cc-count)
+                     (forward-line -1)
+                     (narrow-to-region (point) (point-max))
+                     (gnus-article-hide-header "cc"))
+                   (setq cc-count (1- cc-count)))))))))))))
 
 (defun gnus-article-hide-header (header)
   (save-excursion
@@ -1426,7 +1480,7 @@ If PROMPT (the prefix), prompt for a coding system to use."
                             (set-buffer gnus-summary-buffer)
                           (error))
                         gnus-newsgroup-ignored-charsets))
-       ct cte ctl charset)
+       ct cte ctl charset format)
   (save-excursion
     (save-restriction
       (article-narrow-to-head)
@@ -1438,7 +1492,8 @@ If PROMPT (the prefix), prompt for a coding system to use."
                     (prompt
                      (mm-read-coding-system "Charset to decode: "))
                     (ctl
-                     (mail-content-type-get ctl 'charset))))
+                     (mail-content-type-get ctl 'charset)))
+           format (and ctl (mail-content-type-get ctl 'format)))
       (when cte
        (setq cte (mail-header-strip cte)))
       (if (and ctl (not (string-match "/" (car ctl)))) 
@@ -1447,8 +1502,13 @@ If PROMPT (the prefix), prompt for a coding system to use."
     (forward-line 1)
     (save-restriction
       (narrow-to-region (point) (point-max))
+      (when (and (eq mail-parse-charset 'gnus-decoded)
+                (eq (mm-body-7-or-8) '8bit))
+       ;; The text code could have been decoded.
+       (setq charset mail-parse-charset))
       (when (and (or (not ctl)
-                    (equal (car ctl) "text/plain")))
+                    (equal (car ctl) "text/plain"))
+                (not format)) ;; article with format will decode later.
        (mm-decode-body
         charset (and cte (intern (downcase
                                   (gnus-strip-whitespace cte))))
@@ -1474,14 +1534,55 @@ If FORCE, decode the article whether it is marked as quoted-printable
 or not."
   (interactive (list 'force))
   (save-excursion
-    (let ((buffer-read-only nil)
-         (type (gnus-fetch-field "content-transfer-encoding"))
-         (charset gnus-newsgroup-charset))
+    (let ((buffer-read-only nil) type charset)
+      (if (gnus-buffer-live-p gnus-original-article-buffer)
+         (with-current-buffer gnus-original-article-buffer
+           (setq type
+                 (gnus-fetch-field "content-transfer-encoding"))
+           (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)))
+             (if (stringp charset)
+                 (setq charset (intern (downcase charset)))))))
+      (unless charset 
+       (setq charset gnus-newsgroup-charset))
       (when (or force
                (and type (string-match "quoted-printable" (downcase type))))
        (article-goto-body)
        (quoted-printable-decode-region (point) (point-max) charset)))))
 
+(defun article-de-base64-unreadable (&optional force)
+  "Translate a base64 article.
+If FORCE, decode the article whether it is marked as base64 not."
+  (interactive (list 'force))
+  (save-excursion
+    (let ((buffer-read-only nil) type charset)
+      (if (gnus-buffer-live-p gnus-original-article-buffer)
+         (with-current-buffer gnus-original-article-buffer
+           (setq type
+                 (gnus-fetch-field "content-transfer-encoding"))
+           (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)))
+             (if (stringp charset)
+                 (setq charset (intern (downcase charset)))))))
+      (unless charset 
+       (setq charset gnus-newsgroup-charset))
+      (when (or force
+               (and type (string-match "base64" (downcase type))))
+       (article-goto-body)
+       (save-restriction
+         (narrow-to-region (point) (point-max))
+         (base64-decode-region (point-min) (point-max))
+         (if (mm-coding-system-p charset)
+             (mm-decode-coding-region (point-min) (point-max) charset)))))))
+
 (eval-when-compile
   (require 'rfc1843))
 
@@ -1493,6 +1594,35 @@ or not."
     (let ((buffer-read-only nil))
       (rfc1843-decode-region (point-min) (point-max)))))
 
+(defun article-wash-html ()
+  "Format an html article."
+  (interactive)
+  (save-excursion
+    (let ((buffer-read-only nil)
+         charset)
+      (if (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)))
+             (if (stringp charset)
+                 (setq charset (intern (downcase charset)))))))
+      (unless charset 
+       (setq charset gnus-newsgroup-charset))
+      (article-goto-body)
+      (save-window-excursion
+       (save-restriction
+         (narrow-to-region (point) (point-max))
+         (mm-setup-w3)
+         (let ((w3-strict-width (window-width))
+               (url-standalone-mode t))
+           (condition-case var
+               (w3-region (point-min) (point-max))
+             (error))))))))
+
 (defun article-hide-list-identifiers ()
   "Remove list identifies from the Subject header.
 The `gnus-list-identifiers' variable specifies what to do."
@@ -1507,9 +1637,14 @@ The `gnus-list-identifiers' variable specifies what to do."
          (when regexp
            (goto-char (point-min))
            (when (re-search-forward
-                  (concat "^Subject: +\\(Re: +\\)?\\(" regexp " *\\)")
+                  (concat "^Subject: +\\(\\(\\(Re: +\\)?\\(" regexp 
+                          " *\\)\\)+\\(Re: +\\)?\\)")
                   nil t)
-             (delete-region (match-beginning 2) (match-end 0)))))))))
+             (let ((s (or (match-string 3) (match-string 5))))
+               (delete-region (match-beginning 1) (match-end 1))
+               (when s
+                 (goto-char (match-beginning 1))
+                 (insert s))))))))))
 
 (defun article-hide-pgp ()
   "Remove any PGP headers and signatures in the current article."
@@ -1580,7 +1715,7 @@ always hide."
   (save-excursion
     (save-restriction
       (let ((inhibit-point-motion-hooks t)
-           (banner (gnus-group-get-parameter gnus-newsgroup-name 'banner))
+           (banner (gnus-group-find-parameter gnus-newsgroup-name 'banner))
            (gnus-signature-limit nil)
            buffer-read-only beg end)
        (when banner
@@ -1591,6 +1726,10 @@ always hide."
              (widen)
              (forward-line -1)
              (delete-region (point) (point-max))))
+          ((symbolp banner)
+           (if (setq banner (cdr (assq banner gnus-article-banner-alist)))
+               (while (re-search-forward banner nil t)
+                 (delete-region (match-beginning 0) (match-end 0)))))
           ((stringp banner)
            (while (re-search-forward banner nil t)
              (delete-region (match-beginning 0) (match-end 0))))))))))
@@ -2147,8 +2286,8 @@ This format is defined by the `gnus-article-time-format' variable."
   (let ((default-name
          (funcall function group headers (symbol-value variable)))
        result)
-    (setq
-     result
+    (setq result
+        (expand-file-name
      (cond
       ((eq filename 'default)
        default-name)
@@ -2213,10 +2352,10 @@ This format is defined by the `gnus-article-time-format' variable."
         (gnus-make-directory (file-name-directory file))
         ;; If we have read a directory, we append the default file name.
         (when (file-directory-p file)
-          (setq file (concat (file-name-as-directory file)
-                             (file-name-nondirectory default-name))))
+          (setq file (expand-file-name (file-name-nondirectory default-name)
+                                       (file-name-as-directory file))))
         ;; Possibly translate some characters.
-        (nnheader-translate-file-chars file)))))
+        (nnheader-translate-file-chars file))))))
     (gnus-make-directory (file-name-directory result))
     (set variable result)))
 
@@ -2374,17 +2513,6 @@ If variable `gnus-use-long-file-name' is non-nil, it is
        default
       (or last-file default))))
 
-(defun gnus-Plain-save-name (newsgroup headers &optional last-file)
-  "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
-If variable `gnus-use-long-file-name' is non-nil, it is
-~/News/News.group.  Otherwise, it is like ~/News/news/group/news."
-  (or last-file
-      (expand-file-name
-       (if (gnus-use-long-file-name 'not-save)
-          (gnus-capitalize-newsgroup newsgroup)
-        (concat (gnus-newsgroup-directory-form newsgroup) "/news"))
-       gnus-article-save-directory)))
-
 (defun gnus-plain-save-name (newsgroup headers &optional last-file)
   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
 If variable `gnus-use-long-file-name' is non-nil, it is
@@ -2393,7 +2521,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is
       (expand-file-name
        (if (gnus-use-long-file-name 'not-save)
           newsgroup
-        (concat (gnus-newsgroup-directory-form newsgroup) "/news"))
+        (expand-file-name "news" (gnus-newsgroup-directory-form newsgroup)))
        gnus-article-save-directory)))
 
 (eval-and-compile
@@ -2405,17 +2533,16 @@ If variable `gnus-use-long-file-name' is non-nil, it is
                 gfunc (cdr func))
         (setq afunc func
               gfunc (intern (format "gnus-%s" func))))
-       (fset gfunc
-            (if (not (fboundp afunc))
-                nil
-              `(lambda (&optional interactive &rest args)
-                 ,(documentation afunc t)
-                 (interactive (list t))
-                 (save-excursion
-                   (set-buffer gnus-article-buffer)
-                   (if interactive
-                       (call-interactively ',afunc)
-                     (apply ',afunc args))))))))
+       (defalias gfunc
+        (if (fboundp afunc)
+          `(lambda (&optional interactive &rest args)
+             ,(documentation afunc t)
+             (interactive (list t))
+             (save-excursion
+               (set-buffer gnus-article-buffer)
+               (if interactive
+                   (call-interactively ',afunc)
+                 (apply ',afunc args))))))))
    '(article-hide-headers
      article-hide-boring-headers
      article-treat-overstrike
@@ -2424,8 +2551,9 @@ If variable `gnus-use-long-file-name' is non-nil, it is
      article-remove-cr
      article-display-x-face
      article-de-quoted-unreadable
+     article-de-base64-unreadable
      article-decode-HZ
-     article-mime-decode-quoted-printable
+     article-wash-html
      article-hide-list-identifiers
      article-hide-pgp
      article-strip-banner
@@ -2509,6 +2637,8 @@ If variable `gnus-use-long-file-name' is non-nil, it is
        ["Treat overstrike" gnus-article-treat-overstrike t]
        ["Remove carriage return" gnus-article-remove-cr t]
        ["Remove quoted-unreadable" gnus-article-de-quoted-unreadable t]
+       ["Remove base64" gnus-article-de-base64-unreadable t]
+       ["Treat html" gnus-article-wash-html t]
        ["Decode HZ" gnus-article-decode-HZ t]))
 
     ;; Note "Commands" menu is defined in gnus-sum.el for consistency
@@ -2550,7 +2680,7 @@ commands:
   (make-local-variable 'gnus-article-mime-handles)
   (make-local-variable 'gnus-article-decoded-p)
   (make-local-variable 'gnus-article-mime-handle-alist)
-  (make-local-variable 'gnus-article-washed-types)
+  (make-local-variable 'gnus-article-wash-types)
   (gnus-set-default-directory)
   (buffer-disable-undo)
   (setq buffer-read-only t)
@@ -2586,9 +2716,11 @@ commands:
     (if (get-buffer name)
        (save-excursion
          (set-buffer name)
-         (if gnus-article-mime-handles
-             (mm-destroy-parts gnus-article-mime-handles))
-         (kill-all-local-variables)
+         (when gnus-article-mime-handles
+           (mm-destroy-parts gnus-article-mime-handles)
+           (setq gnus-article-mime-handles nil))
+         ;; Set it to nil in article-buffer!
+         (setq gnus-article-mime-handle-alist nil) 
          (buffer-disable-undo)
          (setq buffer-read-only t)
          (unless (eq major-mode 'gnus-article-mode)
@@ -2655,8 +2787,7 @@ If ALL-HEADERS is non-nil, no headers are hidden."
                      (message "Message marked for downloading"))
                  (gnus-summary-mark-article article gnus-canceled-mark)
                  (unless (memq article gnus-newsgroup-sparse)
-                   (gnus-error 1
-                               "No such article (may have expired or been canceled)")))))
+                   (gnus-error 1 "No such article (may have expired or been canceled)")))))
          (if (or (eq result 'pseudo)
                  (eq result 'nneething))
              (progn
@@ -2707,6 +2838,8 @@ If ALL-HEADERS is non-nil, no headers are hidden."
                (gnus-set-global-variables)
                (setq gnus-have-all-headers
                      (or all-headers gnus-show-all-headers))))
+           (save-excursion
+             (gnus-configure-windows 'article))
            (when (or (numberp article)
                      (stringp article))
              (gnus-article-prepare-display)
@@ -2772,22 +2905,22 @@ If ALL-HEADERS is non-nil, no headers are hidden."
     (gnus-mime-inline-part "i" "View As Text, In This Buffer")
     (gnus-mime-internalize-part "E" "View Internally")
     (gnus-mime-externalize-part "e" "View Externally")
-    (gnus-mime-pipe-part "|" "Pipe To Command...")))
+    (gnus-mime-pipe-part "|" "Pipe To Command...")
+    (gnus-mime-action-on-part "." "Take action on the part")))
 
 (defun gnus-article-mime-part-status ()
   (if gnus-article-mime-handle-alist-1
       (format " (%d parts)" (length gnus-article-mime-handle-alist-1))
     ""))
 
-(defvar gnus-mime-button-map nil)
-(unless gnus-mime-button-map
-  (setq gnus-mime-button-map (make-sparse-keymap))
-  (set-keymap-parent gnus-mime-button-map gnus-article-mode-map)
-  (define-key gnus-mime-button-map gnus-mouse-2 'gnus-article-push-button)
-  (define-key gnus-mime-button-map gnus-down-mouse-3 'gnus-mime-button-menu)
-  (mapcar (lambda (c)
-           (define-key gnus-mime-button-map (cadr c) (car c)))
-         gnus-mime-button-commands))
+(defvar gnus-mime-button-map
+  (let ((map (make-sparse-keymap)))
+    (set-keymap-parent map gnus-article-mode-map)
+    (define-key map gnus-mouse-2 'gnus-article-push-button)
+    (define-key map gnus-down-mouse-3 'gnus-mime-button-menu)
+    (dolist (c gnus-mime-button-commands)
+      (define-key map (cadr c) (car c)))
+    map))
 
 (defun gnus-mime-button-menu (event)
   "Construct a context-sensitive menu of MIME commands."
@@ -2803,7 +2936,7 @@ If ALL-HEADERS is non-nil, no headers are hidden."
                                           (cons (caddr c) (car c)))
                                         gnus-mime-button-commands))))))
        (if response
-           (funcall response))))))
+           (call-interactively response))))))
 
 (defun gnus-mime-view-all-parts (&optional handles)
   "View all the MIME parts."
@@ -2853,7 +2986,7 @@ If ALL-HEADERS is non-nil, no headers are hidden."
   (interactive
    (list (completing-read
          "View as MIME type: "
-         (mapcar (lambda (i) (list i i)) (mailcap-mime-types))
+         (mapcar #'list (mailcap-mime-types))
          nil nil
          (gnus-mime-view-part-as-type-internal))))
   (gnus-article-check-buffer)
@@ -2891,19 +3024,31 @@ If ALL-HEADERS is non-nil, no headers are hidden."
       (setq buffer-file-name nil))
     (goto-char (point-min))))
 
-(defun gnus-mime-inline-part (&optional handle)
+(defun gnus-mime-inline-part (&optional handle arg)
   "Insert the MIME part under point into the current buffer."
-  (interactive)
+  (interactive (list nil current-prefix-arg))
   (gnus-article-check-buffer)
   (let* ((handle (or handle (get-text-property (point) 'gnus-data)))
-        contents
+        contents charset
         (b (point))
         buffer-read-only)
     (if (mm-handle-undisplayer handle)
        (mm-remove-part handle)
       (setq contents (mm-get-part handle))
+      (cond
+       ((not arg)
+       (setq charset (or (mail-content-type-get
+                          (mm-handle-type handle) 'charset)
+                         gnus-newsgroup-charset)))
+       ((numberp arg)
+       (setq charset
+             (or (cdr (assq arg 
+                            gnus-summary-show-article-charset-alist))
+                 (read-coding-system "Charset: ")))))
       (forward-line 2)
-      (mm-insert-inline handle contents)
+      (mm-insert-inline handle (if charset 
+                                  (mm-decode-coding-string contents charset)
+                                contents))
       (goto-char b))))
 
 (defun gnus-mime-externalize-part (&optional handle)
@@ -2912,7 +3057,7 @@ If ALL-HEADERS is non-nil, no headers are hidden."
   (gnus-article-check-buffer)
   (let* ((handle (or handle (get-text-property (point) 'gnus-data)))
         (mm-user-display-methods nil)
-        (mm-inline-large-images nil)
+        (mm-inlined-types nil)
         (mail-parse-charset gnus-newsgroup-charset)
         (mail-parse-ignored-charsets 
          (save-excursion (set-buffer gnus-summary-buffer)
@@ -2937,6 +3082,16 @@ In no internal viewer is available, use an external viewer."
        (mm-remove-part handle)
       (mm-display-part handle))))
 
+(defun gnus-mime-action-on-part (&optional action)
+  "Do something with the MIME attachment at \(point\)."
+  (interactive
+   (list (completing-read "Action: " gnus-mime-action-alist)))
+  (gnus-article-check-buffer)
+  (let ((action-pair (assoc action gnus-mime-action-alist)))
+    (if action-pair
+       (funcall (cdr action-pair)))))
+
+
 (defun gnus-article-part-wrapper (n function)
   (save-current-buffer
     (set-buffer gnus-article-buffer)
@@ -3097,21 +3252,30 @@ In no internal viewer is available, use an external viewer."
                 article-type annotation
                 gnus-data ,handle))
     (setq e (point))
-    (widget-convert-button 'link b e
-                          :mime-handle handle
-                          :action 'gnus-widget-press-button
-                          :button-keymap gnus-mime-button-map
-                          :help-echo
-                          (lambda (widget)
-                            ;; Needed to properly clear the message
-                            ;; due to a bug in wid-edit
-                            (setq help-echo-owns-message t)
-                            (format
-                             "Click to %s the MIME part; %s for more options"
-                             (if (mm-handle-displayed-p
-                                  (widget-get widget :mime-handle))
-                                 "hide" "show")
-                             (if gnus-xemacs "button3" "mouse-3"))))))
+    (widget-convert-button
+     'link b e
+     :mime-handle handle
+     :action 'gnus-widget-press-button
+     :button-keymap gnus-mime-button-map
+     :help-echo
+     (lambda (widget/window &optional overlay pos)
+       ;; Needed to properly clear the message due to a bug in
+       ;; wid-edit (XEmacs only).
+       (if (boundp 'help-echo-owns-message)
+          (setq help-echo-owns-message t))
+       (format
+       "%S: %s the MIME part; %S: more options"
+       (aref gnus-mouse-2 0)
+       ;; XEmacs will get a single widget arg; Emacs 21 will get
+       ;; window, overlay, position.
+       (if (mm-handle-displayed-p
+            (if overlay
+                (with-current-buffer (gnus-overlay-buffer overlay)
+                  (widget-get (widget-at (gnus-overlay-start overlay))
+                              :mime-handle))
+              (widget-get widget/window :mime-handle)))
+           "hide" "show")
+       (aref gnus-down-mouse-3 0))))))
 
 (defun gnus-widget-press-button (elems el)
   (goto-char (widget-get elems :from))
@@ -3390,7 +3554,7 @@ In no internal viewer is available, use an external viewer."
              (if overstrike ?o ? )
              (if emphasis ?e ? )))))
 
-(fset 'gnus-article-hide-headers-if-wanted 'gnus-article-maybe-hide-headers)
+(defalias 'gnus-article-hide-headers-if-wanted 'gnus-article-maybe-hide-headers)
 
 (defun gnus-article-maybe-hide-headers ()
   "Hide unwanted headers if `gnus-have-all-headers' is nil.
@@ -3602,7 +3766,8 @@ Argument LINES specifies lines to be scrolled down."
             ;; We disable the pick minor mode commands.
             (let (gnus-pick-mode)
               (setq func (lookup-key (current-local-map) keys))))
-          (if (not func)
+          (if (or (not func)
+                 (numberp func))
               (ding)
             (unless (member keys nosave-in-article)
               (set-buffer gnus-article-current-summary))
@@ -3715,11 +3880,11 @@ If given a prefix, show the hidden text instead."
                               gnus-newsgroup-name)))
                  (when (and (eq (car method) 'nneething)
                             (vectorp header))
-                   (let ((dir (concat
+                   (let ((dir (expand-file-name
+                               (mail-header-subject header)
                                (file-name-as-directory
                                 (or (cadr (assq 'nneething-address method))
-                                    (nth 1 method)))
-                               (mail-header-subject header))))
+                                    (nth 1 method))))))
                      (when (file-directory-p dir)
                        (setq article 'nneething)
                        (gnus-group-enter-directory dir))))))))
@@ -3957,7 +4122,7 @@ groups."
   "Exit the article editing without updating."
   (interactive)
   ;; We remove all text props from the article buffer.
-  (let ((buf (format "%s" (buffer-string)))
+  (let ((buf (buffer-substring-no-properties (point-min) (point-max)))
        (curbuf (current-buffer))
        (p (point))
        (window-start (window-start)))
@@ -3989,7 +4154,7 @@ groups."
 
 ;;; Internal Variables:
 
-(defcustom gnus-button-url-regexp "\\b\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\):\\(//[-a-zA-Z0-9_.]+:[0-9]*\\)?\\([-a-zA-Z0-9_=!?#$@~`%&*+|\\/:;.,]\\|\\w\\)+\\([-a-zA-Z0-9_=#$@~`%&*+|\\/]\\|\\w\\)"
+(defcustom gnus-button-url-regexp "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\):\\)\\(//[-a-zA-Z0-9_.]+:[0-9]*\\)?\\([-a-zA-Z0-9_=!?#$@~`%&*+|\\/:;.,]\\|\\w\\)+\\([-a-zA-Z0-9_=#$@~`%&*+|\\/]\\|\\w\\)\\)"
   "Regular expression that matches URLs."
   :group 'gnus-article-buttons
   :type 'regexp)
@@ -4564,7 +4729,11 @@ For example:
        val elem)
     (gnus-run-hooks 'gnus-part-display-hook)
     (while (setq elem (pop alist))
-      (setq val (symbol-value (car elem)))
+      (setq val
+           (save-excursion
+             (if (gnus-buffer-live-p gnus-summary-buffer)
+                 (set-buffer gnus-summary-buffer))
+             (symbol-value (car elem))))
       (when (and (or (consp val)
                     treated-type)
                 (gnus-treat-predicate val)
@@ -4574,11 +4743,13 @@ For example:
          (funcall (cadr elem)))))))
 
 ;; Dynamic variables.
-(defvar part-number)
-(defvar total-parts)
-(defvar type)
-(defvar condition)
-(defvar length)
+(eval-when-compile
+  (defvar part-number)
+  (defvar total-parts)
+  (defvar type)
+  (defvar condition)
+  (defvar length))
+
 (defun gnus-treat-predicate (val)
   (cond
    ((null val)