X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-art.el;h=aa16a2166c3bff54abbe46d71bdd67e7ea88a5f5;hb=a0b4fd43824faeaaf14eaf7673a8204f5b16c941;hp=abe618fb683cb203b43ffb716da6ed1135c2e725;hpb=bbaa6736e285258f29be9409b7b75751bb847e96;p=gnus

diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el
index abe618fb6..aa16a2166 100644
--- a/lisp/gnus-art.el
+++ b/lisp/gnus-art.el
@@ -1,6 +1,7 @@
 ;;; gnus-art.el --- article mode commands for Gnus
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
-;;        Free Software Foundation, Inc.
+
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
+;;   2005 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news
@@ -19,8 +20,8 @@
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 ;;; Commentary:
 
@@ -31,7 +32,10 @@
   (defvar tool-bar-map))
 
 (require 'gnus)
-(require 'gnus-sum)
+;; Avoid the "Recursive load suspected" error in Emacs 21.1.
+(eval-and-compile
+  (let ((recursive-load-depth-limit 100))
+    (require 'gnus-sum)))
 (require 'gnus-spec)
 (require 'gnus-int)
 (require 'gnus-win)
@@ -46,6 +50,7 @@
 (autoload 'gnus-msg-mail "gnus-msg" nil t)
 (autoload 'gnus-button-mailto "gnus-msg")
 (autoload 'gnus-button-reply "gnus-msg" nil t)
+(autoload 'parse-time-string "parse-time" nil nil)
 (autoload 'ansi-color-apply-on-region "ansi-color")
 
 (defgroup gnus-article nil
@@ -214,6 +219,7 @@ By default, if you set this t, then Gnus will display citations and
 signatures, but will never scroll down to show you a page consisting
 only of boring text.  Boring text is controlled by
 `gnus-article-boring-faces'."
+  :version "22.1"
   :type 'boolean
   :group 'gnus-article-hiding)
 
@@ -320,27 +326,62 @@ advertisements.  For example:
 		   (symbol :tag "Item in `gnus-article-banner-alist'" none)
 		   regexp
 		   (const :tag "None" nil))))
+  :version "22.1"
   :group 'gnus-article-washing)
 
+(defmacro gnus-emphasis-custom-with-format (&rest body)
+  `(let ((format "\
+\\(\\s-\\|^\\|\\=\\|[-\"]\\|\\s(\\)\\(%s\\(\\w+\\(\\s-+\\w+\\)*[.,]?\\)%s\\)\
+\\(\\([-,.;:!?\"]\\|\\s)\\)+\\s-\\|[?!.]\\s-\\|\\s)\\|\\s-\\)"))
+     ,@body))
+
+(defun gnus-emphasis-custom-value-to-external (value)
+  (gnus-emphasis-custom-with-format
+   (if (consp (car value))
+       (list (format format (car (car value)) (cdr (car value)))
+	     2
+	     (if (nth 1 value) 2 3)
+	     (nth 2 value))
+     value)))
+
+(defun gnus-emphasis-custom-value-to-internal (value)
+  (gnus-emphasis-custom-with-format
+   (let ((regexp (concat "\\`"
+			 (format (regexp-quote format)
+				 "\\([^()]+\\)" "\\([^()]+\\)")
+			 "\\'"))
+	 pattern)
+     (if (string-match regexp (setq pattern (car value)))
+	 (list (cons (match-string 1 pattern) (match-string 2 pattern))
+	       (= (nth 2 value) 2)
+	       (nth 3 value))
+       value))))
+
 (defcustom gnus-emphasis-alist
-  (let ((format
-	 "\\(\\s-\\|^\\|\\=\\|[-\"]\\|\\s(\\)\\(%s\\(\\w+\\(\\s-+\\w+\\)*[.,]?\\)%s\\)\\(\\([-,.;:!?\"]\\|\\s)\\)+\\s-\\|[?!.]\\s-\\|\\s)\\|\\s-\\)")
-	(types
-	 '(("\\*" "\\*" bold)
+  (let ((types
+	 '(("\\*" "\\*" bold nil 2)
 	   ("_" "_" underline)
 	   ("/" "/" italic)
 	   ("_/" "/_" underline-italic)
 	   ("_\\*" "\\*_" underline-bold)
 	   ("\\*/" "/\\*" bold-italic)
 	   ("_\\*/" "/\\*_" underline-bold-italic))))
-    `(,@(mapcar
-	 (lambda (spec)
-	   (list
-	    (format format (car spec) (cadr spec))
-	    2 3 (intern (format "gnus-emphasis-%s" (nth 2 spec)))))
-	 types)
-	("\\(\\s-\\|^\\)\\(_\\(\\(\\w\\|_[^_]\\)+\\)_\\)\\(\\s-\\|[?!.,;]\\)"
-	 2 3 gnus-emphasis-underline)))
+    (nconc
+     (gnus-emphasis-custom-with-format
+      (mapcar (lambda (spec)
+		(list (format format (car spec) (cadr spec))
+		      (or (nth 3 spec) 2)
+		      (or (nth 4 spec) 3)
+		      (intern (format "gnus-emphasis-%s" (nth 2 spec)))))
+	      types))
+     '(;; I've never seen anyone use this strikethru convention whereas I've
+       ;; several times seen it triggered by normal text.  --Stef
+       ;; Miles suggests that this form is sometimes used but for italics,
+       ;; so maybe we should map it to `italic'.
+       ;; ("\\(\\s-\\|^\\)\\(-\\(\\(\\w\\|-[^-]\\)+\\)-\\)\\(\\s-\\|[?!.,;]\\)"
+       ;; 2 3 gnus-emphasis-strikethru)
+       ("\\(\\s-\\|^\\)\\(_\\(\\(\\w\\|_[^_]\\)+\\)_\\)\\(\\s-\\|[?!.,;]\\)"
+	2 3 gnus-emphasis-underline))))
   "*Alist that says how to fontify certain phrases.
 Each item looks like this:
 
@@ -351,11 +392,43 @@ is a number that says what regular expression grouping used to find
 the entire emphasized word.  The third is a number that says what
 regexp grouping should be displayed and highlighted.  The fourth
 is the face used for highlighting."
-  :type '(repeat (list :value ("" 0 0 default)
-		       regexp
-		       (integer :tag "Match group")
-		       (integer :tag "Emphasize group")
-		       face))
+  :type
+  '(repeat
+    (menu-choice
+     :format "%[Customizing Style%]\n%v"
+     :indent 2
+     (group :tag "Default"
+	    :value ("" 0 0 default)
+	    :value-create
+	    (lambda (widget)
+	      (let ((value (widget-get
+			    (cadr (widget-get (widget-get widget :parent)
+					      :args))
+			    :value)))
+		(if (not (eq (nth 2 value) 'default))
+		    (widget-put
+		     widget
+		     :value
+		     (gnus-emphasis-custom-value-to-external value))))
+	      (widget-group-value-create widget))
+	    regexp
+	    (integer :format "Match group: %v")
+	    (integer :format "Emphasize group: %v")
+	    face)
+     (group :tag "Simple"
+	    :value (("_" . "_") nil default)
+	    (cons :format "%v"
+		  (regexp :format "Start regexp: %v")
+		  (regexp :format "End regexp: %v"))
+	    (boolean :format "Show start and end patterns: %[%v%]\n"
+		     :on " On " :off " Off ")
+	    face)))
+  :get (lambda (symbol)
+	 (mapcar 'gnus-emphasis-custom-value-to-internal
+		 (default-value symbol)))
+  :set (lambda (symbol value)
+	 (set-default symbol (mapcar 'gnus-emphasis-custom-value-to-external
+				     value)))
   :group 'gnus-article-emphasis)
 
 (defcustom gnus-emphasize-whitespace-regexp "^[ \t]+\\|[ \t]*\n"
@@ -419,9 +492,6 @@ be fed to `format-time-string'."
   :link '(custom-manual "(gnus)Article Date")
   :group 'gnus-article-washing)
 
-(eval-and-compile
-  (autoload 'mail-extract-address-components "mail-extr"))
-
 (defcustom gnus-save-all-headers t
   "*If non-nil, don't remove any headers before saving."
   :group 'gnus-article-saving
@@ -507,17 +577,19 @@ you could set this variable to something like:
  '((\"^Subject:.*gnus\\|^Newsgroups:.*gnus\" \"gnus-stuff\")
    (\"^Subject:.*vm\\|^Xref:.*vm\" \"vm-stuff\"))
 
-This variable is an alist where the where the key is the match and the
-value is a list of possible files to save in if the match is non-nil.
+This variable is an alist where the key is the match and the
+value is a list of possible files to save in if the match is
+non-nil.
 
 If the match is a string, it is used as a regexp match on the
 article.  If the match is a symbol, that symbol will be funcalled
-from the buffer of the article to be saved with the newsgroup as the
-parameter.  If it is a list, it will be evaled in the same buffer.
+from the buffer of the article to be saved with the newsgroup as
+the parameter.  If it is a list, it will be evaled in the same
+buffer.
 
-If this form or function returns a string, this string will be used as
-a possible file name; and if it returns a non-nil list, that list will
-be used as possible file names."
+If this form or function returns a string, this string will be
+used as a possible file name; and if it returns a non-nil list,
+that list will be used as possible file names."
   :group 'gnus-article-saving
   :type '(repeat (choice (list :value (fun) function)
 			 (cons :value ("" "") regexp (repeat string))
@@ -563,6 +635,13 @@ The following additional specs are available:
   :type 'hook
   :group 'gnus-article-various)
 
+(defcustom gnus-copy-article-ignored-headers nil
+  "List of headers to be removed when copying an article.
+Each element is a regular expression."
+  :version "23.0" ;; No Gnus
+  :type '(repeat regexp)
+  :group 'gnus-article-various)
+
 (make-obsolete-variable 'gnus-article-hide-pgp-hook
 			"This variable is obsolete in Gnus 5.10.")
 
@@ -582,21 +661,23 @@ above them."
   :type 'face
   :group 'gnus-article-buttons)
 
-(defcustom gnus-signature-face 'gnus-signature-face
+(defcustom gnus-signature-face 'gnus-signature
   "Face used for highlighting a signature in the article buffer.
-Obsolete; use the face `gnus-signature-face' for customizations instead."
+Obsolete; use the face `gnus-signature' for customizations instead."
   :type 'face
   :group 'gnus-article-highlight
   :group 'gnus-article-signature)
 
-(defface gnus-signature-face
+(defface gnus-signature
   '((t
      (:italic t)))
   "Face used for highlighting a signature in the article buffer."
   :group 'gnus-article-highlight
   :group 'gnus-article-signature)
+;; backward-compatibility alias
+(put 'gnus-signature-face 'face-alias 'gnus-signature)
 
-(defface gnus-header-from-face
+(defface gnus-header-from
   '((((class color)
       (background dark))
      (:foreground "spring green"))
@@ -608,8 +689,10 @@ Obsolete; use the face `gnus-signature-face' for customizations instead."
   "Face used for displaying from headers."
   :group 'gnus-article-headers
   :group 'gnus-article-highlight)
+;; backward-compatibility alias
+(put 'gnus-header-from-face 'face-alias 'gnus-header-from)
 
-(defface gnus-header-subject-face
+(defface gnus-header-subject
   '((((class color)
       (background dark))
      (:foreground "SeaGreen3"))
@@ -621,8 +704,10 @@ Obsolete; use the face `gnus-signature-face' for customizations instead."
   "Face used for displaying subject headers."
   :group 'gnus-article-headers
   :group 'gnus-article-highlight)
+;; backward-compatibility alias
+(put 'gnus-header-subject-face 'face-alias 'gnus-header-subject)
 
-(defface gnus-header-newsgroups-face
+(defface gnus-header-newsgroups
   '((((class color)
       (background dark))
      (:foreground "yellow" :italic t))
@@ -636,8 +721,10 @@ In the default setup this face is only used for crossposted
 articles."
   :group 'gnus-article-headers
   :group 'gnus-article-highlight)
+;; backward-compatibility alias
+(put 'gnus-header-newsgroups-face 'face-alias 'gnus-header-newsgroups)
 
-(defface gnus-header-name-face
+(defface gnus-header-name
   '((((class color)
       (background dark))
      (:foreground "SeaGreen"))
@@ -649,8 +736,10 @@ articles."
   "Face used for displaying header names."
   :group 'gnus-article-headers
   :group 'gnus-article-highlight)
+;; backward-compatibility alias
+(put 'gnus-header-name-face 'face-alias 'gnus-header-name)
 
-(defface gnus-header-content-face
+(defface gnus-header-content
   '((((class color)
       (background dark))
      (:foreground "forest green" :italic t))
@@ -661,12 +750,14 @@ articles."
      (:italic t)))  "Face used for displaying header content."
   :group 'gnus-article-headers
   :group 'gnus-article-highlight)
+;; backward-compatibility alias
+(put 'gnus-header-content-face 'face-alias 'gnus-header-content)
 
 (defcustom gnus-header-face-alist
-  '(("From" nil gnus-header-from-face)
-    ("Subject" nil gnus-header-subject-face)
-    ("Newsgroups:.*," nil gnus-header-newsgroups-face)
-    ("" gnus-header-name-face gnus-header-content-face))
+  '(("From" nil gnus-header-from)
+    ("Subject" nil gnus-header-subject)
+    ("Newsgroups:.*," nil gnus-header-newsgroups)
+    ("" gnus-header-name gnus-header-content))
   "*Controls highlighting of article headers.
 
 An alist of the form (HEADER NAME CONTENT).
@@ -745,7 +836,7 @@ If set, this variable overrides `gnus-unbuttonized-mime-types'.
 To see e.g. security buttons you could set this to
 `(\"multipart/signed\")'.
 This variable is only used when `gnus-inhibit-mime-unbuttonizing' is nil."
-  :version "21.1"
+  :version "22.1"
   :group 'gnus-article-mime
   :type '(repeat regexp))
 
@@ -754,7 +845,7 @@ This variable is only used when `gnus-inhibit-mime-unbuttonizing' is nil."
 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"
+  :version "22.1"
   :group 'gnus-article-mime
   :type 'boolean)
 
@@ -762,6 +853,7 @@ as described by the variables `gnus-buttonized-mime-types' and
   "String used to delimit header and body.
 This variable is used by `gnus-article-treat-body-boundary' which can
 be controlled by `gnus-treat-body-boundary'."
+  :version "22.1"
   :group 'gnus-article-various
   :type '(choice (item :tag "None" :value nil)
 		 string))
@@ -771,6 +863,7 @@ be controlled by `gnus-treat-body-boundary'."
   "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"
+  :version "22.1"
   :type '(repeat directory)
   :link '(url-link :tag "download"
 		   "http://www.cs.indiana.edu/picons/ftp/index.html")
@@ -841,6 +934,19 @@ used."
   :type '(repeat (cons (string :tag "name")
 		       (function))))
 
+(defcustom gnus-auto-select-part 1
+  "Advance to next MIME part when deleting or stripping parts.
+
+When 0, point will be placed on the same part as before.  When
+positive (negative), move point forward (backwards) this many
+parts.  When nil, redisplay article."
+  :version "23.0" ;; No Gnus
+  :group 'gnus-article-mime
+  :type '(choice (const nil :tag "Redisplay article.")
+		 (const 1 :tag "Next part.")
+		 (const 0 :tag "Current part.")
+		 integer))
+
 ;;;
 ;;; The treatment variables
 ;;;
@@ -910,6 +1016,7 @@ See Info node `(gnus)Customizing Articles' for details."
   "Remove carriage returns.
 Valid values are nil, t, `head', `last', an integer or a predicate.
 See Info node `(gnus)Customizing Articles' for details."
+  :version "22.1"
   :group 'gnus-article-treat
   :link '(custom-manual "(gnus)Customizing Articles")
   :type gnus-article-treat-custom)
@@ -918,6 +1025,7 @@ See Info node `(gnus)Customizing Articles' for details."
   "Remove newlines from within URLs.
 Valid values are nil, t, `head', `last', an integer or a predicate.
 See Info node `(gnus)Customizing Articles' for details."
+  :version "22.1"
   :group 'gnus-article-treat
   :link '(custom-manual "(gnus)Customizing Articles")
   :type gnus-article-treat-custom)
@@ -926,6 +1034,7 @@ See Info node `(gnus)Customizing Articles' for details."
   "Remove leading whitespace in headers.
 Valid values are nil, t, `head', `last', an integer or a predicate.
 See Info node `(gnus)Customizing Articles' for details."
+  :version "22.1"
   :group 'gnus-article-treat
   :link '(custom-manual "(gnus)Customizing Articles")
   :type gnus-article-treat-custom)
@@ -1045,6 +1154,7 @@ See Info node `(gnus)Customizing Articles' for details."
   "Display the Date in a format that can be read aloud in English.
 Valid values are nil, t, `head', `last', an integer or a predicate.
 See Info node `(gnus)Customizing Articles' for details."
+  :version "22.1"
   :group 'gnus-article-treat
   :link '(custom-manual "(gnus)Customizing Articles")
   :type gnus-article-treat-head-custom)
@@ -1120,6 +1230,7 @@ See Info node `(gnus)Customizing Articles' for details."
   "Unfold folded header lines.
 Valid values are nil, t, `head', `last', an integer or a predicate.
 See Info node `(gnus)Customizing Articles' for details."
+  :version "22.1"
   :group 'gnus-article-treat
   :link '(custom-manual "(gnus)Customizing Articles")
   :type gnus-article-treat-custom)
@@ -1128,6 +1239,7 @@ See Info node `(gnus)Customizing Articles' for details."
   "Fold headers.
 Valid values are nil, t, `head', `last', an integer or a predicate.
 See Info node `(gnus)Customizing Articles' for details."
+  :version "22.1"
   :group 'gnus-article-treat
   :link '(custom-manual "(gnus)Customizing Articles")
   :type gnus-article-treat-custom)
@@ -1136,6 +1248,7 @@ See Info node `(gnus)Customizing Articles' for details."
   "Fold the Newsgroups and Followup-To headers.
 Valid values are nil, t, `head', `last', an integer or a predicate.
 See Info node `(gnus)Customizing Articles' for details."
+  :version "22.1"
   :group 'gnus-article-treat
   :link '(custom-manual "(gnus)Customizing Articles")
   :type gnus-article-treat-custom)
@@ -1209,7 +1322,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
-  :version "21.1"
+  :version "22.1"
   :link '(custom-manual "(gnus)Customizing Articles")
   :link '(custom-manual "(gnus)X-Face")
   :type gnus-article-treat-head-custom)
@@ -1240,6 +1353,7 @@ See Info node `(gnus)Customizing Articles' and Info node
 Valid values are nil, t, `head', `last', an integer or a predicate.
 See Info node `(gnus)Customizing Articles' and Info node
 `(gnus)Picons' for details."
+  :version "22.1"
   :group 'gnus-article-treat
   :group 'gnus-picon
   :link '(custom-manual "(gnus)Customizing Articles")
@@ -1255,6 +1369,7 @@ See Info node `(gnus)Customizing Articles' and Info node
 Valid values are nil, t, `head', `last', an integer or a predicate.
 See Info node `(gnus)Customizing Articles' and Info node
 `(gnus)Picons' for details."
+  :version "22.1"
   :group 'gnus-article-treat
   :group 'gnus-picon
   :link '(custom-manual "(gnus)Customizing Articles")
@@ -1270,6 +1385,7 @@ See Info node `(gnus)Customizing Articles' and Info node
 Valid values are nil, t, `head', `last', an integer or a predicate.
 See Info node `(gnus)Customizing Articles' and Info node
 `(gnus)Picons' for details."
+  :version "22.1"
   :group 'gnus-article-treat
   :group 'gnus-picon
   :link '(custom-manual "(gnus)Customizing Articles")
@@ -1278,14 +1394,15 @@ See Info node `(gnus)Customizing Articles' and Info node
 (put 'gnus-treat-newsgroups-picon 'highlight t)
 
 (defcustom gnus-treat-body-boundary
-  (if (or gnus-treat-newsgroups-picon
-	  gnus-treat-mail-picon
-	  gnus-treat-from-picon)
+  (if (and (eq window-system 'x)
+	   (or gnus-treat-newsgroups-picon
+	       gnus-treat-mail-picon
+	       gnus-treat-from-picon))
       'head nil)
   "Draw a boundary at the end of the headers.
 Valid values are nil and `head'.
 See Info node `(gnus)Customizing Articles' for details."
-  :version "21.1"
+  :version "22.1"
   :group 'gnus-article-treat
   :link '(custom-manual "(gnus)Customizing Articles")
   :type gnus-article-treat-head-custom)
@@ -1303,6 +1420,7 @@ See Info node `(gnus)Customizing Articles' for details."
   "Format as HTML.
 Valid values are nil, t, `head', `last', an integer or a predicate.
 See Info node `(gnus)Customizing Articles' for details."
+  :version "22.1"
   :group 'gnus-article-treat
   :link '(custom-manual "(gnus)Customizing Articles")
   :type gnus-article-treat-custom)
@@ -1338,6 +1456,7 @@ See Info node `(gnus)Customizing Articles' for details."
 To automatically treat X-PGP-Sig, set it to head.
 Valid values are nil, t, `head', `last', an integer or a predicate.
 See Info node `(gnus)Customizing Articles' for details."
+  :version "22.1"
   :group 'gnus-article-treat
   :group 'mime-security
   :link '(custom-manual "(gnus)Customizing Articles")
@@ -1351,6 +1470,7 @@ See Info node `(gnus)Customizing Articles' for details."
 (defcustom gnus-article-encrypt-protocol "PGP"
   "The protocol used for encrypt articles.
 It is a string, such as \"PGP\". If nil, ask user."
+  :version "22.1"
   :type 'string
   :group 'mime-security)
 
@@ -1362,11 +1482,13 @@ It is a string, such as \"PGP\". If nil, ask user."
 			      (executable-find idna-program))
   "Whether IDNA decoding of headers is used when viewing messages.
 This requires GNU Libidn, and by default only enabled if it is found."
+  :version "22.1"
   :group 'gnus-article-headers
   :type 'boolean)
 
 (defcustom gnus-article-over-scroll nil
   "If non-nil, allow scrolling the article buffer even when there no more text."
+  :version "22.1"
   :group 'gnus-article
   :type 'boolean)
 
@@ -1402,10 +1524,10 @@ This requires GNU Libidn, and by default only enabled if it is found."
     (gnus-treat-date-ut gnus-article-date-ut)
     (gnus-treat-date-local gnus-article-date-local)
     (gnus-treat-date-english gnus-article-date-english)
-    (gnus-treat-date-lapsed gnus-article-date-lapsed)
     (gnus-treat-date-original gnus-article-date-original)
     (gnus-treat-date-user-defined gnus-article-date-user)
     (gnus-treat-date-iso8601 gnus-article-date-iso8601)
+    (gnus-treat-date-lapsed gnus-article-date-lapsed)
     (gnus-treat-display-x-face gnus-article-display-x-face)
     (gnus-treat-display-face gnus-article-display-face)
     (gnus-treat-hide-headers gnus-article-maybe-hide-headers)
@@ -1646,12 +1768,9 @@ always hide."
     (save-excursion
       (save-restriction
 	(let ((inhibit-read-only t)
-	      (list gnus-boring-article-headers)
-	      (inhibit-point-motion-hooks t)
-	      elem)
+	      (inhibit-point-motion-hooks t))
 	  (article-narrow-to-head)
-	  (while list
-	    (setq elem (pop list))
+	  (dolist (elem gnus-boring-article-headers)
 	    (goto-char (point-min))
 	    (cond
 	     ;; Hide empty headers.
@@ -1859,9 +1978,8 @@ characters to translate to."
 MAP is an alist where the elements are on the form (\"from\" \"to\")."
   (save-excursion
     (when (article-goto-body)
-      (let ((inhibit-read-only t)
-	    elem)
-	(while (setq elem (pop map))
+      (let ((inhibit-read-only t))
+	(dolist (elem map)
 	  (save-excursion
 	    (while (search-forward (car elem) nil t)
 	      (replace-match (cadr elem)))))))))
@@ -2058,33 +2176,33 @@ unfolded."
       ;; read-only.
       (if (and wash-face-p (memq 'face gnus-article-wash-types))
 	  (gnus-delete-images 'face)
-	(let (face faces)
-	  (save-excursion
+	(let (face faces from)
+	  (save-current-buffer
 	    (when (and wash-face-p
-		       (progn
-			 (goto-char (point-min))
-			 (not (re-search-forward "^Face:[\t ]*" nil t)))
-		       (gnus-buffer-live-p gnus-original-article-buffer))
+		       (gnus-buffer-live-p gnus-original-article-buffer)
+		       (not (re-search-forward "^Face:[\t ]*" nil t)))
 	      (set-buffer gnus-original-article-buffer))
 	    (save-restriction
 	      (mail-narrow-to-head)
 	      (while (gnus-article-goto-header "Face")
-		(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
-		(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")
-		  (forward-char -17))
-		(gnus-add-wash-type 'face)
-		(gnus-add-image 'face image)
-		(gnus-put-image image nil 'face))))))
-      )))
+		(push (mail-header-field-value) faces))))
+	  (when faces
+	    (goto-char (point-min))
+	    (let ((from (gnus-article-goto-header "from"))
+		  png image)
+	      (unless from
+		(insert "From:")
+		(setq from (point))
+		(insert "[no `from' set]\n"))
+	      (while faces
+		(when (setq png (gnus-convert-face-to-png (pop faces)))
+		  (setq image
+			(apply 'gnus-create-image png 'png t
+			       (cdr (assq 'png gnus-face-properties-alist))))
+		  (goto-char from)
+		  (gnus-add-wash-type 'face)
+		  (gnus-add-image 'face image)
+		  (gnus-put-image image nil 'face))))))))))
 
 (defun article-display-x-face (&optional force)
   "Look for an X-Face header and display it if present."
@@ -2101,13 +2219,10 @@ unfolded."
 	  (gnus-delete-images 'xface)
 	;; Display X-Faces.
 	(let (x-faces from face)
-	  (save-excursion
+	  (save-current-buffer
 	    (when (and wash-face-p
-		       (progn
-			 (goto-char (point-min))
-			 (not (re-search-forward
-			       "^X-Face\\(-[0-9]+\\)?:[\t ]*" nil t)))
-		       (gnus-buffer-live-p gnus-original-article-buffer))
+		       (gnus-buffer-live-p gnus-original-article-buffer)
+		       (not (re-search-forward "^X-Face:[\t ]*" nil t)))
 	      ;; If type `W f', use gnus-original-article-buffer,
 	      ;; otherwise use the current buffer because displaying
 	      ;; RFC822 parts calls this function too.
@@ -2121,34 +2236,36 @@ unfolded."
 	  ;; single external face.
 	  (when (stringp gnus-article-x-face-command)
 	    (setq x-faces (list (car x-faces))))
-	  (while (and (setq face (pop x-faces))
-		      gnus-article-x-face-command
-		      (or force
-			  ;; Check whether this face is censored.
-			  (not gnus-article-x-face-too-ugly)
-			  (and gnus-article-x-face-too-ugly from
-			       (not (string-match gnus-article-x-face-too-ugly
-						  from)))))
-	    ;; We display the face.
-	    (cond ((stringp gnus-article-x-face-command)
-		   ;; The command is a string, so we interpret the command
-		   ;; as a, well, command, and fork it off.
-		   (let ((process-connection-type nil))
-		     (process-kill-without-query
-		      (start-process
-		       "article-x-face" nil shell-file-name
-		       shell-command-switch gnus-article-x-face-command))
-		     (with-temp-buffer
-		       (insert face)
-		       (process-send-region "article-x-face"
-					    (point-min) (point-max)))
-		     (process-send-eof "article-x-face")))
-		  ((functionp gnus-article-x-face-command)
-		   ;; The command is a lisp function, so we call it.
-		   (funcall gnus-article-x-face-command face))
-		  (t
-		   (error "%s is not a function"
-			  gnus-article-x-face-command)))))))))
+	  (when (and x-faces
+		     gnus-article-x-face-command
+		     (or force
+			 ;; Check whether this face is censored.
+			 (not gnus-article-x-face-too-ugly)
+			 (and from
+			      (not (string-match gnus-article-x-face-too-ugly
+						 from)))))
+	    (while (setq face (pop x-faces))
+	      ;; We display the face.
+	      (cond ((stringp gnus-article-x-face-command)
+		     ;; The command is a string, so we interpret the command
+		     ;; as a, well, command, and fork it off.
+		     (let ((process-connection-type nil))
+		       (gnus-set-process-query-on-exit-flag
+			(start-process
+			 "article-x-face" nil shell-file-name
+			 shell-command-switch gnus-article-x-face-command)
+			nil)
+		       (with-temp-buffer
+			 (insert face)
+			 (process-send-region "article-x-face"
+					      (point-min) (point-max)))
+		       (process-send-eof "article-x-face")))
+		    ((functionp gnus-article-x-face-command)
+		     ;; The command is a lisp function, so we call it.
+		     (funcall gnus-article-x-face-command face))
+		    (t
+		     (error "%s is not a function"
+			    gnus-article-x-face-command))))))))))
 
 (defun article-decode-mime-words ()
   "Decode all MIME-encoded words in the article."
@@ -2364,7 +2481,7 @@ If READ-CHARSET, ask for a coding system."
     (let ((inhibit-read-only t))
       (goto-char (point-min))
       (while (re-search-forward
-	      "^\\(\\(https?\\|ftp\\)://\\S-+\\) *\n\\(\\S-+\\)" nil t)
+	      "\\(\\(https?\\|ftp\\)://\\S-+\\) *\n\\(\\S-+\\)" nil t)
 	(replace-match "\\1\\3" t)))
     (when (interactive-p)
       (gnus-treat-article nil))))
@@ -2778,69 +2895,74 @@ lines forward."
 	  (forward-line 1)
 	(setq ended t)))))
 
-(defun article-date-ut (&optional type highlight header)
+(defun article-date-ut (&optional type highlight)
   "Convert DATE date to universal time in the current article.
 If TYPE is `local', convert to local time; if it is `lapsed', output
 how much time has lapsed since DATE.  For `lapsed', the value of
 `gnus-article-date-lapsed-new-header' says whether the \"X-Sent:\" header
 should replace the \"Date:\" one, or should be added below it."
   (interactive (list 'ut t))
-  (let* ((header (or header
-		     (message-fetch-field "date")
-		     ""))
-	 (tdate-regexp "^Date:[ \t]\\|^X-Sent:[ \t]")
-	 (date-regexp
-	  (cond
-	   ((not gnus-article-date-lapsed-new-header)
-	    tdate-regexp)
-	   ((eq type 'lapsed)
-	    "^X-Sent:[ \t]")
-	   (t
-	    "^Date:[ \t]")))
-	 (date (if (vectorp header) (mail-header-date header)
-		 header))
+  (let* ((tdate-regexp "^Date:[ \t]\\|^X-Sent:[ \t]")
+	 (date-regexp (cond ((not gnus-article-date-lapsed-new-header)
+			     tdate-regexp)
+			    ((eq type 'lapsed)
+			     "^X-Sent:[ \t]")
+			    (article-lapsed-timer
+			     "^Date:[ \t]")
+			    (t
+			     tdate-regexp)))
+	 (case-fold-search t)
+	 (inhibit-read-only t)
 	 (inhibit-point-motion-hooks t)
-	 pos
-	 bface eface)
+	 pos date bface eface)
     (save-excursion
       (save-restriction
-	(article-narrow-to-head)
-	(when (re-search-forward tdate-regexp nil t)
-	  (setq bface (get-text-property (point-at-bol) 'face)
-		date (or (get-text-property (point-at-bol)
-					    'original-date)
-			 date)
-		eface (get-text-property (1- (point-at-eol)) 'face))
-	  (forward-line 1))
-	(when (and date (not (string= date "")))
+	(widen)
+	(goto-char (point-min))
+	(while (or (setq date (get-text-property (setq pos (point))
+						 'original-date))
+		   (when (setq pos (next-single-property-change
+				    (point) 'original-date))
+		     (setq date (get-text-property pos 'original-date))
+		     t))
+	  (narrow-to-region pos (or (text-property-any pos (point-max)
+						       'original-date nil)
+				    (point-max)))
 	  (goto-char (point-min))
-	  (let ((inhibit-read-only t))
-	    ;; Delete any old Date headers.
-	    (while (re-search-forward date-regexp nil t)
-	      (if pos
-		  (delete-region (point-at-bol)
-				 (progn (gnus-article-forward-header)
-					(point)))
-		(delete-region (point-at-bol)
-			       (progn (gnus-article-forward-header)
-				      (forward-char -1)
-				      (point)))
-		(setq pos (point))))
-	    (when (and (not pos)
-		       (re-search-forward tdate-regexp nil t))
-	      (forward-line 1))
-	    (gnus-goto-char pos)
-	    (insert (article-make-date-line date (or type 'ut)))
-	    (unless pos
-	      (insert "\n")
-	      (forward-line -1))
-	    ;; Do highlighting.
-	    (beginning-of-line)
-	    (when (looking-at "\\([^:]+\\): *\\(.*\\)$")
-	      (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))))))))
+	  (when (re-search-forward tdate-regexp nil t)
+	    (setq bface (get-text-property (point-at-bol) 'face)
+		  eface (get-text-property (1- (point-at-eol)) 'face)))
+	  (goto-char (point-min))
+	  (setq pos nil)
+	  ;; Delete any old Date headers.
+	  (while (re-search-forward date-regexp nil t)
+	    (if pos
+		(delete-region (point-at-bol) (progn
+						(gnus-article-forward-header)
+						(point)))
+	      (delete-region (point-at-bol) (progn
+					      (gnus-article-forward-header)
+					      (forward-char -1)
+					      (point)))
+	      (setq pos (point))))
+	  (when (and (not pos)
+		     (re-search-forward tdate-regexp nil t))
+	    (forward-line 1))
+	  (gnus-goto-char pos)
+	  (insert (article-make-date-line date (or type 'ut)))
+	  (unless pos
+	    (insert "\n")
+	    (forward-line -1))
+	  ;; Do highlighting.
+	  (beginning-of-line)
+	  (when (looking-at "\\([^:]+\\): *\\(.*\\)$")
+	    (put-text-property (match-beginning 1) (1+ (match-end 1))
+			       'face bface)
+	    (put-text-property (match-beginning 2) (match-end 2)
+			       'face eface))
+	  (put-text-property (point-min) (1- (point-max)) 'original-date date)
+	  (goto-char (point-max))
+	  (widen))))))
 
 (defun article-make-date-line (date type)
   "Return a DATE line of TYPE."
@@ -2981,20 +3103,21 @@ function and want to see what the date was before converting."
 
 (defun article-update-date-lapsed ()
   "Function to be run from a timer to update the lapsed time line."
-  (let (deactivate-mark)
-    (save-excursion
-      (ignore-errors
-	(walk-windows
-	 (lambda (w)
-	   (set-buffer (window-buffer w))
-	   (when (eq major-mode 'gnus-article-mode)
-	     (let ((mark (point-marker)))
-	       (goto-char (point-min))
-	       (when (re-search-forward "^X-Sent:" nil t)
-		 (article-date-lapsed t))
-	       (goto-char (marker-position mark))
-	       (move-marker mark nil))))
-	 nil 'visible)))))
+  (save-match-data
+    (let (deactivate-mark)
+      (save-excursion
+	(ignore-errors
+	 (walk-windows
+	  (lambda (w)
+	    (set-buffer (window-buffer w))
+	    (when (eq major-mode 'gnus-article-mode)
+	      (let ((mark (point-marker)))
+		(goto-char (point-min))
+		(when (re-search-forward "^X-Sent:" nil t)
+		  (article-date-lapsed t))
+		(goto-char (marker-position mark))
+		(move-marker mark nil))))
+	  nil 'visible))))))
 
 (defun gnus-start-date-timer (&optional n)
   "Start a timer to update the X-Sent header in the article buffers.
@@ -3025,6 +3148,27 @@ This format is defined by the `gnus-article-time-format' variable."
   (interactive (list t))
   (article-date-ut 'iso8601 highlight))
 
+(defmacro gnus-article-save-original-date (&rest forms)
+  "Save the original date as a text property and evaluate FORMS."
+  `(let* ((case-fold-search t)
+	  (start (progn
+		   (goto-char (point-min))
+		   (when (and (re-search-forward "^date:[\t\n ]+" nil t)
+			      (not (bolp)))
+		     (match-end 0))))
+	  (date (when (and start
+			   (re-search-forward "[\t ]*\n\\(?:[^\t ]\\|\\'\\)"
+					      nil t))
+		  (buffer-substring-no-properties start
+						  (match-beginning 0)))))
+     (goto-char (point-max))
+     (skip-chars-backward "\n")
+     (put-text-property (point-min) (point) 'original-date date)
+     ,@forms
+     (goto-char (point-max))
+     (skip-chars-backward "\n")
+     (put-text-property (point-min) (point) 'original-date date)))
+
 ;; (defun article-show-all ()
 ;;   "Show all hidden text in the article buffer."
 ;;   (interactive)
@@ -3635,6 +3779,7 @@ commands:
 \\[gnus-article-describe-briefly]\t Describe the current mode briefly
 \\[gnus-info-find-node]\t Go to the Gnus info node"
   (interactive)
+  (kill-all-local-variables)
   (gnus-simplify-mode-line)
   (setq mode-name "Article")
   (setq major-mode 'gnus-article-mode)
@@ -3656,13 +3801,15 @@ commands:
   (make-local-variable 'gnus-article-image-alist)
   (make-local-variable 'gnus-article-charset)
   (make-local-variable 'gnus-article-ignored-charsets)
+  ;; Prevent recent Emacsen from displaying non-break space as "\ ".
+  (set (make-local-variable 'nobreak-char-display) nil)
   (gnus-set-default-directory)
   (buffer-disable-undo)
   (setq buffer-read-only t
 	show-trailing-whitespace nil)
   (set-syntax-table gnus-article-mode-syntax-table)
   (mm-enable-multibyte)
-  (gnus-run-hooks 'gnus-article-mode-hook))
+  (gnus-run-mode-hooks 'gnus-article-mode-hook))
 
 (defun gnus-article-setup-buffer ()
   "Initialize the article buffer."
@@ -3689,14 +3836,19 @@ commands:
       (mm-enable-multibyte)
       (setq major-mode 'gnus-original-article-mode)
       (make-local-variable 'gnus-original-article))
-    (if (get-buffer name)
+    (if (and (get-buffer name)
+	     (with-current-buffer name
+	       (if gnus-article-edit-mode
+		   (if (y-or-n-p "Article mode edit in progress; discard? ")
+		       (progn
+			 (set-buffer-modified-p nil)
+			 (gnus-kill-buffer name)
+			 (message "")
+			 nil)
+		     (error "Action aborted"))
+		 t)))
 	(save-excursion
 	  (set-buffer name)
-	  (when (and gnus-article-edit-mode
-		     (buffer-modified-p)
-		     (not
-		      (y-or-n-p "Article mode edit in progress; discard? ")))
-	    (error "Action aborted"))
 	  (set (make-local-variable 'gnus-article-edit-mode) nil)
 	  (when gnus-article-mime-handles
 	    (mm-destroy-parts gnus-article-mime-handles)
@@ -3954,13 +4106,32 @@ General format specifiers can also be used.  See Info node
 	  (delete-region (point) (point-max))
 	  (mm-display-parts handles))))))
 
+(defun gnus-article-jump-to-part (n)
+  "Jump to MIME part N."
+  (interactive "P")
+  (pop-to-buffer gnus-article-buffer)
+  (let ((parts (length gnus-article-mime-handle-alist)))
+    (or n (setq n
+		(string-to-number
+		 (read-string ;; Emacs 21 doesn't have `read-number'.
+		  (format "Jump to part (2..%s): " parts)))))
+    (unless (and (integerp n) (<= n parts) (>= n 1))
+      (setq n
+	    (progn
+	      (gnus-message 7 "Invalid part `%s', using %s instead."
+			    n parts)
+	      parts)))
+    (gnus-message 9 "Jumping to part %s." n)
+    (gnus-article-goto-part n)))
+
 (eval-when-compile
-  (defsubst gnus-article-edit-part (handles)
+  (defsubst gnus-article-edit-part (handles &optional current-id)
     "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 ()
+	(buffer-disable-undo)
 	(erase-buffer)
 	(let ((mail-parse-charset (or gnus-article-charset
 				      ',gnus-newsgroup-charset))
@@ -3969,7 +4140,7 @@ and `gnus-mime-delete-part', and not provided at run-time normally."
 		   ',gnus-newsgroup-ignored-charsets))
 	      (mbl mml-buffer-list))
 	  (setq mml-buffer-list nil)
-	  (insert-buffer gnus-original-article-buffer)
+	  (insert-buffer-substring gnus-original-article-buffer)
 	  (mime-to-mml ',handles)
 	  (setq gnus-article-mime-handles nil)
 	  (let ((mbl1 mml-buffer-list))
@@ -3993,10 +4164,14 @@ and `gnus-mime-delete-part', and not provided at run-time normally."
 	(gnus-summary-edit-article-done
 	 ,(or (mail-header-references gnus-current-headers) "")
 	 ,(gnus-group-read-only-p)
-	 ,gnus-summary-buffer no-highlight)))
+	 ,gnus-summary-buffer no-highlight))
+     t)
     (gnus-article-edit-done)
     (gnus-summary-expand-window)
-    (gnus-summary-show-article)))
+    (gnus-summary-show-article)
+    (when (and current-id (integerp gnus-auto-select-part))
+      (gnus-article-jump-to-part
+       (+ current-id gnus-auto-select-part)))))
 
 (defun gnus-mime-save-part-and-strip ()
   "Save the MIME part under point then replace it with an external body."
@@ -4007,29 +4182,28 @@ and `gnus-mime-delete-part', and not provided at run-time normally."
   (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)
-	  (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)))))
+  (let* ((data (get-text-property (point) 'gnus-data))
+	 (id (get-text-property (point) 'gnus-part))
+	 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)
+	(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 id))))
 
 (defun gnus-mime-delete-part ()
   "Delete the MIME part under point.
@@ -4041,9 +4215,11 @@ Replace it with some information about the removed part."
   (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? ")
+  (when (or gnus-expert-user
+	    (gnus-yes-or-no-p "\
+Deleting parts may malfunction or destroy the article; continue? "))
     (let* ((data (get-text-property (point) 'gnus-data))
+	   (id (get-text-property (point) 'gnus-part))
 	   (handles gnus-article-mime-handles)
 	   (none "(none)")
 	   (description
@@ -4074,8 +4250,8 @@ Deleting parts may malfunction or destroy the article; continue? ")
 			nil `("text/plain") nil nil
 			(list "attachment")
 			(format "Deleted attachment (%s bytes)" bsize))))))
-      (set-buffer gnus-summary-buffer)
-      (gnus-article-edit-part handles))))
+      ;; (set-buffer gnus-summary-buffer)
+      (gnus-article-edit-part handles id))))
 
 (defun gnus-mime-save-part ()
   "Save the MIME part under point."
@@ -4137,60 +4313,63 @@ Deleting parts may malfunction or destroy the article; continue? ")
 	    (mm-merge-handles gnus-article-mime-handles handle))
       (gnus-mm-display-part handle))))
 
-(eval-when-compile
-  (require 'jka-compr))
-
-;; jka-compr.el uses a "sh -c" to direct stderr to err-file, but these days
-;; emacs can do that itself.
-;;
-(defun gnus-mime-jka-compr-maybe-uncompress ()
-  "Uncompress the current buffer if `auto-compression-mode' is enabled.
-The uncompress method used is derived from `buffer-file-name'."
-  (when (and (fboundp 'jka-compr-installed-p)
-             (jka-compr-installed-p))
-    (let ((info (jka-compr-get-compression-info buffer-file-name)))
-      (when info
-        (let ((basename (file-name-nondirectory buffer-file-name))
-              (args     (jka-compr-info-uncompress-args    info))
-              (prog     (jka-compr-info-uncompress-program info))
-              (message  (jka-compr-info-uncompress-message info))
-              (err-file (jka-compr-make-temp-name)))
-          (if message
-              (message "%s %s..." message basename))
-          (unwind-protect
-              (unless (memq (apply 'call-process-region
-                                   (point-min) (point-max)
-                                   prog
-                                   t (list t err-file) nil
-                                   args)
-                            jka-compr-acceptable-retval-list)
-                (jka-compr-error prog args basename message err-file))
-            (jka-compr-delete-temp-file err-file)))))))
-
-(defun gnus-mime-copy-part (&optional handle)
+(defun gnus-mime-copy-part (&optional handle arg)
   "Put the MIME part under point into a new buffer.
 If `auto-compression-mode' is enabled, compressed files like .gz and .bz2
 are decompressed."
-  (interactive)
+  (interactive (list nil current-prefix-arg))
   (gnus-article-check-buffer)
-  (let* ((handle (or handle (get-text-property (point) 'gnus-data)))
-	 (contents (and handle (mm-get-part handle)))
-	 (base (and handle
-		    (file-name-nondirectory
-		     (or
-		      (mail-content-type-get (mm-handle-type handle) 'name)
-		      (mail-content-type-get (mm-handle-disposition handle)
-					     'filename)
-		      "*decoded*"))))
-	 (buffer (and base (generate-new-buffer base))))
-    (when contents
-      (switch-to-buffer buffer)
-      (insert contents)
+  (unless handle
+    (setq handle (get-text-property (point) 'gnus-data)))
+  (when handle
+    (let ((filename (or (mail-content-type-get (mm-handle-disposition handle)
+					       'name)
+			(mail-content-type-get (mm-handle-disposition handle)
+					       'filename)))
+	  contents dont-decode charset coding-system)
+      (mm-with-unibyte-buffer
+	(mm-insert-part handle)
+	(setq contents (or (condition-case nil
+			       (mm-decompress-buffer filename nil 'sig)
+			     (error
+			      (setq dont-decode t)
+			      nil))
+			   (buffer-string))))
+      (setq filename (cond (filename (file-name-nondirectory filename))
+			   (dont-decode "*raw data*")
+			   (t "*decoded*")))
+      (cond
+       (dont-decode)
+       ((not arg)
+	(unless (setq charset (mail-content-type-get
+			       (mm-handle-type handle) 'charset))
+	  (unless (setq coding-system (mm-with-unibyte-buffer
+					(insert contents)
+					(mm-find-buffer-file-coding-system)))
+	    (setq charset gnus-newsgroup-charset))))
+       ((numberp arg)
+	(setq charset (or (cdr (assq arg
+				     gnus-summary-show-article-charset-alist))
+			  (mm-read-coding-system "Charset: ")))))
+      (switch-to-buffer (generate-new-buffer filename))
+      (if (or coding-system
+	      (and charset
+		   (setq coding-system (mm-charset-to-coding-system charset))
+		   (not (eq charset 'ascii))))
+	  (progn
+	    (mm-enable-multibyte)
+	    (insert (mm-decode-coding-string contents coding-system))
+	    (setq buffer-file-coding-system
+		  (if (boundp 'last-coding-system-used)
+		      (symbol-value 'last-coding-system-used)
+		    coding-system)))
+	(mm-disable-multibyte)
+	(insert contents)
+	(setq buffer-file-coding-system mm-binary-coding-system))
       ;; We do it this way to make `normal-mode' set the appropriate mode.
       (unwind-protect
 	  (progn
-	    (setq buffer-file-name (expand-file-name base))
-	    (gnus-mime-jka-compr-maybe-uncompress)
+	    (setq buffer-file-name (expand-file-name filename))
 	    (normal-mode))
 	(setq buffer-file-name nil))
       (goto-char (point-min)))))
@@ -4221,37 +4400,57 @@ are decompressed."
 	  (ps-despool filename)))))
 
 (defun gnus-mime-inline-part (&optional handle arg)
-  "Insert the MIME part under point into the current buffer."
+  "Insert the MIME part under point into the current buffer.
+Compressed files like .gz and .bz2 are decompressed."
   (interactive (list nil current-prefix-arg))
   (gnus-article-check-buffer)
-  (let* ((handle (or handle (get-text-property (point) 'gnus-data)))
-	 contents charset
-	 (b (point))
-	 (inhibit-read-only t))
-    (when handle
+  (unless handle
+    (setq handle (get-text-property (point) 'gnus-data)))
+  (when handle
+    (let ((b (point))
+	  (inhibit-read-only t)
+	  contents charset coding-system)
       (if (and (not arg) (mm-handle-undisplayer handle))
 	  (mm-remove-part handle)
-	(setq contents (mm-get-part handle))
+	(mm-with-unibyte-buffer
+	  (mm-insert-part handle)
+	  (setq contents
+		(or (mm-decompress-buffer
+		     (or (mail-content-type-get (mm-handle-disposition handle)
+						'name)
+			 (mail-content-type-get (mm-handle-disposition handle)
+						'filename))
+		     nil t)
+		    (buffer-string))))
 	(cond
 	 ((not arg)
-	  (setq charset (or (mail-content-type-get
-			     (mm-handle-type handle) 'charset)
-			    gnus-newsgroup-charset)))
+	  (unless (setq charset (mail-content-type-get
+				 (mm-handle-type handle) 'charset))
+	    (unless (setq coding-system
+			  (mm-with-unibyte-buffer
+			    (insert contents)
+			    (mm-find-buffer-file-coding-system)))
+	      (setq charset gnus-newsgroup-charset))))
 	 ((numberp arg)
 	  (if (mm-handle-undisplayer handle)
 	      (mm-remove-part handle))
 	  (setq charset
 		(or (cdr (assq arg
 			       gnus-summary-show-article-charset-alist))
-		    (mm-read-coding-system "Charset: ")))))
+		    (mm-read-coding-system "Charset: "))))
+	 (t
+	  (if (mm-handle-undisplayer handle)
+	      (mm-remove-part handle))))
 	(forward-line 2)
-	(mm-insert-inline handle
-			  (if (and charset
-				   (setq charset (mm-charset-to-coding-system
-						  charset))
-				   (not (eq charset 'ascii)))
-			      (mm-decode-coding-string contents charset)
-			    contents))
+	(mm-insert-inline
+	 handle
+	 (if (or coding-system
+		 (and charset
+		      (setq coding-system
+			    (mm-charset-to-coding-system charset))
+		      (not (eq coding-system 'ascii))))
+	     (mm-decode-coding-string contents coding-system)
+	   (mm-string-to-multibyte contents)))
 	(goto-char b)))))
 
 (defun gnus-mime-view-part-as-charset (&optional handle arg)
@@ -4316,13 +4515,15 @@ If no internal viewer is available, use an external viewer."
     (if action-pair
 	(funcall (cdr action-pair)))))
 
-(defun gnus-article-part-wrapper (n function)
+(defun gnus-article-part-wrapper (n function &optional no-handle)
   (with-current-buffer gnus-article-buffer
     (when (> n (length gnus-article-mime-handle-alist))
       (error "No such part"))
     (gnus-article-goto-part n)
-    (let ((handle (cdr (assq n gnus-article-mime-handle-alist))))
-      (funcall function handle))))
+    (if no-handle
+	(funcall function)
+      (let ((handle (cdr (assq n gnus-article-mime-handle-alist))))
+	(funcall function handle)))))
 
 (defun gnus-article-pipe-part (n)
   "Pipe MIME part N, which is the numerical prefix."
@@ -4360,10 +4561,22 @@ N is the numerical prefix."
   (interactive "p")
   (gnus-article-part-wrapper n 'gnus-mime-inline-part))
 
+(defun gnus-article-save-part-and-strip (n)
+  "Save MIME part N and replace it with an external body.
+N is the numerical prefix."
+  (interactive "p")
+  (gnus-article-part-wrapper n 'gnus-mime-save-part-and-strip t))
+
+(defun gnus-article-delete-part (n)
+  "Delete MIME part N and add some information about the removed part.
+N is the numerical prefix."
+  (interactive "p")
+  (gnus-article-part-wrapper n 'gnus-mime-delete-part t))
+
 (defun gnus-article-mime-match-handle-first (condition)
   (if condition
-      (let ((alist gnus-article-mime-handle-alist) ihandle n)
-	(while (setq ihandle (pop alist))
+      (let (n)
+	(dolist (ihandle gnus-article-mime-handle-alist)
 	  (if (and (cond
 		    ((functionp condition)
 		     (funcall condition (cdr ihandle)))
@@ -4530,11 +4743,15 @@ N is the numerical prefix."
 	  ;; We have to do this since selecting the window
 	  ;; may change the point.  So we set the window point.
 	  (set-window-point window point)))
-      (let* ((handles (or ihandles
-			  (mm-dissect-buffer nil gnus-article-loose-mime)
-			  (and gnus-article-emulate-mime
-			       (mm-uu-dissect))))
-	     (inhibit-read-only t) handle name type b e display)
+      (let ((handles ihandles)
+	    (inhibit-read-only t)
+	    handle)
+	(cond (handles)
+	      ((setq handles (mm-dissect-buffer nil gnus-article-loose-mime))
+	       (when gnus-article-emulate-mime
+		 (mm-uu-dissect-text-parts handles)))
+	      (gnus-article-emulate-mime
+	       (setq handles (mm-uu-dissect))))
 	(when (and (not ihandles)
 		   (not gnus-displaying-mime))
 	  ;; Top-level call; we clean up.
@@ -4567,7 +4784,8 @@ N is the numerical prefix."
 	    (save-restriction
 	      (article-goto-body)
 	      (narrow-to-region (point-min) (point))
-	      (gnus-treat-article 'head))))))))
+	      (gnus-article-save-original-date
+	       (gnus-treat-article 'head)))))))))
 
 (defcustom gnus-mime-display-multipart-as-mixed nil
   "Display \"multipart\" parts as  \"multipart/mixed\".
@@ -4580,6 +4798,7 @@ If t, it overrides nil values of
 
 (defcustom gnus-mime-display-multipart-alternative-as-mixed nil
   "Display \"multipart/alternative\" parts as  \"multipart/mixed\"."
+  :version "22.1"
   :group 'gnus-article-mime
   :type 'boolean)
 
@@ -4589,6 +4808,7 @@ If t, it overrides nil values of
 If displaying \"text/html\" is discouraged \(see
 `mm-discouraged-alternatives'\) images or other material inside a
 \"multipart/related\" part might be overlooked when this variable is nil."
+  :version "22.1"
   :group 'gnus-article-mime
   :type 'boolean)
 
@@ -4693,7 +4913,7 @@ If displaying \"text/html\" is discouraged \(see
 	      (forward-line -1)
 	      (setq beg (point)))
 	    (gnus-article-insert-newline)
-	    (mm-insert-inline handle (mm-get-part handle))
+	    (mm-display-inline handle)
 	    (goto-char (point-max))))
 	  ;; Do highlighting.
 	  (save-excursion
@@ -4954,7 +5174,7 @@ If given a numerical ARG, move forward ARG pages."
 	  (goto-char (point-min))
 	  (gnus-insert-prev-page-button)))
       (when (and (gnus-visual-p 'page-marker)
-		 (< (+ (point-max) 2) (buffer-size)))
+		 (< (point-max) (save-restriction (widen) (point-max))))
 	(save-excursion
 	  (goto-char (point-max))
 	  (gnus-insert-next-page-button))))))
@@ -5017,14 +5237,36 @@ Argument LINES specifies lines to be scrolled up."
     (gnus-article-next-page-1 lines)
     nil))
 
+(defmacro gnus-article-beginning-of-window ()
+  "Move point to the beginning of the window.
+In Emacs, the point is placed at the line number which `scroll-margin'
+specifies."
+  (if (featurep 'xemacs)
+      '(move-to-window-line 0)
+    '(move-to-window-line
+      (min (max 0 scroll-margin)
+	   (max 1 (- (window-height)
+		     (if mode-line-format 1 0)
+		     (if header-line-format 1 0)))))))
+
 (defun gnus-article-next-page-1 (lines)
-  (let ((scroll-in-place nil))
-    (condition-case ()
-	(scroll-up lines)
-      (end-of-buffer
-       ;; Long lines may cause an end-of-buffer error.
-       (goto-char (point-max)))))
-  (move-to-window-line 0))
+  (when (and (not (featurep 'xemacs))
+	     (numberp lines)
+	     (> lines 0)
+	     (numberp (symbol-value 'scroll-margin))
+	     (> (symbol-value 'scroll-margin) 0))
+    ;; Protect against the bug that Emacs 21.x hangs up when scrolling up for
+    ;; too many number of lines if `scroll-margin' is set as two or greater.
+    (setq lines (min lines
+		     (max 0 (- (count-lines (window-start) (point-max))
+			       (symbol-value 'scroll-margin))))))
+  (condition-case ()
+      (let ((scroll-in-place nil))
+	(scroll-up lines))
+    (end-of-buffer
+     ;; Long lines may cause an end-of-buffer error.
+     (goto-char (point-max))))
+  (gnus-article-beginning-of-window))
 
 (defun gnus-article-prev-page (&optional lines)
   "Show previous page of current article.
@@ -5038,13 +5280,13 @@ Argument LINES specifies lines to be scrolled down."
 	(gnus-narrow-to-page -1)	;Go to previous page.
 	(goto-char (point-max))
 	(recenter -1))
-    (let ((scroll-in-place nil))
-      (prog1
-	  (condition-case ()
-	      (scroll-down lines)
-	    (beginning-of-buffer
-	     (goto-char (point-min))))
-	(move-to-window-line 0)))))
+    (prog1
+	(condition-case ()
+	    (let ((scroll-in-place nil))
+	      (scroll-down lines))
+	  (beginning-of-buffer
+	   (goto-char (point-min))))
+      (gnus-article-beginning-of-window))))
 
 (defun gnus-article-only-boring-p ()
   "Decide whether there is only boring text remaining in the article.
@@ -5180,7 +5422,7 @@ not have a face in `gnus-article-boring-faces'."
 	      (when (eq win (selected-window))
 		(setq new-sum-point (point)
 		      new-sum-start (window-start win)
-		      new-sum-hscroll (window-hscroll win))
+		      new-sum-hscroll (window-hscroll win)))
 	      (when (eq in-buffer (current-buffer))
 		(setq selected (gnus-summary-select-article))
 		(set-buffer obuf)
@@ -5196,7 +5438,7 @@ not have a face in `gnus-article-boring-faces'."
 			   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-hscroll win new-sum-hscroll))))
 	  (set-window-configuration owin)
 	  (ding))))))
 
@@ -5592,17 +5834,21 @@ groups."
        ,(or (mail-header-references gnus-current-headers) "")
        ,(gnus-group-read-only-p) ,gnus-summary-buffer no-highlight))))
 
-(defun gnus-article-edit-article (start-func exit-func)
+(defun gnus-article-edit-article (start-func exit-func &optional quiet)
   "Start editing the contents of the current article buffer."
   (let ((winconf (current-window-configuration)))
     (set-buffer gnus-article-buffer)
-    (gnus-article-edit-mode)
+    (let ((message-auto-save-directory
+	   ;; Don't associate the article buffer with a draft file.
+	   nil))
+      (gnus-article-edit-mode))
     (funcall start-func)
     (set-buffer-modified-p nil)
     (gnus-configure-windows 'edit-article)
     (setq gnus-article-edit-done-function exit-func)
     (setq gnus-prev-winconf winconf)
-    (gnus-message 6 "C-c C-c to end edits")))
+    (unless quiet
+      (gnus-message 6 "C-c C-c to end edits"))))
 
 (defun gnus-article-edit-done (&optional arg)
   "Update the article edits and exit."
@@ -5647,7 +5893,7 @@ groups."
 	  (window-start (window-start)))
       (erase-buffer)
       (if (gnus-buffer-live-p gnus-original-article-buffer)
-	  (insert-buffer gnus-original-article-buffer))
+	  (insert-buffer-substring gnus-original-article-buffer))
       (let ((winconf gnus-prev-winconf))
 	(kill-all-local-variables)
 	(gnus-article-mode)
@@ -5687,6 +5933,15 @@ groups."
 (defcustom gnus-button-valid-fqdn-regexp
   message-valid-fqdn-regexp
   "Regular expression that matches a valid FQDN."
+  :version "22.1"
+  :group 'gnus-article-buttons
+  :type 'regexp)
+
+;; Regexp suggested by Felix Wiemann in <87oeuomcz9.fsf@news2.ososo.de>
+(defcustom gnus-button-valid-localpart-regexp
+  "[a-z0-9$%(*-=?[_][^<>\")!;:,{}\n\t ]*"
+  "Regular expression that matches a localpart of mail addresses or MIDs."
+  :version "22.1"
   :group 'gnus-article-buttons
   :type 'regexp)
 
@@ -5694,6 +5949,7 @@ groups."
   "Function to use for displaying man pages.
 The function must take at least one argument with a string naming the
 man page."
+  :version "22.1"
   :type '(choice (function-item :tag "Man" manual-entry)
 		 (function-item :tag "Woman" woman)
 		 (function :tag "Other"))
@@ -5704,6 +5960,7 @@ man page."
 If the default site is too slow, try to find a CTAN mirror, see
 <URL:http://tug.ctan.org/tex-archive/CTAN.sites?action=/index.html>.  See also
 the variable `gnus-button-handle-ctan'."
+  :version "22.1"
   :group 'gnus-article-buttons
   :link '(custom-manual "(gnus)Group Parameters")
   :type '(choice (const "http://www.tex.ac.uk/tex-archive/")
@@ -5714,34 +5971,36 @@ the variable `gnus-button-handle-ctan'."
 (defcustom gnus-button-ctan-handler 'browse-url
   "Function to use for displaying CTAN links.
 The function must take one argument, the string naming the URL."
+  :version "22.1"
   :type '(choice (function-item :tag "Browse Url" browse-url)
 		 (function :tag "Other"))
   :group 'gnus-article-buttons)
 
 (defcustom gnus-button-handle-ctan-bogus-regexp "^/?tex-archive/\\|^/"
   "Bogus strings removed from CTAN URLs."
+  :version "22.1"
   :group 'gnus-article-buttons
   :type '(choice (const "^/?tex-archive/\\|/")
 		 (regexp :tag "Other")))
 
 (defcustom gnus-button-ctan-directory-regexp
-  (concat
-   "\\(?:"
-   "biblio\\|digests\\|dviware\\|fonts\\|graphics\\|help\\|"
-   "indexing\\|info\\|language\\|macros\\|support\\|systems\\|"
-   "tds\\|tools\\|usergrps\\|web\\|nonfree\\|obsolete"
-   "\\)")
+  (regexp-opt
+   (list "archive-tools" "biblio" "bibliography" "digests" "documentation"
+	 "dviware" "fonts" "graphics" "help" "indexing" "info" "language"
+	 "languages" "macros" "nonfree" "obsolete" "support" "systems"
+	 "tds" "tools" "usergrps" "web") t)
   "Regular expression for ctan directories.
 It should match all directories in the top level of `gnus-ctan-url'."
+  :version "22.1"
   :group 'gnus-article-buttons
   :type 'regexp)
 
 (defcustom gnus-button-mid-or-mail-regexp
-  (concat "\\b\\(<?[a-z0-9$%(*-=?[_][^<>\")!;:,{}\n\t ]*@"
-	  ;; Felix Wiemann in <87oeuomcz9.fsf@news2.ososo.de>
+  (concat "\\b\\(<?" gnus-button-valid-localpart-regexp "@"
 	  gnus-button-valid-fqdn-regexp
 	  ">?\\)\\b")
   "Regular expression that matches a message ID or a mail address."
+  :version "22.1"
   :group 'gnus-article-buttons
   :type 'regexp)
 
@@ -5753,6 +6012,7 @@ message ID or a mail address, respectively.  If this variable is set to the
 symbol `ask', always query the user what do do.  If it is a function, this
 function will be called with the string as it's only argument.  The function
 must return `mid', `mail', `invalid' or `ask'."
+  :version "22.1"
   :group 'gnus-article-buttons
   :type '(choice (function-item :tag "Heuristic function"
 				gnus-button-mid-or-mail-heuristic)
@@ -5816,6 +6076,7 @@ must return `mid', `mail', `invalid' or `ask'."
 
 A negative RATE indicates a message IDs, whereas a positive indicates a mail
 address.  The REGEXP is processed with `case-fold-search' set to nil."
+  :version "22.1"
   :group 'gnus-article-buttons
   :type '(repeat (cons (number :tag "Rate")
 		       (regexp :tag "Regexp"))))
@@ -6000,6 +6261,7 @@ positives are possible.  Note that you can set this variable local to
 specific groups.  Setting it higher in TeX groups is probably a good idea.
 See Info node `(gnus)Group Parameters' and the variable `gnus-parameters' on
 how to set variables in specific groups."
+  :version "22.1"
   :group 'gnus-article-buttons
   :link '(custom-manual "(gnus)Group Parameters")
   :type 'integer)
@@ -6011,6 +6273,7 @@ positives are possible.  Note that you can set this variable local to
 specific groups.  Setting it higher in Unix groups is probably a good idea.
 See Info node `(gnus)Group Parameters' and the variable `gnus-parameters' on
 how to set variables in specific groups."
+  :version "22.1"
   :group 'gnus-article-buttons
   :link '(custom-manual "(gnus)Group Parameters")
   :type 'integer)
@@ -6022,6 +6285,7 @@ positives are possible.  Note that you can set this variable local to
 specific groups.  Setting it higher in Emacs or Gnus related groups is
 probably a good idea.  See Info node `(gnus)Group Parameters' and the variable
 `gnus-parameters' on how to set variables in specific groups."
+  :version "22.1"
   :group 'gnus-article-buttons
   :link '(custom-manual "(gnus)Group Parameters")
   :type 'integer)
@@ -6031,6 +6295,7 @@ probably a good idea.  See Info node `(gnus)Group Parameters' and the variable
 The higher the number, the more buttons will appear and the more false
 positives are possible."
   ;; mail addresses, MIDs, URLs for news, ...
+  :version "22.1"
   :group 'gnus-article-buttons
   :type 'integer)
 
@@ -6039,14 +6304,16 @@ positives are possible."
 The higher the number, the more buttons will appear and the more false
 positives are possible."
   ;; stuff handled by `browse-url' or `gnus-button-embedded-url'
+  :version "22.1"
   :group 'gnus-article-buttons
   :type 'integer)
 
 (defcustom gnus-button-alist
   '(("<\\(url:[>\n\t ]*?\\)?\\(nntp\\|news\\):[>\n\t ]*\\([^>\n\t ]*@[^>\n\t ]*\\)>"
      0 (>= gnus-button-message-level 0) gnus-button-handle-news 3)
-    ("\\b\\(nntp\\|news\\):\\([^>\n\t ]*@[^>)!;:,\n\t ]*\\)" 0 t
-     gnus-button-handle-news 2)
+    ((concat "\\b\\(nntp\\|news\\):\\("
+	     gnus-button-valid-localpart-regexp "@[a-z0-9.-]+[a-z]\\)")
+     0 t gnus-button-handle-news 2)
     ("\\(\\b<\\(url:[>\n\t ]*\\)?\\(nntp\\|news\\):[>\n\t ]*\\(//\\)?\\([^>\n\t ]*\\)>\\)"
      1 (>= gnus-button-message-level 0) gnus-button-fetch-group 5)
     ("\\b\\(nntp\\|news\\):\\(//\\)?\\([^'\">\n\t ]+\\)"
@@ -6188,13 +6455,15 @@ variable it the real callback function."
     ("^\\(From\\|Reply-To\\):" ": *\\(.+\\)$"
      1 (>= gnus-button-message-level 0) gnus-button-reply 1)
     ("^\\(Cc\\|To\\):" "[^ \t\n<>,()\"]+@[^ \t\n<>,()\"]+"
-     0 (>= gnus-button-message-level 0) gnus-button-mailto 0)
+     0 (>= gnus-button-message-level 0) gnus-msg-mail 0)
     ("^X-[Uu][Rr][Ll]:" gnus-button-url-regexp
      0 (>= gnus-button-browse-level 0) browse-url 0)
     ("^Subject:" gnus-button-url-regexp
      0 (>= gnus-button-browse-level 0) browse-url 0)
     ("^[^:]+:" gnus-button-url-regexp
      0 (>= gnus-button-browse-level 0) browse-url 0)
+    ("^OpenPGP:.*url=" gnus-button-url-regexp
+     0 (>= gnus-button-browse-level 0) gnus-button-openpgp 0)
     ("^[^:]+:" "\\bmailto:\\([-a-z.@_+0-9%=?&/]+\\)"
      0 (>= gnus-button-message-level 0) gnus-url-mailto 1)
     ("^[^:]+:" "\\(<\\(url: \\)?\\(nntp\\|news\\):\\([^>\n ]*\\)>\\)"
@@ -6271,9 +6540,8 @@ do the highlighting.  See the documentation for those functions."
   "Highlight article headers as specified by `gnus-header-face-alist'."
   (interactive)
   (gnus-with-article-headers
-    (let ((alist gnus-header-face-alist)
-	  entry regexp header-face field-face from hpoints fpoints)
-      (while (setq entry (pop alist))
+    (let (regexp header-face field-face from hpoints fpoints)
+      (dolist (entry gnus-header-face-alist)
 	(goto-char (point-min))
 	(setq regexp (concat "^\\("
 			     (if (string-equal "" (nth 0 entry))
@@ -6303,7 +6571,7 @@ do the highlighting.  See the documentation for those functions."
 (defun gnus-article-highlight-signature ()
   "Highlight the signature in an article.
 It does this by highlighting everything after
-`gnus-signature-separator' using `gnus-signature-face'."
+`gnus-signature-separator' using the face `gnus-signature'."
   (interactive)
   (gnus-with-article-buffer
     (let ((inhibit-point-motion-hooks t))
@@ -6371,11 +6639,9 @@ specified by `gnus-button-alist'."
   "Add buttons to the head of the article."
   (interactive)
   (gnus-with-article-headers
-    (let ((alist gnus-header-button-alist)
-	  entry beg end)
-      (while alist
+    (let (beg end)
+      (dolist (entry gnus-header-button-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.
@@ -6473,15 +6739,18 @@ specified by `gnus-button-alist'."
 		      (cons fun args)))))))
 
 (defun gnus-parse-news-url (url)
-  (let (scheme server group message-id articles)
+  (let (scheme server port group message-id articles)
     (with-temp-buffer
       (insert url)
       (goto-char (point-min))
       (when (looking-at "\\([A-Za-z]+\\):")
 	(setq scheme (match-string 1))
 	(goto-char (match-end 0)))
-      (when (looking-at "//\\([^/]+\\)/")
+      (when (looking-at "//\\([^:/]+\\)\\(:?\\)\\([0-9]+\\)?/")
 	(setq server (match-string 1))
+	(setq port (if (stringp (match-string 3))
+		       (string-to-number (match-string 3))
+		     (match-string 3)))
 	(goto-char (match-end 0)))
 
       (cond
@@ -6494,18 +6763,23 @@ specified by `gnus-button-alist'."
 	(setq group (match-string 1)))
        (t
 	(error "Unknown news URL syntax"))))
-    (list scheme server group message-id articles)))
+    (list scheme server port group message-id articles)))
 
 (defun gnus-button-handle-news (url)
   "Fetch a news URL."
-  (destructuring-bind (scheme server group message-id articles)
+  (destructuring-bind (scheme server port group message-id articles)
       (gnus-parse-news-url url)
     (cond
      (message-id
       (save-excursion
 	(set-buffer gnus-summary-buffer)
 	(if server
-	    (let ((gnus-refer-article-method (list (list 'nntp server))))
+	    (let ((gnus-refer-article-method
+		   (nconc (list (list 'nntp server))
+			  gnus-refer-article-method))
+		  (nntp-port-number (or port "nntp")))
+	      (gnus-message 7 "Fetching %s with %s"
+			    message-id gnus-refer-article-method)
 	      (gnus-summary-refer-article message-id))
 	  (gnus-summary-refer-article message-id))))
      (group
@@ -6541,10 +6815,10 @@ specified by `gnus-button-alist'."
   (if (string-match "\\([^#]+\\)#?\\(.*\\)" url)
       (gnus-info-find-node
        (concat "("
-	       (gnus-url-unhex-string 
+	       (gnus-url-unhex-string
 		 (match-string 1 url))
 	       ")"
-	       (or (gnus-url-unhex-string 
+	       (or (gnus-url-unhex-string
 		    (match-string 2 url))
 		   "Top")))
     (error "Can't parse %s" url)))
@@ -6560,6 +6834,13 @@ specified by `gnus-button-alist'."
   (Info-directory)
   (Info-menu url))
 
+(defun gnus-button-openpgp (url)
+  "Retrieve and add an OpenPGP key given URL from an OpenPGP header."
+  (with-temp-buffer
+    (mm-url-insert-file-contents-external url)
+    (pgg-snarf-keys-region (point-min) (point-max))
+    (pgg-display-output-buffer nil nil nil)))
+
 (defun gnus-button-message-id (message-id)
   "Fetch MESSAGE-ID."
   (with-current-buffer gnus-summary-buffer
@@ -6583,7 +6864,7 @@ specified by `gnus-button-alist'."
 				     (match-string 3 address)
 				   "nntp")))
        nil nil nil
-       (and (match-end 6) (list (string-to-int (match-string 6 address))))))))
+       (and (match-end 6) (list (string-to-number (match-string 6 address))))))))
 
 (defun gnus-url-parse-query-string (query &optional downcase)
   (let (retval pairs cur key val)
@@ -6844,7 +7125,7 @@ For example:
     current-prefix-arg))
   (let ((func (cdr (assoc protocol gnus-article-encrypt-protocol-alist))))
     (unless func
-      (error (format "Can't find the encrypt protocol %s" protocol)))
+      (error "Can't find the encrypt protocol %s" protocol))
     (if (member gnus-newsgroup-name '("nndraft:delayed"
 				      "nndraft:drafts"
 				      "nndraft:queue"))