emacs: lisp/gnus/gnus-art.el comparison

comparison lisp/gnus/gnus-art.el @ 85712:a3c27999decb

Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Revision: emacs@sv.gnu.org/emacs--devo--0--patch-911

author	Miles Bader <miles@gnu.org>
date	Sun, 28 Oct 2007 09:18:39 +0000
parents	d7862063d437
children	a3af441f6431

comparison

equal deleted inserted replaced

-:b6f5dc84b2e1
+:a3c27999decb
 (require 'cl)
 (defvar tool-bar-map)
 (defvar w3m-minor-mode-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)
 (require 'mm-bodies)
 (require 'mail-parse)
 (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")
+(autoload 'mm-url-insert-file-contents-external "mm-url")
 (autoload 'mm-extern-cache-contents "mm-extern")
 (defgroup gnus-article nil
 "Article display."
 :link '(custom-manual "(gnus)Article Buffer")
 "X-Content-length" "X-Posting-Agent" "Original-Received"
 "X-Request-PGP" "X-Fingerprint" "X-WRIEnvto" "X-WRIEnvfrom"
 "X-Virus-Scanned" "X-Delivery-Agent" "Posted-Date" "X-Gateway"
 "X-Local-Origin" "X-Local-Destination" "X-UserInfo1"
 "X-Received-Date" "X-Hashcash" "Face" "X-DMCA-Notifications"
-"X-Abuse-and-DMCA-Info" "X-Postfilter" "X-Gpg-.*" "X-Disclaimer"))
+"X-Abuse-and-DMCA-Info" "X-Postfilter" "X-Gpg-.*" "X-Disclaimer"
+"Envelope-To" "X-Spam-Score" "System-Type" "X-Injected-Via-Gmane"
+"X-Gmane-NNTP-Posting-Host" "Jabber-ID" "Archived-At"
+"Envelope-Sender" "Envelope-Recipients"))
 "*All headers that start with this regexp will be hidden.
 This variable can also be a list of regexps of headers to be ignored.
 If `gnus-visible-headers' is non-nil, this variable will be ignored."
 :type '(choice :custom-show nil
 		 regexp
 If it is a number, no signature may not be longer (in characters) than
 that number.  If it is a floating point number, no signature may be
 longer (in lines) than that number.  If it is a function, the function
 will be called without any parameters, and if it returns nil, there is
 no signature in the buffer.  If it is a string, it will be used as a
-regexp.  If it matches, the text in question is not a signature."
+regexp.  If it matches, the text in question is not a signature.
+This can also be a list of the above values."
 :type '(choice (const nil)
 		 (integer :value 200)
 		 (number :value 4.0)
 		 function
 		 (regexp :value ".*"))
 		     :value
 		     (gnus-emphasis-custom-value-to-external value))))
 	      (widget-group-value-create widget))
 	    regexp
 	    (integer :format "Match group: %v")
-	    (integer  :format "Emphasize group: %v")
+	    (integer :format "Emphasize group: %v")
 	    face)
 (group :tag "Simple"
 	    :value (("_" . "_") nil default)
 	    (cons :format "%v"
 		  (regexp :format "Start regexp: %v")
 (defface gnus-emphasis-highlight-words
 '((t (:background "black" :foreground "yellow")))
 "Face used for displaying highlighted words."
 :group 'gnus-article-emphasis)
-(defcustom gnus-article-time-format "%a, %b %d %Y %T %Z"
+(defcustom gnus-article-time-format "%a, %d %b %Y %T %Z"
 "Format for display of Date headers in article bodies.
 See `format-time-string' for the possible values.
 The variable can also be function, which should return a complete Date
 header.  The function is called with one argument, the time, which can
 be fed to `format-time-string'."
-:type '(choice string symbol)
+:type '(choice string function)
 :link '(custom-manual "(gnus)Article Date")
 :group 'gnus-article-washing)
 (defcustom gnus-save-all-headers t
 "*If non-nil, don't remove any headers before saving.
 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
+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.
+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 evalled in the same buffer.
+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
+If this form or function returns a string, this string will be used as a
-a possible file name; and if it returns a non-nil list, that list will
+possible file name; and if it returns a non-nil list, that list will be
-be used as possible file names."
+used as possible file names."
 :group 'gnus-article-saving
 :type '(repeat (choice (list :value (fun) function)
 			 (cons :value ("" "") regexp (repeat string))
 			 (sexp :value nil))))
 (defcustom gnus-article-prepare-hook nil
 "*A hook called after an article has been prepared in the article buffer."
 :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.")
-(defcustom gnus-article-button-face 'bold
+(defface gnus-button
+'((t (:weight bold)))
+"Face used for highlighting a button in the article buffer."
+:group 'gnus-article-buttons)
+(defcustom gnus-article-button-face 'gnus-button
 "Face used for highlighting buttons in the article buffer.
 An article button is a piece of text that you can activate by pressing
 `RET' or `mouse-2' above it."
 :type 'face
 (put 'gnus-signature-face 'face-alias 'gnus-signature)
 (defface gnus-header-from
 '((((class color)
 (background dark))
-(:foreground "spring green"))
+(:foreground "PaleGreen1"))
 (((class color)
 (background light))
 (:foreground "red3"))
 (t
 (:italic t)))
 (put 'gnus-header-from-face 'face-alias 'gnus-header-from)
 (defface gnus-header-subject
 '((((class color)
 (background dark))
-(:foreground "SeaGreen3"))
+(:foreground "SeaGreen1"))
 (((class color)
 (background light))
 (:foreground "red4"))
 (t
 (:bold t :italic t)))
 (put 'gnus-header-newsgroups-face 'face-alias 'gnus-header-newsgroups)
 (defface gnus-header-name
 '((((class color)
 (background dark))
-(:foreground "SeaGreen"))
+(:foreground "SpringGreen2"))
 (((class color)
 (background light))
 (:foreground "maroon"))
 (t
 (:bold t)))
 (put 'gnus-header-name-face 'face-alias 'gnus-header-name)
 (defface gnus-header-content
 '((((class color)
 (background dark))
-(:foreground "forest green" :italic t))
+(:foreground "SpringGreen1" :italic t))
 (((class color)
 (background light))
 (:foreground "indianred4" :italic t))
 (t
 (:italic t)))  "Face used for displaying header content."
 			       (item :tag "skip" nil)
 			       (face :value default))
 		       (choice :tag "Content"
 			       (item :tag "skip" nil)
 			       (face :value default)))))
+(defcustom gnus-face-properties-alist (if (featurep 'xemacs)
+					  '((xface . (:face gnus-x-face)))
+					'((pbm . (:face gnus-x-face))
+					  (png . nil)))
+"Alist of image types and properties applied to Face and X-Face images.
+Here are examples:
+;; Specify the altitude of Face images in the From header.
+\(setq gnus-face-properties-alist
+'((pbm . (:face gnus-x-face :ascent 80))
+	(png . (:ascent 80))))
+;; Show Face images as pressed buttons.
+\(setq gnus-face-properties-alist
+'((pbm . (:face gnus-x-face :relief -2))
+	(png . (:relief -2))))
+See the manual for the valid properties for various image types.
+Currently, `pbm' is used for X-Face images and `png' is used for Face
+images in Emacs.  Only the `:face' property is effective on the `xface'
+image type in XEmacs if it is built with the libcompface library."
+:version "23.0" ;; No Gnus
+:group 'gnus-article-headers
+:type '(repeat (cons :format "%v" (symbol :tag "Image type") plist)))
 (defcustom gnus-article-decode-hook
 '(article-decode-charset article-decode-encoded-words
 			   article-decode-group-name article-decode-idna-rhs)
 "*Hook run to decode charsets in articles."
 (defcustom gnus-mime-multipart-functions nil
 "An alist of MIME types to functions to display them."
 :version "21.1"
 :group 'gnus-article-mime
-:type 'alist)
+:type '(repeat (cons :format "%v" (string :tag "MIME type") function)))
 (defcustom gnus-article-date-lapsed-new-header nil
 "Whether the X-Sent and Date headers can coexist.
 When using `gnus-treat-date-lapsed', the \"X-Sent:\" header will
 either replace the old \"Date:\" header (if this variable is nil), or
 	  (function)))
 (defcustom gnus-mime-action-alist
 '(("save to file" . gnus-mime-save-part)
 ("save and strip" . gnus-mime-save-part-and-strip)
+("replace with file" . gnus-mime-replace-part)
 ("delete part" . gnus-mime-delete-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)
 "An alist of actions that run on the MIME attachment."
 :group 'gnus-article-mime
 :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
 ;;;
 (defvar gnus-part-display-hook nil
 (defvar gnus-article-treat-custom
 '(choice (const :tag "Off" nil)
 	   (const :tag "On" t)
 	   (const :tag "Header" head)
+	   (const :tag "First" first)
 	   (const :tag "Last" last)
 	   (integer :tag "Less")
 	   (repeat :tag "Groups" regexp)
 	   (sexp :tag "Predicate")))
 (defvar gnus-article-treat-head-custom
 '(choice (const :tag "Off" nil)
 	   (const :tag "Header" head)))
-(defvar gnus-article-treat-types '("text/plain")
+(defvar gnus-article-treat-types '("text/plain" "text/x-verbatim"
+				   "text/x-patch")
 "Parts to treat.")
 (defvar gnus-inhibit-treatment nil
 "Whether to inhibit treatment.")
 (defcustom gnus-treat-highlight-signature '(or t (typep "text/x-vcard"))
 "Highlight the signature.
-Valid values are nil, t, `head', `last', an integer or a predicate.
+Valid values are nil, t, `head', `first', `last', an integer or a
-See Info node `(gnus)Customizing Articles'."
+predicate.  See Info node `(gnus)Customizing Articles'."
 :group 'gnus-article-treat
 :link '(custom-manual "(gnus)Customizing Articles")
 :type gnus-article-treat-custom)
 (put 'gnus-treat-highlight-signature 'highlight t)
 (defcustom gnus-treat-buttonize 100000
 "Add buttons.
-Valid values are nil, t, `head', `last', an integer or a predicate.
+Valid values are nil, t, `head', `first', `last', an integer or a
-See Info node `(gnus)Customizing Articles'."
+predicate.  See Info node `(gnus)Customizing Articles'."
 :group 'gnus-article-treat
 :link '(custom-manual "(gnus)Customizing Articles")
 :type gnus-article-treat-custom)
 (put 'gnus-treat-buttonize 'highlight t)
 (defcustom gnus-treat-buttonize-head 'head
 "Add buttons to the head.
-Valid values are nil, t, `head', `last', an integer or a predicate.
+Valid values are nil, t, `head', `first', `last', an integer or a
-See Info node `(gnus)Customizing Articles' for details."
+predicate.  See Info node `(gnus)Customizing Articles'."
 :group 'gnus-article-treat
 :link '(custom-manual "(gnus)Customizing Articles")
 :type gnus-article-treat-head-custom)
 (put 'gnus-treat-buttonize-head 'highlight t)
 (defcustom gnus-treat-emphasize
 (and (or window-system
-	   (featurep 'xemacs)
+	   (featurep 'xemacs))
-	   (>= (string-to-number emacs-version) 21))
 50000)
 "Emphasize text.
-Valid values are nil, t, `head', `last', an integer or a predicate.
+Valid values are nil, t, `head', `first', `last', an integer or a
-See Info node `(gnus)Customizing Articles' for details."
+predicate.  See Info node `(gnus)Customizing Articles'."
 :group 'gnus-article-treat
 :link '(custom-manual "(gnus)Customizing Articles")
 :type gnus-article-treat-custom)
 (put 'gnus-treat-emphasize 'highlight t)
 (defcustom gnus-treat-strip-cr nil
 "Remove carriage returns.
-Valid values are nil, t, `head', `last', an integer or a predicate.
+Valid values are nil, t, `head', `first', `last', an integer or a
-See Info node `(gnus)Customizing Articles' for details."
+predicate.  See Info node `(gnus)Customizing Articles'."
 :version "22.1"
 :group 'gnus-article-treat
 :link '(custom-manual "(gnus)Customizing Articles")
 :type gnus-article-treat-custom)
 (defcustom gnus-treat-unsplit-urls nil
 "Remove newlines from within URLs.
-Valid values are nil, t, `head', `last', an integer or a predicate.
+Valid values are nil, t, `head', `first', `last', an integer or a
-See Info node `(gnus)Customizing Articles' for details."
+predicate.  See Info node `(gnus)Customizing Articles'."
 :version "22.1"
 :group 'gnus-article-treat
 :link '(custom-manual "(gnus)Customizing Articles")
 :type gnus-article-treat-custom)
 (defcustom gnus-treat-leading-whitespace nil
 "Remove leading whitespace in headers.
-Valid values are nil, t, `head', `last', an integer or a predicate.
+Valid values are nil, t, `head', `first', `last', an integer or a
-See Info node `(gnus)Customizing Articles' for details."
+predicate.  See Info node `(gnus)Customizing Articles'."
 :version "22.1"
 :group 'gnus-article-treat
 :link '(custom-manual "(gnus)Customizing Articles")
 :type gnus-article-treat-custom)
 (defcustom gnus-treat-hide-headers 'head
 "Hide headers.
-Valid values are nil, t, `head', `last', an integer or a predicate.
+Valid values are nil, t, `head', `first', `last', an integer or a
-See Info node `(gnus)Customizing Articles' for details."
+predicate.  See Info node `(gnus)Customizing Articles'."
 :group 'gnus-article-treat
 :link '(custom-manual "(gnus)Customizing Articles")
 :type gnus-article-treat-head-custom)
 (defcustom gnus-treat-hide-boring-headers nil
 "Hide boring headers.
-Valid values are nil, t, `head', `last', an integer or a predicate.
+Valid values are nil, t, `head', `first', `last', an integer or a
-See Info node `(gnus)Customizing Articles' for details."
+predicate.  See Info node `(gnus)Customizing Articles'."
 :group 'gnus-article-treat
 :link '(custom-manual "(gnus)Customizing Articles")
 :type gnus-article-treat-head-custom)
 (defcustom gnus-treat-hide-signature nil
 "Hide the signature.
-Valid values are nil, t, `head', `last', an integer or a predicate.
+Valid values are nil, t, `head', `first', `last', an integer or a
-See Info node `(gnus)Customizing Articles' for details."
+predicate.  See Info node `(gnus)Customizing Articles'."
 :group 'gnus-article-treat
 :link '(custom-manual "(gnus)Customizing Articles")
 :type gnus-article-treat-custom)
 (defcustom gnus-treat-fill-article nil
 "Fill the article.
-Valid values are nil, t, `head', `last', an integer or a predicate.
+Valid values are nil, t, `head', `first', `last', an integer or a
-See Info node `(gnus)Customizing Articles' for details."
+predicate.  See Info node `(gnus)Customizing Articles'."
 :group 'gnus-article-treat
 :link '(custom-manual "(gnus)Customizing Articles")
 :type gnus-article-treat-custom)
 (defcustom gnus-treat-hide-citation nil
 "Hide cited text.
-Valid values are nil, t, `head', `last', an integer or a predicate.
+Valid values are nil, t, `head', `first', `last', an integer or a
-See Info node `(gnus)Customizing Articles' for details."
+predicate.  See Info node `(gnus)Customizing Articles'."
 :group 'gnus-article-treat
 :link '(custom-manual "(gnus)Customizing Articles")
 :type gnus-article-treat-custom)
 (defcustom gnus-treat-hide-citation-maybe nil
 "Hide cited text.
-Valid values are nil, t, `head', `last', an integer or a predicate.
+Valid values are nil, t, `head', `first', `last', an integer or a
-See Info node `(gnus)Customizing Articles' for details."
+predicate.  See Info node `(gnus)Customizing Articles'."
 :group 'gnus-article-treat
 :link '(custom-manual "(gnus)Customizing Articles")
 :type gnus-article-treat-custom)
 (defcustom gnus-treat-strip-list-identifiers 'head
 "Strip list identifiers from `gnus-list-identifiers`.
-Valid values are nil, t, `head', `last', an integer or a predicate.
+Valid values are nil, t, `head', `first', `last', an integer or a
-See Info node `(gnus)Customizing Articles' for details."
+predicate.  See Info node `(gnus)Customizing Articles'."
 :version "21.1"
 :group 'gnus-article-treat
 :link '(custom-manual "(gnus)Customizing Articles")
 :type gnus-article-treat-custom)
 (make-obsolete-variable 'gnus-treat-strip-pgp
 			"This option is obsolete in Gnus 5.10.")
 (defcustom gnus-treat-strip-pem nil
 "Strip PEM signatures.
-Valid values are nil, t, `head', `last', an integer or a predicate.
+Valid values are nil, t, `head', `first', `last', an integer or a
-See Info node `(gnus)Customizing Articles' for details."
+predicate.  See Info node `(gnus)Customizing Articles'."
 :group 'gnus-article-treat
 :link '(custom-manual "(gnus)Customizing Articles")
 :type gnus-article-treat-custom)
 (defcustom gnus-treat-strip-banner t
 "Strip banners from articles.
 The banner to be stripped is specified in the `banner' group parameter.
-Valid values are nil, t, `head', `last', an integer or a predicate.
+Valid values are nil, t, `head', `first', `last', an integer or a
-See Info node `(gnus)Customizing Articles' for details."
+predicate.  See Info node `(gnus)Customizing Articles'."
 :group 'gnus-article-treat
 :link '(custom-manual "(gnus)Customizing Articles")
 :type gnus-article-treat-custom)
 (defcustom gnus-treat-highlight-headers 'head
 "Highlight the headers.
-Valid values are nil, t, `head', `last', an integer or a predicate.
+Valid values are nil, t, `head', `first', `last', an integer or a
-See Info node `(gnus)Customizing Articles' for details."
+predicate.  See Info node `(gnus)Customizing Articles'."
 :group 'gnus-article-treat
 :link '(custom-manual "(gnus)Customizing Articles")
 :type gnus-article-treat-head-custom)
 (put 'gnus-treat-highlight-headers 'highlight t)
 (defcustom gnus-treat-highlight-citation t
 "Highlight cited text.
-Valid values are nil, t, `head', `last', an integer or a predicate.
+Valid values are nil, t, `head', `first', `last', an integer or a
-See Info node `(gnus)Customizing Articles' for details."
+predicate.  See Info node `(gnus)Customizing Articles'."
 :group 'gnus-article-treat
 :link '(custom-manual "(gnus)Customizing Articles")
 :type gnus-article-treat-custom)
 (put 'gnus-treat-highlight-citation 'highlight t)
 (defcustom gnus-treat-date-ut nil
 "Display the Date in UT (GMT).
-Valid values are nil, t, `head', `last', an integer or a predicate.
+Valid values are nil, t, `head', `first', `last', an integer or a
-See Info node `(gnus)Customizing Articles' for details."
+predicate.  See Info node `(gnus)Customizing Articles'."
 :group 'gnus-article-treat
 :link '(custom-manual "(gnus)Customizing Articles")
 :type gnus-article-treat-head-custom)
 (defcustom gnus-treat-date-local nil
 "Display the Date in the local timezone.
-Valid values are nil, t, `head', `last', an integer or a predicate.
+Valid values are nil, t, `head', `first', `last', an integer or a
-See Info node `(gnus)Customizing Articles' for details."
+predicate.  See Info node `(gnus)Customizing Articles'."
 :group 'gnus-article-treat
 :link '(custom-manual "(gnus)Customizing Articles")
 :type gnus-article-treat-head-custom)
 (defcustom gnus-treat-date-english nil
 "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.
+Valid values are nil, t, `head', `first', `last', an integer or a
-See Info node `(gnus)Customizing Articles' for details."
+predicate.  See Info node `(gnus)Customizing Articles'."
 :version "22.1"
 :group 'gnus-article-treat
 :link '(custom-manual "(gnus)Customizing Articles")
 :type gnus-article-treat-head-custom)
 (defcustom gnus-treat-date-lapsed nil
 "Display the Date header in a way that says how much time has elapsed.
-Valid values are nil, t, `head', `last', an integer or a predicate.
+Valid values are nil, t, `head', `first', `last', an integer or a
-See Info node `(gnus)Customizing Articles' for details."
+predicate.  See Info node `(gnus)Customizing Articles'."
 :group 'gnus-article-treat
 :link '(custom-manual "(gnus)Customizing Articles")
 :type gnus-article-treat-head-custom)
 (defcustom gnus-treat-date-original nil
 "Display the date in the original timezone.
-Valid values are nil, t, `head', `last', an integer or a predicate.
+Valid values are nil, t, `head', `first', `last', an integer or a
-See Info node `(gnus)Customizing Articles' for details."
+predicate.  See Info node `(gnus)Customizing Articles'."
 :group 'gnus-article-treat
 :link '(custom-manual "(gnus)Customizing Articles")
 :type gnus-article-treat-head-custom)
 (defcustom gnus-treat-date-iso8601 nil
 "Display the date in the ISO8601 format.
-Valid values are nil, t, `head', `last', an integer or a predicate.
+Valid values are nil, t, `head', `first', `last', an integer or a
-See Info node `(gnus)Customizing Articles' for details."
+predicate.  See Info node `(gnus)Customizing Articles'."
 :version "21.1"
 :group 'gnus-article-treat
 :link '(custom-manual "(gnus)Customizing Articles")
 :type gnus-article-treat-head-custom)
 (defcustom gnus-treat-date-user-defined nil
 "Display the date in a user-defined format.
 The format is defined by the `gnus-article-time-format' variable.
-Valid values are nil, t, `head', `last', an integer or a predicate.
+Valid values are nil, t, `head', `first', `last', an integer or a
-See Info node `(gnus)Customizing Articles' for details."
+predicate.  See Info node `(gnus)Customizing Articles'."
 :group 'gnus-article-treat
 :link '(custom-manual "(gnus)Customizing Articles")
 :type gnus-article-treat-head-custom)
 (defcustom gnus-treat-strip-headers-in-body t
 "Strip the X-No-Archive header line from the beginning of the body.
-Valid values are nil, t, `head', `last', an integer or a predicate.
+Valid values are nil, t, `head', `first', `last', an integer or a
-See Info node `(gnus)Customizing Articles' for details."
+predicate.  See Info node `(gnus)Customizing Articles'."
 :version "21.1"
 :group 'gnus-article-treat
 :link '(custom-manual "(gnus)Customizing Articles")
 :type gnus-article-treat-custom)
 (defcustom gnus-treat-strip-trailing-blank-lines nil
 "Strip trailing blank lines.
-Valid values are nil, t, `head', `last', an integer or a predicate.
+Valid values are nil, t, `head', `first', `last', an integer or a
-See Info node `(gnus)Customizing Articles' for details.
+predicate.  See Info node `(gnus)Customizing Articles'.
 When set to t, it also strips trailing blanks in all MIME parts.
 Consider to use `last' instead."
 :group 'gnus-article-treat
 :link '(custom-manual "(gnus)Customizing Articles")
 :type gnus-article-treat-custom)
 (defcustom gnus-treat-strip-leading-blank-lines nil
 "Strip leading blank lines.
-Valid values are nil, t, `head', `last', an integer or a predicate.
+Valid values are nil, t, `head', `first', `last', an integer or a
-See Info node `(gnus)Customizing Articles' for details.
+predicate.  See Info node `(gnus)Customizing Articles'.
 When set to t, it also strips trailing blanks in all MIME parts."
 :group 'gnus-article-treat
 :link '(custom-manual "(gnus)Customizing Articles")
 :type gnus-article-treat-custom)
 (defcustom gnus-treat-strip-multiple-blank-lines nil
 "Strip multiple blank lines.
-Valid values are nil, t, `head', `last', an integer or a predicate.
+Valid values are nil, t, `head', `first', `last', an integer or a
-See Info node `(gnus)Customizing Articles' for details."
+predicate.  See Info node `(gnus)Customizing Articles'."
 :group 'gnus-article-treat
 :link '(custom-manual "(gnus)Customizing Articles")
 :type gnus-article-treat-custom)
 (defcustom gnus-treat-unfold-headers 'head
 "Unfold folded header lines.
-Valid values are nil, t, `head', `last', an integer or a predicate.
+Valid values are nil, t, `head', `first', `last', an integer or a
-See Info node `(gnus)Customizing Articles' for details."
+predicate.  See Info node `(gnus)Customizing Articles'."
 :version "22.1"
 :group 'gnus-article-treat
 :link '(custom-manual "(gnus)Customizing Articles")
 :type gnus-article-treat-custom)
+(defcustom gnus-article-unfold-long-headers nil
+"If non-nil, allow unfolding headers even if the header is long.
+If it is a regexp, only long headers matching this regexp are unfolded.
+If it is t, all long headers are unfolded.
+This variable has no effect if `gnus-treat-unfold-headers' is nil."
+:version "23.0" ;; No Gnus
+:group 'gnus-article-treat
+:type '(choice (const nil)
+		 (const :tag "all" t)
+		 (regexp)))
 (defcustom gnus-treat-fold-headers nil
 "Fold headers.
-Valid values are nil, t, `head', `last', an integer or a predicate.
+Valid values are nil, t, `head', `first', `last', an integer or a
-See Info node `(gnus)Customizing Articles' for details."
+predicate.  See Info node `(gnus)Customizing Articles'."
 :version "22.1"
 :group 'gnus-article-treat
 :link '(custom-manual "(gnus)Customizing Articles")
 :type gnus-article-treat-custom)
 (defcustom gnus-treat-fold-newsgroups 'head
 "Fold the Newsgroups and Followup-To headers.
-Valid values are nil, t, `head', `last', an integer or a predicate.
+Valid values are nil, t, `head', `first', `last', an integer or a
-See Info node `(gnus)Customizing Articles' for details."
+predicate.  See Info node `(gnus)Customizing Articles'."
 :version "22.1"
 :group 'gnus-article-treat
 :link '(custom-manual "(gnus)Customizing Articles")
 :type gnus-article-treat-custom)
 (defcustom gnus-treat-overstrike t
 "Treat overstrike highlighting.
-Valid values are nil, t, `head', `last', an integer or a predicate.
+Valid values are nil, t, `head', `first', `last', an integer or a
-See Info node `(gnus)Customizing Articles' for details."
+predicate.  See Info node `(gnus)Customizing Articles'."
 :group 'gnus-article-treat
 :link '(custom-manual "(gnus)Customizing Articles")
 :type gnus-article-treat-custom)
 (put 'gnus-treat-overstrike 'highlight t)
+(defcustom gnus-treat-ansi-sequences (if (locate-library "ansi-color") t)
+"Treat ANSI SGR control sequences.
+Valid values are nil, t, `head', `first', `last', an integer or a
+predicate.  See Info node `(gnus)Customizing Articles'."
+:group 'gnus-article-treat
+:link '(custom-manual "(gnus)Customizing Articles")
+:type gnus-article-treat-custom)
 (make-obsolete-variable 'gnus-treat-display-xface
 			'gnus-treat-display-x-face)
 (defcustom gnus-treat-display-x-face
 (defcustom gnus-treat-display-face
 (and (not noninteractive)
 (gnus-image-type-available-p 'png)
 'head)
 "Display Face headers.
-Valid values are nil, t, `head', `last', an integer or a predicate.
+Valid values are nil, t, `head', `first', `last', an integer or a
-See Info node `(gnus)Customizing Articles' and Info node
+predicate.  See Info node `(gnus)Customizing Articles' and Info
-`(gnus)X-Face' for details."
+node `(gnus)X-Face' for details."
 :group 'gnus-article-treat
 :version "22.1"
 :link '(custom-manual "(gnus)Customizing Articles")
 :link '(custom-manual "(gnus)X-Face")
 :type gnus-article-treat-head-custom)
 (put 'gnus-treat-display-face 'highlight t)
 (defcustom gnus-treat-display-smileys (gnus-image-type-available-p 'xpm)
 "Display smileys.
-Valid values are nil, t, `head', `last', an integer or a predicate.
+Valid values are nil, t, `head', `first', `last', an integer or a
-See Info node `(gnus)Customizing Articles' and Info node
+predicate.  See Info node `(gnus)Customizing Articles' and Info
-`(gnus)Smileys' for details."
+node `(gnus)Smileys' for details."
 :group 'gnus-article-treat
 :version "21.1"
 :link '(custom-manual "(gnus)Customizing Articles")
 :link '(custom-manual "(gnus)Smileys")
 :type gnus-article-treat-custom)
 (defcustom gnus-treat-from-picon
 (if (and (gnus-image-type-available-p 'xpm)
 	   (gnus-picons-installed-p))
 'head nil)
 "Display picons in the From header.
-Valid values are nil, t, `head', `last', an integer or a predicate.
+Valid values are nil, t, `head', `first', `last', an integer or a
-See Info node `(gnus)Customizing Articles' and Info node
+predicate.  See Info node `(gnus)Customizing Articles' and Info
-`(gnus)Picons' for details."
+node `(gnus)Picons' for details."
 :version "22.1"
 :group 'gnus-article-treat
 :group 'gnus-picon
 :link '(custom-manual "(gnus)Customizing Articles")
 :link '(custom-manual "(gnus)Picons")
 (defcustom gnus-treat-mail-picon
 (if (and (gnus-image-type-available-p 'xpm)
 	   (gnus-picons-installed-p))
 'head nil)
 "Display picons in To and Cc headers.
-Valid values are nil, t, `head', `last', an integer or a predicate.
+Valid values are nil, t, `head', `first', `last', an integer or a
-See Info node `(gnus)Customizing Articles' and Info node
+predicate.  See Info node `(gnus)Customizing Articles' and Info
-`(gnus)Picons' for details."
+node `(gnus)Picons' for details."
 :version "22.1"
 :group 'gnus-article-treat
 :group 'gnus-picon
 :link '(custom-manual "(gnus)Customizing Articles")
 :link '(custom-manual "(gnus)Picons")
 (defcustom gnus-treat-newsgroups-picon
 (if (and (gnus-image-type-available-p 'xpm)
 	   (gnus-picons-installed-p))
 'head nil)
 "Display picons in the Newsgroups and Followup-To headers.
-Valid values are nil, t, `head', `last', an integer or a predicate.
+Valid values are nil, t, `head', `first', `last', an integer or a
-See Info node `(gnus)Customizing Articles' and Info node
+predicate.  See Info node `(gnus)Customizing Articles' and Info
-`(gnus)Picons' for details."
+node `(gnus)Picons' for details."
 :version "22.1"
 :group 'gnus-article-treat
 :group 'gnus-picon
 :link '(custom-manual "(gnus)Customizing Articles")
 :link '(custom-manual "(gnus)Picons")
 :type gnus-article-treat-head-custom)
 (put 'gnus-treat-newsgroups-picon 'highlight t)
 (defcustom gnus-treat-body-boundary
-(if (or gnus-treat-newsgroups-picon
+(if (and (eq window-system 'x)
-	  gnus-treat-mail-picon
+	   (or gnus-treat-newsgroups-picon
-	  gnus-treat-from-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 "22.1"
 :link '(custom-manual "(gnus)Customizing Articles")
 :type gnus-article-treat-head-custom)
 (defcustom gnus-treat-capitalize-sentences nil
 "Capitalize sentence-starting words.
-Valid values are nil, t, `head', `last', an integer or a predicate.
+Valid values are nil, t, `head', `first', `last', an integer or a
-See Info node `(gnus)Customizing Articles' for details."
+predicate.  See Info node `(gnus)Customizing Articles'."
 :version "21.1"
 :group 'gnus-article-treat
 :link '(custom-manual "(gnus)Customizing Articles")
 :type gnus-article-treat-custom)
 (defcustom gnus-treat-wash-html nil
 "Format as HTML.
-Valid values are nil, t, `head', `last', an integer or a predicate.
+Valid values are nil, t, `head', `first', `last', an integer or a
-See Info node `(gnus)Customizing Articles' for details."
+predicate.  See Info node `(gnus)Customizing Articles'."
 :version "22.1"
 :group 'gnus-article-treat
 :link '(custom-manual "(gnus)Customizing Articles")
 :type gnus-article-treat-custom)
 (defcustom gnus-treat-fill-long-lines nil
 "Fill long lines.
-Valid values are nil, t, `head', `last', an integer or a predicate.
+Valid values are nil, t, `head', `first', `last', an integer or a
-See Info node `(gnus)Customizing Articles' for details."
+predicate.  See Info node `(gnus)Customizing Articles'."
 :group 'gnus-article-treat
 :link '(custom-manual "(gnus)Customizing Articles")
 :type gnus-article-treat-custom)
 (defcustom gnus-treat-play-sounds nil
 "Play sounds.
-Valid values are nil, t, `head', `last', an integer or a predicate.
+Valid values are nil, t, `head', `first', `last', an integer or a
-See Info node `(gnus)Customizing Articles' for details."
+predicate.  See Info node `(gnus)Customizing Articles'."
 :version "21.1"
 :group 'gnus-article-treat
 :link '(custom-manual "(gnus)Customizing Articles")
 :type gnus-article-treat-custom)
 (defcustom gnus-treat-translate nil
 "Translate articles from one language to another.
-Valid values are nil, t, `head', `last', an integer or a predicate.
+Valid values are nil, t, `head', `first', `last', an integer or a
-See Info node `(gnus)Customizing Articles' for details."
+predicate.  See Info node `(gnus)Customizing Articles'."
 :version "21.1"
 :group 'gnus-article-treat
 :link '(custom-manual "(gnus)Customizing Articles")
 :type gnus-article-treat-custom)
 (defcustom gnus-treat-x-pgp-sig nil
 "Verify X-PGP-Sig.
 To automatically treat X-PGP-Sig, set it to head.
-Valid values are nil, t, `head', `last', an integer or a predicate.
+Valid values are nil, t, `head', `first', `last', an integer or a
-See Info node `(gnus)Customizing Articles' for details."
+predicate.  See Info node `(gnus)Customizing Articles'."
 :version "22.1"
 :group 'gnus-article-treat
 :group 'mime-security
 :link '(custom-manual "(gnus)Customizing Articles")
 :type gnus-article-treat-custom)
 (gnus-treat-strip-leading-blank-lines
 gnus-article-strip-leading-blank-lines)
 (gnus-treat-strip-multiple-blank-lines
 gnus-article-strip-multiple-blank-lines)
 (gnus-treat-overstrike gnus-article-treat-overstrike)
+(gnus-treat-ansi-sequences gnus-article-treat-ansi-sequences)
 (gnus-treat-unfold-headers gnus-article-treat-unfold-headers)
+(gnus-treat-fold-newsgroups gnus-article-treat-fold-newsgroups)
 (gnus-treat-fold-headers gnus-article-treat-fold-headers)
-(gnus-treat-fold-newsgroups gnus-article-treat-fold-newsgroups)
 (gnus-treat-buttonize-head gnus-article-add-buttons-to-head)
 (gnus-treat-display-smileys gnus-treat-smiley)
 (gnus-treat-capitalize-sentences gnus-article-capitalize-sentences)
 (gnus-treat-wash-html gnus-article-wash-html)
 (gnus-treat-emphasize gnus-article-emphasize)
 (when (and (not (gnus-article-check-hidden-text 'boring-headers arg))
 	     (not gnus-show-all-headers))
 (save-excursion
 (save-restriction
 	(let ((inhibit-read-only t)
-	      (list gnus-boring-article-headers)
+	      (inhibit-point-motion-hooks t))
-	      (inhibit-point-motion-hooks t)
-	      elem)
 	  (article-narrow-to-head)
-	  (while list
+	  (dolist (elem gnus-boring-article-headers)
-	    (setq elem (pop list))
 	    (goto-char (point-min))
 	    (cond
 	     ;; Hide empty headers.
 	     ((eq elem 'empty)
 	      (while (re-search-forward "^[^: \t]+:[ \t]*\n[^ \t]" nil t)
 		(forward-line -1)
 		(gnus-article-hide-text-type
-		 (gnus-point-at-bol)
+		 (point-at-bol)
 		 (progn
 		   (end-of-line)
 		   (if (re-search-forward "^[^ \t]" nil t)
 		       (match-beginning 0)
 		     (point-max)))
 (defun gnus-article-hide-header (header)
 (save-excursion
 (goto-char (point-min))
 (when (re-search-forward (concat "^" header ":") nil t)
 (gnus-article-hide-text-type
-(gnus-point-at-bol)
+(point-at-bol)
 (progn
 	 (end-of-line)
 	 (if (re-search-forward "^[^ \t]" nil t)
 	     (match-beginning 0)
 	   (point-max)))
 (save-excursion
 (save-restriction
 	(article-narrow-to-head)
 	(while (not (eobp))
 	  (cond
-	   ((< (setq column (- (gnus-point-at-eol) (point)))
+	   ((< (setq column (- (point-at-eol) (point)))
 	       gnus-article-normalized-header-length)
 	    (end-of-line)
 	    (insert (make-string
 		     (- gnus-article-normalized-header-length column)
 		     ? )))
 	   ((> column gnus-article-normalized-header-length)
 	    (gnus-put-text-property
 	     (progn
 	       (forward-char gnus-article-normalized-header-length)
 	       (point))
-	     (gnus-point-at-eol)
+	     (point-at-eol)
 	     'invisible t))
 	   (t
 	    ;; Do nothing.
 	    ))
 	  (forward-line 1))))))
 (defun article-translate-strings (map)
 "Translate all string in the body of the article according to MAP.
 MAP is an alist where the elements are on the form (\"from\" \"to\")."
 (save-excursion
 (when (article-goto-body)
-(let ((inhibit-read-only t)
+(let ((inhibit-read-only t))
-	    elem)
+	(dolist (elem map)
-	(while (setq elem (pop map))
 	  (save-excursion
 	    (while (search-forward (car elem) nil t)
 	      (replace-match (cadr elem)))))))))
 (defun article-treat-overstrike ()
 	     ((eq previous ?_)
 	      (gnus-article-hide-text-type (- (point) 2) (point) 'overstrike)
 	      (put-text-property
 	       (point) (1+ (point)) 'face 'underline)))))))))
+(defun article-treat-ansi-sequences ()
+"Translate ANSI SGR control sequences into overlays or extents."
+(interactive)
+(save-excursion
+(when (article-goto-body)
+(let ((inhibit-read-only t))
+	(ansi-color-apply-on-region (point) (point-max))))))
 (defun gnus-article-treat-unfold-headers ()
 "Unfold folded message headers.
 Only the headers that fit into the current window width will be
 unfolded."
 (interactive)
 (gnus-with-article-headers
 (let (length)
 (while (not (eobp))
 	(save-restriction
 	  (mail-header-narrow-to-field)
-	  (let ((header (buffer-string)))
+	  (let* ((header (buffer-string))
+		 (unfoldable
+		  (or (equal gnus-article-unfold-long-headers t)
+		      (and (stringp gnus-article-unfold-long-headers)
+			   (string-match gnus-article-unfold-long-headers header)))))
 	    (with-temp-buffer
 	      (insert header)
 	      (goto-char (point-min))
 	      (while (re-search-forward "\n[\t ]" nil t)
 		(replace-match " " t t)))
-	    (setq length (- (point-max) (point-min) 1)))
+	    (setq length (- (point-max) (point-min) 1))
-	  (when (< length (window-width))
+	    (when (or unfoldable
-	    (while (re-search-forward "\n[\t ]" nil t)
+		      (< length (window-width)))
-	      (replace-match " " t t)))
+	      (while (re-search-forward "\n[\t ]" nil t)
+		(replace-match " " t t))))
 	  (goto-char (point-max)))))))
 (defun gnus-article-treat-fold-headers ()
 "Fold message headers."
 (interactive)
 	(mail-header-narrow-to-field)
 	(while (re-search-forward ", *" nil t)
 	  (replace-match ", " t t))
 	(mail-header-fold-field)
 	(goto-char (point-max))))))
+(defcustom gnus-article-truncate-lines default-truncate-lines
+"Value of `truncate-lines' in Gnus Article buffer.
+Valid values are nil, t, `head', `first', `last', an integer or a
+predicate.  See Info node `(gnus)Customizing Articles'."
+:version "23.0" ;; No Gnus
+:group 'gnus-article
+;; :link '(custom-manual "(gnus)Customizing Articles")
+:type 'boolean)
+(defun gnus-article-toggle-truncate-lines (&optional arg)
+"Toggle whether to fold or truncate long lines in article the buffer.
+If ARG is non-nil and not a number, toggle
+`gnus-article-truncate-lines' too.  If ARG is a number, truncate
+long lines iff arg is positive."
+(interactive "P")
+(cond
+((and (numberp arg) (> arg 0))
+(setq gnus-article-truncate-lines t))
+((numberp arg)
+(setq gnus-article-truncate-lines nil))
+(arg
+(setq gnus-article-truncate-lines
+	  (not gnus-article-truncate-lines))))
+(gnus-with-article-buffer
+(cond
+((and (numberp arg) (> arg 0))
+(setq truncate-lines nil))
+((numberp arg)
+(setq truncate-lines t)))
+;; In versions of Emacs 22 (CVS) before 2006-05-26,
+;; `toggle-truncate-lines' needs an argument.
+(toggle-truncate-lines)))
 (defun gnus-article-treat-body-boundary ()
 "Place a boundary line at the end of the headers."
 (interactive)
 (when (and gnus-body-boundary-delimiter
 	(let ((adaptive-fill-mode nil)) ;Why?  -sm
 	  (while (not (eobp))
 	    (end-of-line)
 	    (when (>= (current-column) (min fill-column width))
 	      (narrow-to-region (min (1+ (point)) (point-max))
-				(gnus-point-at-bol))
+				(point-at-bol))
 (let ((goback (point-marker)))
 (fill-paragraph nil)
 (goto-char (marker-position goback)))
 	      (widen))
 	    (forward-line 1)))))))
 (point)
 (progn
 	 (while (and (not (bobp))
 		     (looking-at "^[ \t]*$")
 		     (not (gnus-annotation-in-region-p
-			   (point) (gnus-point-at-eol))))
+			   (point) (point-at-eol))))
 	   (forward-line -1))
 	 (forward-line 1)
 	 (point))))))
+(eval-when-compile
+(defvar gnus-face-properties-alist))
 (defun article-display-face ()
 "Display any Face headers in the header."
 (interactive)
 (let ((wash-face-p buffer-read-only))
 		(insert "From:")
 		(setq from (point))
 		(insert "[no `from' set]\n"))
 	      (while faces
 		(when (setq png (gnus-convert-face-to-png (pop faces)))
-		  (setq image (gnus-create-image png 'png t))
+		  (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))))))))))
 			    gnus-article-x-face-command))))))))))
 (defun article-decode-mime-words ()
 "Decode all MIME-encoded words in the article."
 (interactive)
-(save-excursion
+(gnus-with-article-buffer
-(set-buffer gnus-article-buffer)
 (let ((inhibit-point-motion-hooks t)
-	  (inhibit-read-only t)
 	  (mail-parse-charset gnus-newsgroup-charset)
 	  (mail-parse-ignored-charsets
-	   (save-excursion (set-buffer gnus-summary-buffer)
+	   (with-current-buffer gnus-summary-buffer
-			   gnus-newsgroup-ignored-charsets)))
+	     gnus-newsgroup-ignored-charsets)))
 (mail-decode-encoded-word-region (point-min) (point-max)))))
 (defun article-decode-charset (&optional prompt)
 "Decode charset-encoded text in the article.
 If PROMPT (the prefix), prompt for a coding system to use."
 	  (funcall gnus-decode-address-function start end)
 	(funcall gnus-decode-header-function start end))
 (goto-char (setq end start)))))
 (defun article-decode-group-name ()
-"Decode group names in `Newsgroups:'."
+"Decode group names in Newsgroups, Followup-To and Xref headers."
 (let ((inhibit-point-motion-hooks t)
 	(inhibit-read-only t)
-	(method (gnus-find-method-for-group gnus-newsgroup-name)))
+	(method (gnus-find-method-for-group gnus-newsgroup-name))
+	regexp)
 (when (and (or gnus-group-name-charset-method-alist
 		   gnus-group-name-charset-group-alist)
 	       (gnus-buffer-live-p gnus-original-article-buffer))
 (save-restriction
 	(article-narrow-to-head)
-	(with-current-buffer gnus-original-article-buffer
+	(dolist (header '("Newsgroups" "Followup-To" "Xref"))
-	  (goto-char (point-min)))
+	  (with-current-buffer gnus-original-article-buffer
-	(while (re-search-forward
+	    (goto-char (point-min)))
-		"^Newsgroups:\\(\\(.\\|\n[\t ]\\)*\\)\n[^\t ]" nil t)
+	  (setq regexp (concat "^" header
-	  (replace-match (save-match-data
+			       ":\\([^\n]*\\(?:\n[\t ]+[^\n]+\\)*\\)\n"))
-			   (gnus-decode-newsgroups
+	  (while (re-search-forward regexp nil t)
-			    ;; XXX how to use data in article buffer?
+	    (replace-match (save-match-data
-			    (with-current-buffer gnus-original-article-buffer
+			     (gnus-decode-newsgroups
-			      (re-search-forward
+			      ;; XXX how to use data in article buffer?
-			       "^Newsgroups:\\(\\(.\\|\n[\t ]\\)*\\)\n[^\t ]"
+			      (with-current-buffer gnus-original-article-buffer
-			       nil t)
+				(re-search-forward regexp nil t)
-			      (match-string 1))
+				(match-string 1))
-			    gnus-newsgroup-name method))
+			      gnus-newsgroup-name method))
-			 t t nil 1))
+			   t t nil 1))
-	(goto-char (point-min))
+	  (goto-char (point-min)))))))
-	(with-current-buffer gnus-original-article-buffer
-	  (goto-char (point-min)))
-	(while (re-search-forward
-		"^Followup-To:\\(\\(.\\|\n[\t ]\\)*\\)\n[^\t ]" nil t)
-	  (replace-match (save-match-data
-			   (gnus-decode-newsgroups
-			    ;; XXX how to use data in article buffer?
-			    (with-current-buffer gnus-original-article-buffer
-			      (re-search-forward
-			       "^Followup-To:\\(\\(.\\|\n[\t ]\\)*\\)\n[^\t ]"
-			       nil t)
-			      (match-string 1))
-			    gnus-newsgroup-name method))
-			 t t nil 1))))))
 (autoload 'idna-to-unicode "idna")
 (defun article-decode-idna-rhs ()
 "Decode IDNA strings in RHS in various headers in current buffer.
 	   (point-min) (point-max)
 	   "w3m" t t nil "-dump" "-T" "text/html"
 	   "-I" (symbol-name charset) "-O" (symbol-name charset))))
 (mm-inline-wash-with-stdin nil "w3m" "-dump" "-T" "text/html")))
+(defvar gnus-article-browse-html-temp-list nil
+"List of temporary files created by `gnus-article-browse-html-parts'.
+Internal variable.")
+(defcustom gnus-article-browse-delete-temp 'ask
+"What to do with temporary files from `gnus-article-browse-html-parts'.
+If nil, don't delete temporary files.  If it is t, delete them on
+exit from the summary buffer.  If it is the symbol `file', query
+on each file, if it is `ask' ask once when exiting from the
+summary buffer."
+:group 'gnus-article
+:version "23.0" ;; No Gnus
+:type '(choice (const :tag "Don't delete" nil)
+		 (const :tag "Don't ask" t)
+		 (const :tag "Ask" ask)
+		 (const :tag "Ask for each file" file)))
+;; Cf. mm-postponed-undisplay-list / mm-destroy-postponed-undisplay-list.
+(defun gnus-article-browse-delete-temp-files (&optional how)
+"Delete temp-files created by `gnus-article-browse-html-parts'."
+(when (and gnus-article-browse-html-temp-list
+	     (or how
+		 (setq how gnus-article-browse-delete-temp)))
+(when (and (eq how 'ask)
+	       (y-or-n-p (format
+			  "Delete all %s temporary HTML file(s)? "
+			  (length gnus-article-browse-html-temp-list)))
+	       (setq how t)))
+(dolist (file gnus-article-browse-html-temp-list)
+(when (and (file-exists-p file)
+		 (or (eq how t)
+		     ;; `how' is neither `nil', `ask' nor `t' (i.e. `file'):
+		     (gnus-y-or-n-p
+		      (format "Delete temporary HTML file `%s'? " file))))
+	(delete-file file)))
+;; Also remove file from the list when not deleted or if file doesn't
+;; exist anymore.
+(setq gnus-article-browse-html-temp-list nil))
+gnus-article-browse-html-temp-list)
+(defun gnus-article-browse-html-parts (list)
+"View all \"text/html\" parts from LIST.
+Recurse into multiparts."
+;; Internal function used by `gnus-article-browse-html-article'.
+(let ((showed))
+;; Find and show the html-parts.
+(dolist (handle list)
+;; If HTML, show it:
+(when (listp handle)
+	(cond ((and (bufferp (car handle))
+		    (string-match "text/html" (car (mm-handle-type handle))))
+	       (let ((tmp-file (mm-make-temp-file
+				;; Do we need to care for 8.3 filenames?
+				"mm-" nil ".html")))
+		 (mm-save-part-to-file handle tmp-file)
+		 (add-to-list 'gnus-article-browse-html-temp-list tmp-file)
+		 (add-hook 'gnus-summary-prepare-exit-hook
+			   'gnus-article-browse-delete-temp-files)
+		 (add-hook 'gnus-exit-gnus-hook
+			   (lambda  ()
+			     (gnus-article-browse-delete-temp-files t)))
+		 ;; FIXME: Warn if there's an <img> tag?
+		 (browse-url-of-file tmp-file)
+		 (setq showed t)))
+	      ;; If multipart, recurse
+	      ((and (stringp (car handle))
+		    (string-match "^multipart/" (car handle))
+		    (setq showed
+			  (or showed
+			      (gnus-article-browse-html-parts handle))))))))
+showed))
+;; FIXME: Documentation in texi/gnus.texi missing.
+(defun gnus-article-browse-html-article ()
+"View \"text/html\" parts of the current article with a WWW browser.
+Warning: Spammers use links to images in HTML articles to verify
+whether you have read the message.  As
+`gnus-article-browse-html-article' passes the unmodified HTML
+content to the browser without eliminating these \"web bugs\" you
+should only use it for mails from trusted senders."
+;; Cf. `mm-w3m-safe-url-regexp'
+(interactive)
+(save-window-excursion
+;; Open raw article and select the buffer
+(gnus-summary-show-article t)
+(gnus-summary-select-article-buffer)
+(let ((parts (mm-dissect-buffer t t)))
+;; If singlepart, enforce a list.
+(when (and (bufferp (car parts))
+		 (stringp (car (mm-handle-type parts))))
+	(setq parts (list parts)))
+;; Process the list
+(unless (gnus-article-browse-html-parts parts)
+	(gnus-error 3 "Mail doesn't contain a \"text/html\" part!"))
+(gnus-summary-show-article))))
 (defun article-hide-list-identifiers ()
 "Remove list identifies from the Subject header.
 The `gnus-list-identifiers' variable specifies what to do."
 (interactive)
 (let ((inhibit-point-motion-hooks t)
 (defun article-babel ()
 "Translate article using an online translation service."
 (interactive)
 (require 'babel)
-(save-excursion
+(gnus-with-article-buffer
-(set-buffer gnus-article-buffer)
 (when (article-goto-body)
-(let* ((inhibit-read-only t)
+(let* ((start (point))
-	     (start (point))
 	     (end (point-max))
 	     (orig (buffer-substring start end))
 	     (trans (babel-as-string orig)))
 	(save-restriction
 	  (narrow-to-region start end)
 	  (narrow-to-region pos (or (text-property-any pos (point-max)
 						       'original-date nil)
 				    (point-max)))
 	  (goto-char (point-min))
 	  (when (re-search-forward tdate-regexp nil t)
-	    (setq bface (get-text-property (gnus-point-at-bol) 'face)
+	    (setq bface (get-text-property (point-at-bol) 'face)
-		  eface (get-text-property (1- (gnus-point-at-eol)) '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 (gnus-point-at-bol)
+		(delete-region (point-at-bol) (progn
-			       (progn
+						(gnus-article-forward-header)
-				 (gnus-article-forward-header)
+						(point)))
-				 (point)))
+	      (delete-region (point-at-bol) (progn
-	      (delete-region (gnus-point-at-bol)
+					      (gnus-article-forward-header)
-			     (progn
+					      (forward-char -1)
-			       (gnus-article-forward-header)
+					      (point)))
-			       (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)
 (condition-case ()
 (let ((time (date-to-time date)))
 	(cond
 	 ;; Convert to the local timezone.
 	 ((eq type 'local)
-	  (let ((tz (car (current-time-zone time))))
+	  (concat "Date: " (message-make-date time)))
-	    (format "Date: %s %s%02d%02d" (current-time-string time)
-		    (if (> tz 0) "+" "-") (/ (abs tz) 3600)
-		    (/ (% (abs tz) 3600) 60))))
 	 ;; Convert to Universal Time.
 	 ((eq type 'ut)
 	  (concat "Date: "
-		  (current-time-string
+		  (substring
-		   (let* ((e (parse-time-string date))
+		   (message-make-date
-			  (tm (apply 'encode-time e))
+		    (let* ((e (parse-time-string date))
-			  (ms (car tm))
+			   (tm (apply 'encode-time e))
-			  (ls (- (cadr tm) (car (current-time-zone time)))))
+			   (ms (car tm))
-		     (cond ((< ls 0) (list (1- ms) (+ ls 65536)))
+			   (ls (- (cadr tm) (car (current-time-zone time)))))
-			   ((> ls 65535) (list (1+ ms) (- ls 65536)))
+		      (cond ((< ls 0) (list (1- ms) (+ ls 65536)))
-			   (t (list ms ls)))))
+			    ((> ls 65535) (list (1+ ms) (- ls 65536)))
-		  " UT"))
+			    (t (list ms ls)))))
+		   0 -5)
+		  "UT"))
 	 ;; Get the original date from the article.
 	 ((eq type 'original)
 	  (concat "Date: " (if (string-match "\n+$" date)
 			       (substring date 0 (match-beginning 0))
 			     date)))
 (interactive "p")
 (unless n
 (setq n 1))
 (gnus-stop-date-timer)
 (setq article-lapsed-timer
-	(nnheader-run-at-time 1 n 'article-update-date-lapsed)))
+	(run-at-time 1 n 'article-update-date-lapsed)))
 (defun gnus-stop-date-timer ()
 "Stop the X-Sent timer."
 (interactive)
 (when article-lapsed-timer
 		   (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 ]\\|\\'\\)"
+			   (re-search-forward "[\t ]*\n\\(?:[^\t ]\\|\\'\\)"
 					      nil t))
 		  (buffer-substring-no-properties start
 						  (match-beginning 0)))))
 (goto-char (point-max))
 (skip-chars-backward "\n")
 (save-restriction
 (widen)
 (shell-command-on-region (point-min) (point-max) command nil)))
 (setq gnus-last-shell-command command))
-(defmacro gnus-read-string (prompt &optional initial-contents history
-			    default-value)
-"Like `read-string' but allow for older XEmacsen that don't have the 5th arg."
-(if (and (featurep 'xemacs)
-	   (< emacs-minor-version 2))
-`(read-string ,prompt ,initial-contents ,history)
-`(read-string ,prompt ,initial-contents ,history ,default-value)))
 (defun gnus-summary-pipe-to-muttprint (&optional command)
 "Pipe this article to muttprint."
-(setq command (gnus-read-string
+(setq command (read-string
 		 "Print using command: " gnus-summary-muttprint-program
 		 nil gnus-summary-muttprint-program))
 (gnus-summary-save-in-pipe command))
 ;;; Article file names when saving.
 	    (let ((inhibit-read-only t) bface eface)
 	      (save-restriction
 		(message-narrow-to-head)
 		(goto-char (point-max))
 		(forward-line -1)
-		(setq bface (get-text-property (gnus-point-at-bol) 'face)
+		(setq bface (get-text-property (point-at-bol) 'face)
-		      eface (get-text-property (1- (gnus-point-at-eol)) 'face))
+		      eface (get-text-property (1- (point-at-eol)) 'face))
 		(message-remove-header "X-Gnus-PGP-Verify")
 		(if (re-search-forward "^X-PGP-Sig:" nil t)
 		    (forward-line)
 		  (goto-char (point-max)))
 		(narrow-to-region (point) (point))
 (interactive)
 (if (gnus-buffer-live-p gnus-original-article-buffer)
 (canlock-verify gnus-original-article-buffer)))
 (eval-and-compile
-(mapcar
+(mapc
 (lambda (func)
 (let (afunc gfunc)
 (if (consp func)
 	   (setq afunc (car func)
 		 gfunc (cdr func))
 '(article-hide-headers
 article-verify-x-pgp-sig
 article-verify-cancel-lock
 article-hide-boring-headers
 article-treat-overstrike
+article-treat-ansi-sequences
 article-fill-long-lines
 article-capitalize-sentences
 article-remove-cr
 article-remove-leading-whitespace
 article-display-x-face
 article-date-user
 article-date-lapsed
 article-emphasize
 article-treat-dumbquotes
 article-normalize-headers
-;;     (article-show-all . gnus-article-show-all-headers)
+;;(article-show-all . gnus-article-show-all-headers)
 )))
 ;;;
 ;;; Gnus article mode
 ;;;
 '("Treatment"
 ["Hide headers" gnus-article-hide-headers t]
 ["Hide signature" gnus-article-hide-signature t]
 ["Hide citation" gnus-article-hide-citation t]
 ["Treat overstrike" gnus-article-treat-overstrike t]
+["Treat ANSI sequences" gnus-article-treat-ansi-sequences t]
 ["Remove carriage return" gnus-article-remove-cr t]
 ["Remove leading whitespace" gnus-article-remove-leading-whitespace 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]
 (make-local-variable 'gnus-article-ignored-charsets)
 ;; Prevent Emacs 22 from displaying non-break space with `nobreak-space'
 ;; face.
 (set (make-local-variable 'nobreak-char-display) nil)
 (setq cursor-in-non-selected-windows nil)
+(setq truncate-lines gnus-article-truncate-lines)
 (gnus-set-default-directory)
 (buffer-disable-undo)
-(setq buffer-read-only t)
+(setq buffer-read-only t
+	show-trailing-whitespace nil)
 (set-syntax-table gnus-article-mode-syntax-table)
 (mm-enable-multibyte)
 (gnus-run-mode-hooks 'gnus-article-mode-hook))
-;; Internal variables.  Are `gnus-button-regexp' and `gnus-button-last' used
-;; at all?
-(defvar gnus-button-regexp nil)
 (defvar gnus-button-marker-list nil
-"Regexp matching any of the regexps from `gnus-button-alist'.")
+"Regexp matching any of the regexps from `gnus-button-alist'.
-(defvar gnus-button-last nil
+Internal variable.")
-"The value of `gnus-button-alist' when `gnus-button-regexp' was build.")
 (defun gnus-article-setup-buffer ()
 "Initialize the article buffer."
 (let* ((name (if gnus-single-article-buffer "*Article*"
 		 (concat "*Article " gnus-newsgroup-name "*")))
 		 (concat " *Original Article"
 			 (substring name (match-end 0))))))
 (setq gnus-article-buffer name)
 (setq gnus-original-article-buffer original)
 (setq gnus-article-mime-handle-alist nil)
-;; This might be a variable local to the summary buffer.
+(with-current-buffer gnus-summary-buffer
-(unless gnus-single-article-buffer
+;; This might be a variable local to the summary buffer.
-(save-excursion
+(unless gnus-single-article-buffer
-	(set-buffer gnus-summary-buffer)
 	(setq gnus-article-buffer name)
 	(setq gnus-original-article-buffer original)
 	(gnus-set-global-variables)))
 (gnus-article-setup-highlight-words)
 ;; Init original article buffer.
 	  (current-buffer))
 (save-excursion
 	(set-buffer (gnus-get-buffer-create name))
 	(gnus-article-mode)
 	(make-local-variable 'gnus-summary-buffer)
+	(setq gnus-summary-buffer
+	      (gnus-summary-buffer-name gnus-newsgroup-name))
 	(gnus-summary-set-local-parameters gnus-newsgroup-name)
 	(current-buffer)))))
 ;; Set article window start at LINE, where LINE is the number of lines
 ;; from the head of the article.
 (defun gnus-article-set-window-start (&optional line)
-(set-window-start
+(let ((article-window (gnus-get-buffer-window gnus-article-buffer t)))
-(gnus-get-buffer-window gnus-article-buffer t)
+(when article-window
-(save-excursion
+(set-window-start
-(set-buffer gnus-article-buffer)
+article-window
-(goto-char (point-min))
+(save-excursion
-(if (not line)
+	 (set-buffer gnus-article-buffer)
-	 (point-min)
+	 (goto-char (point-min))
-(gnus-message 6 "Moved to bookmark")
+	 (if (not line)
-(search-forward "\n\n" nil t)
+	     (point-min)
-(forward-line line)
+	   (gnus-message 6 "Moved to bookmark")
-(point)))))
+	   (search-forward "\n\n" nil t)
+	   (forward-line line)
+	   (point)))))))
 (defun gnus-article-prepare (article &optional all-headers header)
 "Prepare ARTICLE in article mode buffer.
 ARTICLE should either be an article number or a Message-ID.
 If ARTICLE is an id, HEADER should be the article headers.
 (when gnus-display-mime-function
 (funcall gnus-display-mime-function))
 (gnus-run-hooks 'gnus-article-prepare-hook)))
 ;;;
+;;; Gnus Sticky Article Mode
+;;;
+(define-derived-mode gnus-sticky-article-mode gnus-article-mode "StickyArticle"
+"Mode for sticky articles."
+;; Release bindings that won't work.
+(substitute-key-definition 'gnus-article-read-summary-keys 'undefined
+			     gnus-sticky-article-mode-map)
+(substitute-key-definition 'gnus-article-refer-article 'undefined
+			     gnus-sticky-article-mode-map)
+(dolist (k '("e" "h" "s" "F" "R"))
+(define-key gnus-sticky-article-mode-map k nil))
+(define-key gnus-sticky-article-mode-map "k" 'gnus-kill-sticky-article-buffer)
+(define-key gnus-sticky-article-mode-map "q" 'bury-buffer)
+(define-key gnus-sticky-article-mode-map "\C-hc" 'describe-key-briefly)
+(define-key gnus-sticky-article-mode-map "\C-hk" 'describe-key))
+(defun gnus-sticky-article (arg)
+"Make the current article sticky.
+If a prefix ARG is given, ask for a name for this sticky article buffer."
+(interactive "P")
+(gnus-summary-show-thread)
+(gnus-summary-select-article nil nil 'pseudo)
+(let (new-art-buf-name)
+(gnus-eval-in-buffer-window gnus-article-buffer
+(setq new-art-buf-name
+	    (concat
+	     "*Sticky Article: "
+	     (if arg
+		 (read-from-minibuffer "Sticky article buffer name: ")
+	       (gnus-with-article-headers
+		 (gnus-article-goto-header "subject")
+		 (setq new-art-buf-name
+		       (buffer-substring-no-properties
+			(line-beginning-position) (line-end-position)))
+		 (goto-char (point-min))
+		 (gnus-article-goto-header "from")
+		 (setq new-art-buf-name
+		       (concat
+			new-art-buf-name ", "
+			(buffer-substring-no-properties
+			 (line-beginning-position) (line-end-position))))
+		 (goto-char (point-min))
+		 (gnus-article-goto-header "date")
+		 (setq new-art-buf-name
+		       (concat
+			new-art-buf-name ", "
+			(buffer-substring-no-properties
+			 (line-beginning-position) (line-end-position))))))
+	     "*"))
+(if (and (gnus-buffer-live-p new-art-buf-name)
+	       (with-current-buffer new-art-buf-name
+		 (eq major-mode 'gnus-sticky-article-mode)))
+	  (switch-to-buffer new-art-buf-name)
+	(setq new-art-buf-name (rename-buffer new-art-buf-name t)))
+(gnus-sticky-article-mode))
+(setq gnus-article-buffer new-art-buf-name))
+(gnus-summary-recenter)
+(gnus-summary-position-point))
+(defun gnus-kill-sticky-article-buffer (&optional buffer)
+"Kill the given sticky article BUFFER.
+If none is given, assume the current buffer and kill it if it has
+`gnus-sticky-article-mode'."
+(interactive)
+(unless buffer
+(setq buffer (current-buffer)))
+(with-current-buffer buffer
+(when (eq major-mode 'gnus-sticky-article-mode)
+(gnus-kill-buffer buffer))))
+(defun gnus-kill-sticky-article-buffers (arg)
+"Kill all sticky article buffers.
+If a prefix ARG is given, ask for confirmation."
+(interactive "P")
+(dolist (buf (gnus-buffers))
+(with-current-buffer buf
+(when (eq major-mode 'gnus-sticky-article-mode)
+	(if (not arg)
+	    (gnus-kill-buffer buf)
+	  (when (yes-or-no-p (concat "Kill buffer " (buffer-name buf) "? "))
+	    (gnus-kill-buffer buf)))))))
+;;;
 ;;; Gnus MIME viewing functions
 ;;;
 (defvar gnus-mime-button-line-format "%{%([%p. %d%T]%)%}%e\n"
 "Format of the MIME buttons.
 (gnus-mime-view-part "v" "View Interactively...")
 (gnus-mime-view-part-as-type "t" "View As Type...")
 (gnus-mime-view-part-as-charset "C" "View As charset...")
 (gnus-mime-save-part "o" "Save...")
 (gnus-mime-save-part-and-strip "\C-o" "Save and Strip")
+(gnus-mime-replace-part "r" "Replace part")
 (gnus-mime-delete-part "d" "Delete part")
 (gnus-mime-copy-part "c" "View As Text, In Other Buffer")
 (gnus-mime-inline-part "i" "View As Text, In This Buffer")
-(gnus-mime-view-part-internally "E" "View Internally")
+(gnus-mime-view-part-internally "E" "View Internally") ;; Why `E'?
 (gnus-mime-view-part-externally "e" "View Externally")
 (gnus-mime-print-part "p" "Print")
 (gnus-mime-pipe-part "|" "Pipe To Command...")
 (gnus-mime-action-on-part "." "Take action on the part...")))
 	(format " (%d parts)" (length gnus-article-mime-handle-alist-1)))
 ""))
 (defvar gnus-mime-button-map
 (let ((map (make-sparse-keymap)))
-(unless (>= (string-to-number emacs-version) 21)
-;; XEmacs doesn't care.
-(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))
 (easy-menu-define
 gnus-mime-button-menu gnus-mime-button-map "MIME button menu."
 `("MIME Part"
 ,@(mapcar (lambda (c)
-		(vector (caddr c) (car c) :enable t))
+		(vector (caddr c) (car c) :active t))
 	      gnus-mime-button-commands)))
-(eval-when-compile
-(define-compiler-macro popup-menu (&whole form
-					    menu &optional position prefix)
-(if (and (fboundp 'popup-menu)
-	     (not (memq 'popup-menu (assoc "lmenu" load-history))))
-	form
-;; Gnus is probably running under Emacs 20.
-`(let* ((menu (cdr ,menu))
-	      (response (x-popup-menu
-			 t (list (car menu)
-				 (cons "" (mapcar (lambda (c)
-						    (cons (caddr c) (car c)))
-						  (cdr menu)))))))
-	 (if response
-	     (call-interactively (nth 3 (assq response menu))))))))
 (defun gnus-mime-button-menu (event prefix)
 "Construct a context-sensitive menu of MIME commands."
 (interactive "e\nP")
 (save-window-excursion
 (popup-menu gnus-mime-button-menu nil prefix))))
 (defun gnus-mime-view-all-parts (&optional handles)
 "View all the MIME parts."
 (interactive)
-(save-current-buffer
+(with-current-buffer gnus-article-buffer
-(set-buffer gnus-article-buffer)
 (let ((handles (or handles gnus-article-mime-handles))
 	  (mail-parse-charset gnus-newsgroup-charset)
 	  (mail-parse-ignored-charsets
 	   (with-current-buffer gnus-summary-buffer
 	     gnus-newsgroup-ignored-charsets)))
 	(or (search-forward "\n\n") (goto-char (point-max)))
 	(let ((inhibit-read-only t))
 	  (delete-region (point) (point-max))
 	  (mm-display-parts handles))))))
-(defun gnus-mime-save-part-and-strip ()
+(defun gnus-article-jump-to-part (n)
-"Save the MIME part under point then replace it with an external body."
+"Jump to MIME part N."
+(interactive "P")
+(pop-to-buffer gnus-article-buffer)
+;; FIXME: why is it necessary?
+(sit-for 0)
+(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)
+(cond ((>= gnus-auto-select-part 1)
+	   (while (and (<= n parts)
+		       (not (gnus-article-goto-part n)))
+	     (setq n (1+ n))))
+	  ((< gnus-auto-select-part 0)
+	   (while (and (>= n 1)
+		       (not (gnus-article-goto-part n)))
+	     (setq n (1- n))))
+	  (t
+	   (gnus-article-goto-part n)))))
+(eval-when-compile
+(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))
+	      (mail-parse-ignored-charsets
+	       (or gnus-article-ignored-charsets
+		   ',gnus-newsgroup-ignored-charsets))
+	      (mbl mml-buffer-list))
+	  (setq mml-buffer-list nil)
+	  (insert-buffer-substring gnus-original-article-buffer)
+	  (mime-to-mml ',handles)
+	  (setq gnus-article-mime-handles nil)
+	  (let ((mbl1 mml-buffer-list))
+	    (setq mml-buffer-list mbl)
+	    (set (make-local-variable 'mml-buffer-list) mbl1))
+	  (gnus-make-local-hook 'kill-buffer-hook)
+	  (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t)))
+`(lambda (no-highlight)
+	(let ((mail-parse-charset (or gnus-article-charset
+				      ',gnus-newsgroup-charset))
+	      (message-options message-options)
+	      (message-options-set-recipient)
+	      (mail-parse-ignored-charsets
+	       (or gnus-article-ignored-charsets
+		   ',gnus-newsgroup-ignored-charsets)))
+	  (mml-to-mime)
+	  (mml-destroy-buffers)
+	  (remove-hook 'kill-buffer-hook
+		       'mml-destroy-buffers t)
+	  (kill-local-variable 'mml-buffer-list))
+	(gnus-summary-edit-article-done
+	 ,(or (mail-header-references gnus-current-headers) "")
+	 ,(gnus-group-read-only-p)
+	 ,gnus-summary-buffer no-highlight))
+t)
+(gnus-article-edit-done)
+(gnus-summary-expand-window)
+(gnus-summary-show-article)
+(when (and current-id (integerp gnus-auto-select-part))
+(gnus-article-jump-to-part
+(if (text-property-any (point-min) (point-max)
+			      'gnus-part (+ current-id gnus-auto-select-part))
+	   (+ current-id gnus-auto-select-part)
+	 (with-current-buffer gnus-article-buffer
+	   (length gnus-article-mime-handle-alist)))))))
+(defun gnus-mime-replace-part (file)
+"Replace MIME part under point with an external body."
+;; Useful if file has already been saved to disk
+(interactive
+(list
+(mm-with-multibyte
+(read-file-name "Replace MIME part with file: "
+		      (or mm-default-directory default-directory)
+		      nil nil))))
+(gnus-mime-save-part-and-strip file))
+(defun gnus-mime-save-part-and-strip (&optional file)
+"Save the MIME part under point then replace it with an external body.
+If FILE is given, use it for the external part."
 (interactive)
 (gnus-article-check-buffer)
 (when (gnus-group-read-only-p)
 (error "The current group does not support deleting of parts"))
 (when (mm-complicated-handles gnus-article-mime-handles)
 (error "\
 The current article has a complicated MIME structure, giving up..."))
-(when (gnus-yes-or-no-p "\
+(let* ((data (get-text-property (point) 'gnus-data))
-Deleting parts may malfunction or destroy the article; continue? ")
+	 (id (get-text-property (point) 'gnus-part))
-(let* ((data (get-text-property (point) 'gnus-data))
+	 param
-	   file param
+	 (handles gnus-article-mime-handles))
-	   (handles gnus-article-mime-handles))
+(unless file
-(setq file (and data (mm-save-part data)))
+(setq file
-(when file
+	    (and data (mm-save-part data "Delete MIME part and save to: "))))
-	(with-current-buffer (mm-handle-buffer data)
+(when file
-	  (erase-buffer)
+(with-current-buffer (mm-handle-buffer data)
-	  (insert "Content-Type: " (mm-handle-media-type data))
+	(erase-buffer)
-	  (mml-insert-parameter-string (cdr (mm-handle-type data))
+	(insert "Content-Type: " (mm-handle-media-type data))
-				       '(charset))
+	(mml-insert-parameter-string (cdr (mm-handle-type data))
-	  ;; Add a filename for the sake of saving the part again.
+				     '(charset))
-	  (mml-insert-parameter
+	;; Add a filename for the sake of saving the part again.
-	   (mail-header-encode-parameter "name" (file-name-nondirectory file)))
+	(mml-insert-parameter
-	  (insert "\n")
+	 (mail-header-encode-parameter "name" (file-name-nondirectory file)))
-	  (insert "Content-ID: " (message-make-message-id) "\n")
+	(insert "\n")
-	  (insert "Content-Transfer-Encoding: binary\n")
+	(insert "Content-ID: " (message-make-message-id) "\n")
-	  (insert "\n"))
+	(insert "Content-Transfer-Encoding: binary\n")
-	(setcdr data
+	(insert "\n"))
-		(cdr (mm-make-handle nil
+(setcdr data
-				     `("message/external-body"
+	      (cdr (mm-make-handle nil
-				       (access-type . "LOCAL-FILE")
+				   `("message/external-body"
-				       (name . ,file)))))
+				     (access-type . "LOCAL-FILE")
-	(set-buffer gnus-summary-buffer)
+				     (name . ,file)))))
-	(gnus-article-edit-article
+;; (set-buffer gnus-summary-buffer)
-	 `(lambda ()
+(gnus-article-edit-part handles id))))
-	    (erase-buffer)
-	    (let ((mail-parse-charset (or gnus-article-charset
+;; A function like `gnus-summary-save-parts' (`X m', `<MIME> <Extract all
-					  ',gnus-newsgroup-charset))
+;; parts...>') but with stripping would be nice.
-		  (mail-parse-ignored-charsets
-		   (or gnus-article-ignored-charsets
-		       ',gnus-newsgroup-ignored-charsets))
-		  (mbl mml-buffer-list))
-	      (setq mml-buffer-list nil)
-	      (insert-buffer-substring gnus-original-article-buffer)
-	      (mime-to-mml ',handles)
-	      (setq gnus-article-mime-handles nil)
-	      (let ((mbl1 mml-buffer-list))
-		(setq mml-buffer-list mbl)
-		(set (make-local-variable 'mml-buffer-list) mbl1))
-	      (gnus-make-local-hook 'kill-buffer-hook)
-	      (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t)))
-	 `(lambda (no-highlight)
-	    (let ((mail-parse-charset (or gnus-article-charset
-					  ',gnus-newsgroup-charset))
-		  (message-options message-options)
-		  (message-options-set-recipient)
-		  (mail-parse-ignored-charsets
-		   (or gnus-article-ignored-charsets
-		       ',gnus-newsgroup-ignored-charsets)))
-	      (mml-to-mime)
-	      (mml-destroy-buffers)
-	      (remove-hook 'kill-buffer-hook
-			   'mml-destroy-buffers t)
-	      (kill-local-variable 'mml-buffer-list))
-	    (gnus-summary-edit-article-done
-	     ,(or (mail-header-references gnus-current-headers) "")
-	     ,(gnus-group-read-only-p)
-	     ,gnus-summary-buffer no-highlight)))))))
 (defun gnus-mime-delete-part ()
 "Delete the MIME part under point.
 Replace it with some information about the removed part."
 (interactive)
 (when (gnus-group-read-only-p)
 (error "The current group does not support deleting of parts"))
 (when (mm-complicated-handles gnus-article-mime-handles)
 (error "\
 The current article has a complicated MIME structure, giving up..."))
-(when (gnus-yes-or-no-p "\
+(when (or gnus-expert-user
-Deleting parts may malfunction or destroy the article; continue? ")
+	    (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
 	    (mail-decode-encoded-word-string (or (mm-handle-description data)
 						 none)))
 	  (setcdr data
 		  (cdr (mm-make-handle
 			nil `("text/plain") nil nil
 			(list "attachment")
 			(format "Deleted attachment (%s bytes)" bsize))))))
-(set-buffer gnus-summary-buffer)
+;; (set-buffer gnus-summary-buffer)
-;; FIXME: maybe some of the following code (borrowed from
+(gnus-article-edit-part handles id))))
-;; `gnus-mime-save-part-and-strip') isn't necessary?
-(gnus-article-edit-article
-`(lambda ()
-	  (erase-buffer)
-	  (let ((mail-parse-charset (or gnus-article-charset
-					',gnus-newsgroup-charset))
-		(mail-parse-ignored-charsets
-		 (or gnus-article-ignored-charsets
-		     ',gnus-newsgroup-ignored-charsets))
-		(mbl mml-buffer-list))
-	    (setq mml-buffer-list nil)
-	    (insert-buffer-substring gnus-original-article-buffer)
-	    (mime-to-mml ',handles)
-	    (setq gnus-article-mime-handles nil)
-	    (let ((mbl1 mml-buffer-list))
-	      (setq mml-buffer-list mbl)
-	      (set (make-local-variable 'mml-buffer-list) mbl1))
-	    (gnus-make-local-hook 'kill-buffer-hook)
-	    (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t)))
-`(lambda (no-highlight)
-	  (let ((mail-parse-charset (or gnus-article-charset
-					',gnus-newsgroup-charset))
-		(message-options message-options)
-		(message-options-set-recipient)
-		(mail-parse-ignored-charsets
-		 (or gnus-article-ignored-charsets
-		     ',gnus-newsgroup-ignored-charsets)))
-	    (mml-to-mime)
-	    (mml-destroy-buffers)
-	    (remove-hook 'kill-buffer-hook
-			 'mml-destroy-buffers t)
-	    (kill-local-variable 'mml-buffer-list))
-	  (gnus-summary-edit-article-done
-	   ,(or (mail-header-references gnus-current-headers) "")
-	   ,(gnus-group-read-only-p)
-	   ,gnus-summary-buffer no-highlight))))
-;; Not in `gnus-mime-save-part-and-strip':
-(gnus-article-edit-done)
-(gnus-summary-expand-window)
-(gnus-summary-show-article)))
 (defun gnus-mime-save-part ()
 "Save the MIME part under point."
 (interactive)
 (gnus-article-check-buffer)
 		;; Content-Type: foo/bar; name=...
 		(mail-content-type-get (mm-handle-type handle) 'name)
 		;; Content-Disposition: attachment; filename=...
 		(cdr (assq 'filename (cdr (mm-handle-disposition handle))))))
 	 (def-type (and name (mm-default-file-encoding name))))
-(and def-type (cons def-type 0))))
+(or (and def-type (cons def-type 0))
+	(and handle
+	     (equal (mm-handle-media-supertype handle) "text")
+	     '("text/plain" . 0))
+	'("application/octet-stream" . 0))))
 (defun gnus-mime-view-part-as-type (&optional mime-type pred)
 "Choose a MIME media type, and view the part as such.
 If non-nil, PRED is a predicate to use during completion to limit the
 available media-types."
 			    (mm-handle-description handle)
 			    nil
 			    (mm-handle-id handle)))
 (setq gnus-article-mime-handles
 	    (mm-merge-handles gnus-article-mime-handles handle))
+(when (mm-handle-displayed-p handle)
+	(mm-remove-part handle))
 (gnus-mm-display-part handle))))
-(eval-when-compile
+(defun gnus-mime-copy-part (&optional handle arg)
-(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)
 "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)))
+(unless handle
-	 (contents (and handle (mm-get-part handle)))
+(setq handle (get-text-property (point) 'gnus-data)))
-	 (base (and handle
+(when handle
-		    (file-name-nondirectory
+(let ((filename (or (mail-content-type-get (mm-handle-type handle)
-		     (or
+					       'name)
-		      (mail-content-type-get (mm-handle-type handle) 'name)
+			(mail-content-type-get (mm-handle-disposition handle)
-		      (mail-content-type-get (mm-handle-disposition handle)
+					       'filename)))
-					     'filename)
+	  contents dont-decode charset coding-system)
-		      "*decoded*"))))
+(mm-with-unibyte-buffer
-	 (buffer (and base (generate-new-buffer base))))
+	(mm-insert-part handle)
-(when contents
+	(setq contents (or (condition-case nil
-(switch-to-buffer buffer)
+			       (mm-decompress-buffer filename nil 'sig)
-(insert contents)
+			     (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))
+	    (setq buffer-file-name (expand-file-name filename))
-	    (gnus-mime-jka-compr-maybe-uncompress)
 	    (normal-mode))
 	(setq buffer-file-name nil))
 (goto-char (point-min)))))
 (defun gnus-mime-print-part (&optional handle filename)
 	    (insert contents)
 	    (gnus-print-buffer))
 	  (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)))
+(unless handle
-	 contents charset
+(setq handle (get-text-property (point) 'gnus-data)))
-	 (b (point))
+(when handle
-	 (inhibit-read-only t))
+(let ((b (point))
-(when handle
+	  (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-type 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
+	  (unless (setq charset (mail-content-type-get
-			     (mm-handle-type handle) 'charset)
+				 (mm-handle-type handle) 'charset))
-			    gnus-newsgroup-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
 	  (if (mm-handle-undisplayer handle)
 	      (mm-remove-part handle))))
 	(forward-line 2)
 	(mm-insert-inline
 	 handle
-	 (if (and charset
+	 (if (or coding-system
-		  (setq charset (mm-charset-to-coding-system
+		 (and charset
-				 charset))
+		      (setq coding-system
-		  (not (eq charset 'ascii)))
+			    (mm-charset-to-coding-system charset))
-	     (mm-decode-coding-string contents charset)
+		      (not (eq coding-system 'ascii))))
+	     (mm-decode-coding-string contents coding-system)
 	   (mm-string-to-multibyte contents)))
 	(goto-char b)))))
 (defun gnus-mime-strip-charset-parameters (handle)
 "Strip charset parameters from HANDLE."
 (let ((handle (or handle (get-text-property (point) 'gnus-data)))
 	(fun (get-text-property (point) 'gnus-callback))
 	(gnus-newsgroup-ignored-charsets 'gnus-all)
 	gnus-newsgroup-charset form preferred parts)
 (when handle
-(if (mm-handle-undisplayer handle)
+(when (prog1
-	  (mm-remove-part handle))
+		(and fun
-(when fun
+		     (setq gnus-newsgroup-charset
-	(setq gnus-newsgroup-charset
+			   (or (cdr (assq
-	      (or (cdr (assq arg gnus-summary-show-article-charset-alist))
+				     arg
-		  (mm-read-coding-system "Charset: ")))
+				     gnus-summary-show-article-charset-alist))
+			       (mm-read-coding-system "Charset: "))))
+	      (if (mm-handle-undisplayer handle)
+		  (mm-remove-part handle)))
 	(gnus-mime-strip-charset-parameters handle)
 	(when (and (consp (setq form (cdr-safe fun)))
 		   (setq form (ignore-errors
 				(assq 'gnus-mime-display-alternative form)))
 		   (setq preferred (caddr form))
 (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)
+(defun gnus-article-part-wrapper (n function &optional no-handle interactive)
-(let ((window (get-buffer-window gnus-article-buffer 'visible))
+"Call FUNCTION on MIME part N.
-	frame)
+Unless NO-HANDLE, call FUNCTION with N-th MIME handle as it's only argument.
-(when window
+If INTERACTIVE, call FUNCTION interactivly."
-;; It is necessary to select the article window so that
+(let (window frame)
-;; `gnus-article-goto-part' may really move the point.
+;; Check whether the article is displayed.
-(setq frame (selected-frame))
+(unless (and (gnus-buffer-live-p gnus-article-buffer)
-(gnus-select-frame-set-input-focus (window-frame window))
+		 (setq window (get-buffer-window gnus-article-buffer t))
-(unwind-protect
+		 (frame-visible-p (setq frame (window-frame window))))
-	  (save-window-excursion
+(error "No article is displayed"))
-	    (select-window window)
+(with-current-buffer gnus-article-buffer
-	    (when (> n (length gnus-article-mime-handle-alist))
+;; Check whether the article displays the right contents.
-	      (error "No such part"))
+(unless (with-current-buffer gnus-summary-buffer
-	    (gnus-article-goto-part n)
+		(eq gnus-current-article (gnus-summary-article-number)))
-	    (let ((handle (cdr (assq n gnus-article-mime-handle-alist))))
+	(error "You should select the right article first"))
-	      (funcall function handle)))
+(if n
-	(gnus-select-frame-set-input-focus frame)))))
+	  (setq n (prefix-numeric-value n))
+	(let ((pt (point)))
+	  (setq n (or (get-text-property pt 'gnus-part)
+		      (and (not (bobp))
+			   (get-text-property (1- pt) 'gnus-part))
+		      (get-text-property (prog2
+					     (forward-line 1)
+					     (point)
+					   (goto-char pt))
+					 'gnus-part)
+		      (get-text-property
+		       (or (and (setq pt (previous-single-property-change
+					  pt 'gnus-part))
+				(1- pt))
+			   (next-single-property-change	(point) 'gnus-part)
+			   (point))
+		       'gnus-part)
+		      1))))
+;; Check whether the specified part exists.
+(when (> n (length gnus-article-mime-handle-alist))
+	(error "No such part")))
+(unless
+	(progn
+	  ;; To select the window is needed so that the cursor
+	  ;; might be visible on the MIME button.
+	  (select-window (prog1
+			     window
+			   (setq window (selected-window))
+			   ;; Article may be displayed in the other frame.
+			   (gnus-select-frame-set-input-focus
+			    (prog1
+				frame
+			      (setq frame (selected-frame))))))
+	  (when (gnus-article-goto-part n)
+	    ;; We point the cursor and the arrow at the MIME button
+	    ;; when the `function' prompt the user for something.
+	    (let ((cursor-in-non-selected-windows t)
+		  (overlay-arrow-string "=>")
+		  (overlay-arrow-position (point-marker)))
+	      (unwind-protect
+		  (cond
+		   ((and no-handle interactive)
+		    (call-interactively function))
+		   (no-handle
+		    (funcall function))
+		   (interactive
+		    (call-interactively
+		     function
+		     (cdr (assq n gnus-article-mime-handle-alist))))
+		   (t
+		    (funcall function
+			     (cdr (assq n gnus-article-mime-handle-alist)))))
+		(set-marker overlay-arrow-position nil)
+		(unless gnus-auto-select-part
+		  (gnus-select-frame-set-input-focus frame)
+		  (select-window window))))
+	    t))
+(if gnus-inhibit-mime-unbuttonizing
+	  ;; This is the default though the program shouldn't reach here.
+	  (error "No such part")
+	;; The part which doesn't have the MIME button is selected.
+	;; So, we display all the buttons and redo it.
+	(let ((gnus-inhibit-mime-unbuttonizing t))
+	  (gnus-summary-show-article)
+	  (gnus-article-part-wrapper n function no-handle))))))
 (defun gnus-article-pipe-part (n)
 "Pipe MIME part N, which is the numerical prefix."
-(interactive "p")
+(interactive "P")
 (gnus-article-part-wrapper n 'mm-pipe-part))
 (defun gnus-article-save-part (n)
 "Save MIME part N, which is the numerical prefix."
-(interactive "p")
+(interactive "P")
 (gnus-article-part-wrapper n 'mm-save-part))
 (defun gnus-article-interactively-view-part (n)
 "View MIME part N interactively, which is the numerical prefix."
-(interactive "p")
+(interactive "P")
 (gnus-article-part-wrapper n 'mm-interactively-view-part))
 (defun gnus-article-copy-part (n)
 "Copy MIME part N, which is the numerical prefix."
-(interactive "p")
+(interactive "P")
 (gnus-article-part-wrapper n 'gnus-mime-copy-part))
 (defun gnus-article-view-part-as-charset (n)
 "View MIME part N using a specified charset.
 N is the numerical prefix."
-(interactive "p")
+(interactive "P")
 (gnus-article-part-wrapper n 'gnus-mime-view-part-as-charset))
 (defun gnus-article-view-part-externally (n)
 "View MIME part N externally, which is the numerical prefix."
-(interactive "p")
+(interactive "P")
 (gnus-article-part-wrapper n 'gnus-mime-view-part-externally))
 (defun gnus-article-inline-part (n)
 "Inline MIME part N, which is the numerical prefix."
-(interactive "p")
+(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-replace-part (n)
+"Replace MIME part N with an external body.
+N is the numerical prefix."
+(interactive "P")
+(gnus-article-part-wrapper n 'gnus-mime-replace-part t 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-view-part-as-type (n)
+"Choose a MIME media type, and view part N as such.
+N is the numerical prefix."
+(interactive "P")
+(gnus-article-part-wrapper n 'gnus-mime-view-part-as-type t))
 (defun gnus-article-mime-match-handle-first (condition)
 (if condition
-(let ((alist gnus-article-mime-handle-alist) ihandle n)
+(let (n)
-	(while (setq ihandle (pop alist))
+	(dolist (ihandle gnus-article-mime-handle-alist)
 	  (if (and (cond
 		    ((functionp condition)
 		     (funcall condition (cdr ihandle)))
 		    ((eq condition 'undisplayed)
 		     (not (or (mm-handle-undisplayer (cdr ihandle))
 1))
 (defun gnus-article-view-part (&optional n)
 "View MIME part N, which is the numerical prefix."
 (interactive "P")
-(save-current-buffer
+(with-current-buffer gnus-article-buffer
-(set-buffer gnus-article-buffer)
 (or (numberp n) (setq n (gnus-article-mime-match-handle-first
 			     gnus-article-mime-match-handle-function)))
 (when (> n (length gnus-article-mime-handle-alist))
 (error "No such part"))
 (let ((handle (cdr (assq n gnus-article-mime-handle-alist))))
 (prog1
 	(let ((window (selected-window))
 	      (mail-parse-charset gnus-newsgroup-charset)
 	      (mail-parse-ignored-charsets
 	       (if (gnus-buffer-live-p gnus-summary-buffer)
-		   (save-excursion
+		   (with-current-buffer gnus-summary-buffer
-		     (set-buffer gnus-summary-buffer)
 		     gnus-newsgroup-ignored-charsets)
 		 nil)))
 	  (save-excursion
 	    (unwind-protect
 		(let ((win (gnus-get-buffer-window (current-buffer) t))
 (unless (bolp)
 (insert "\n"))
 (setq b (point))
 (gnus-eval-format
 gnus-mime-button-line-format gnus-mime-button-line-format-alist
-`(,@(gnus-local-map-property gnus-mime-button-map)
+`(keymap ,gnus-mime-button-map
-	 gnus-callback gnus-mm-display-part
+	      gnus-callback gnus-mm-display-part
-	 gnus-part ,gnus-tmp-id
+	      gnus-part ,gnus-tmp-id
-	 article-type annotation
+	      article-type annotation
-	 gnus-data ,handle))
+	      gnus-data ,handle))
 (setq e (if (bolp)
 		;; Exclude a newline.
 		(1- (point))
 	      (point)))
+(when gnus-article-button-face
+(gnus-overlay-put (gnus-make-overlay b e nil t)
+			'face gnus-article-button-face))
 (widget-convert-button
 'link b e
 :mime-handle handle
 :action 'gnus-widget-press-button
 :button-keymap gnus-mime-button-map
 	      (forward-line -1)
 	      (setq beg (point)))
 	    (gnus-article-insert-newline)
 	    (mm-insert-inline
 	     handle
-	     (let ((charset (mail-content-type-get (mm-handle-type handle)
+	     (let ((charset (or (mail-content-type-get (mm-handle-type handle)
-						   'charset)))
+						       'charset)
+				(and (equal type "text/calendar") 'utf-8))))
 	       (cond ((not charset)
 		      (mm-string-as-multibyte (mm-get-part handle)))
 		     ((eq charset 'gnus-decoded)
 		      (with-current-buffer (mm-handle-buffer handle)
 			(buffer-string)))
 	    (goto-char (point-max))))
 	  ;; Do highlighting.
 	  (save-excursion
 	    (save-restriction
 	      (narrow-to-region beg (point))
-	      (gnus-treat-article
+	      (if (eq handle gnus-article-mime-handles)
-	       nil id
+		  ;; The format=flowed case.
-	       (gnus-article-mime-total-parts)
+		  (gnus-treat-article nil 1 1 (mm-handle-media-type handle))
-	       (mm-handle-media-type handle)))))))))
+		;; Don't count signature parts that are never displayed.
+		;; The part number should be re-calculated supposing this
+		;; might be a message/rfc822 part.
+		(let (handles)
+		  (dolist (part gnus-article-mime-handles)
+		    (unless (or (stringp part)
+				(equal (car (mm-handle-type part))
+				       "application/pgp-signature"))
+		      (push part handles)))
+		  (gnus-treat-article
+		   nil (length (memq handle handles)) (length handles)
+		   (mm-handle-media-type handle)))))))))))
 (defun gnus-unbuttonized-mime-type-p (type)
 "Say whether TYPE is to be unbuttonized."
 (unless gnus-inhibit-mime-unbuttonizing
 (when (catch 'found
 	       (unless ,(not ibegend)
 		 (setq gnus-article-mime-handle-alist
 		       ',gnus-article-mime-handle-alist))
 	       (gnus-mime-display-alternative
 		',ihandles ',not-pref ',begend ,id))
-	     ,@(gnus-local-map-property gnus-mime-button-map)
+	     keymap ,gnus-mime-button-map
 	     ,gnus-mouse-face-prop ,gnus-article-mouse-face
 	     face ,gnus-article-button-face
 	     gnus-part ,id
 	     article-type multipart))
 	  (widget-convert-button 'link from (point)
 		 (unless ,(not ibegend)
 		   (setq gnus-article-mime-handle-alist
 			 ',gnus-article-mime-handle-alist))
 		 (gnus-mime-display-alternative
 		  ',ihandles ',handle ',begend ,id))
-	       ,@(gnus-local-map-property gnus-mime-button-map)
+	       keymap ,gnus-mime-button-map
 	       ,gnus-mouse-face-prop ,gnus-article-mouse-face
 	       face ,gnus-article-button-face
 	       gnus-part ,id
 	       gnus-data ,handle))
 	    (widget-convert-button 'link from (point)
 	(when preferred
 	  (if (stringp (car preferred))
 	      (gnus-display-mime preferred)
 	    (let ((mail-parse-charset gnus-newsgroup-charset)
 		  (mail-parse-ignored-charsets
-		   (save-excursion (set-buffer gnus-summary-buffer)
+		   (with-current-buffer gnus-summary-buffer
-				   gnus-newsgroup-ignored-charsets)))
+		     gnus-newsgroup-ignored-charsets)))
 	      (mm-display-part preferred)
 	      ;; Do highlighting.
 	      (save-excursion
 		(save-restriction
 		  (narrow-to-region (car begend) (point-max))
 (let ((entry (assoc key gnus-article-wash-status-strings)))
 (if value (nth 1 entry) (nth 2 entry))))
 (defun gnus-article-wash-status ()
 "Return a string which display status of article washing."
-(save-excursion
+(with-current-buffer gnus-article-buffer
-(set-buffer gnus-article-buffer)
 (let ((cite (memq 'cite gnus-article-wash-types))
 	  (headers (memq 'headers gnus-article-wash-types))
 	  (boring (memq 'boring-headers gnus-article-wash-types))
 	  (pgp (memq 'pgp gnus-article-wash-types))
 	  (pem (memq 'pem gnus-article-wash-types))
 (defun gnus-article-maybe-hide-headers ()
 "Hide unwanted headers if `gnus-have-all-headers' is nil.
 Provided for backwards compatibility."
 (when (and (or (not (gnus-buffer-live-p gnus-summary-buffer))
-		 (not (save-excursion (set-buffer gnus-summary-buffer)
+		 (not (with-current-buffer gnus-summary-buffer
-				      gnus-have-all-headers)))
+			gnus-have-all-headers)))
 	     (not gnus-inhibit-hiding))
 (gnus-article-hide-headers)))
 ;;; Article savers.
 '(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 (and (boundp 'header-line-format)
+		     (if header-line-format 1 0)))))))
-			      (symbol-value 'header-line-format))
-			 1 0)))))))
 (defun gnus-article-next-page-1 (lines)
 (when (and (not (featurep 'xemacs))
 	     (numberp lines)
 	     (> lines 0)
 (defun gnus-article-refer-article ()
 "Read article specified by message-id around point."
 (interactive)
 (save-excursion
-(re-search-backward "[ \t]\\|^" (gnus-point-at-bol) t)
+(re-search-backward "[ \t]\\|^" (point-at-bol) t)
-(re-search-forward "<?news:<?\\|<" (gnus-point-at-eol) t)
+(re-search-forward "<?news:<?\\|<" (point-at-eol) t)
-(if (re-search-forward "[^@ ]+@[^ \t>]+" (gnus-point-at-eol) t)
+(if (re-search-forward "[^@ ]+@[^ \t>]+" (point-at-eol) t)
 	(let ((msg-id (concat "<" (match-string 0) ">")))
 	  (set-buffer gnus-summary-buffer)
 	  (gnus-summary-refer-article msg-id))
 (error "No references around point"))))
 		       (events-to-keys (read-key-sequence nil))
 		     (read-key-sequence nil)))))
 (message "")
-(if (or (member keys nosaves)
+(cond
-	    (member keys nosave-but-article)
+((eq (aref keys (1- (length keys))) ?\C-h)
-	    (member keys nosave-in-article))
+(with-current-buffer gnus-article-current-summary
-	(let (func)
+	(describe-bindings (substring keys 0 -1))))
-	  (save-window-excursion
+((or (member keys nosaves)
-	    (pop-to-buffer gnus-article-current-summary)
+	  (member keys nosave-but-article)
-	    ;; We disable the pick minor mode commands.
+	  (member keys nosave-in-article))
-	    (let (gnus-pick-mode)
+(let (func)
-	      (setq func (lookup-key (current-local-map) keys))))
+	(save-window-excursion
-	  (if (or (not func)
+	  (pop-to-buffer gnus-article-current-summary)
-		  (numberp func))
+	  ;; We disable the pick minor mode commands.
-	      (ding)
+	  (let (gnus-pick-mode)
-	    (unless (member keys nosave-in-article)
+	    (setq func (lookup-key (current-local-map) keys))))
-	      (set-buffer gnus-article-current-summary))
+	(if (or (not func)
-	    (call-interactively func)
+		(numberp func))
-	    (setq new-sum-point (point)))
+	    (ding)
-	  (when (member keys nosave-but-article)
+	  (unless (member keys nosave-in-article)
-	    (pop-to-buffer gnus-article-buffer)))
+	    (set-buffer gnus-article-current-summary))
+	  (call-interactively func)
+	  (setq new-sum-point (point)))
+	(when (member keys nosave-but-article)
+	  (pop-to-buffer gnus-article-buffer))))
+(t
 ;; These commands should restore window configuration.
 (let ((obuf (current-buffer))
 	    (owin (current-window-configuration))
-	    (opoint (point))
+	    win func in-buffer selected new-sum-start new-sum-hscroll err)
-	    win func in-buffer selected new-sum-start new-sum-hscroll)
 	(cond (not-restore-window
-	       (pop-to-buffer gnus-article-current-summary))
+	       (pop-to-buffer gnus-article-current-summary)
+	       (setq win (selected-window)))
 	      ((setq win (get-buffer-window gnus-article-current-summary))
 	       (select-window win))
 	      (t
-	       (switch-to-buffer gnus-article-current-summary 'norecord)))
+	       (let ((summary-buffer gnus-article-current-summary))
+		 (gnus-configure-windows 'article)
+		 (unless (setq win (get-buffer-window summary-buffer 'visible))
+		   (let ((gnus-buffer-configuration
+			  '(article ((vertical 1.0
+					       (summary 0.25 point)
+					       (article 1.0))))))
+		     (gnus-configure-windows 'article))
+		   (setq win (get-buffer-window summary-buffer 'visible)))
+		 (gnus-select-frame-set-input-focus (window-frame win))
+		 (select-window win))))
 	(setq in-buffer (current-buffer))
 	;; We disable the pick minor mode commands.
 	(if (and (setq func (let (gnus-pick-mode)
 			      (lookup-key (current-local-map) keys)))
-		 (functionp func))
+		 (functionp func)
+		 (condition-case code
+		     (progn
+		       (call-interactively func)
+		       t)
+		   (error
+		    (setq err code)
+		    nil)))
 	    (progn
-	      (call-interactively func)
 	      (when (eq win (selected-window))
 		(setq new-sum-point (point)
 		      new-sum-start (window-start win)
 		      new-sum-hscroll (window-hscroll win)))
-	      (when (eq in-buffer (current-buffer))
+	      (when (or (eq in-buffer (current-buffer))
+			(when (eq obuf (current-buffer))
+			  (set-buffer in-buffer)
+			  t))
 		(setq selected (gnus-summary-select-article))
 		(set-buffer obuf)
 		(unless not-restore-window
 		  (set-window-configuration owin))
-		(when (eq selected 'old)
+		(when (and (eq selected 'old)
-		  (article-goto-body)
+			   new-sum-point)
 		  (set-window-start (get-buffer-window (current-buffer))
 				    1)
 		  (set-window-point (get-buffer-window (current-buffer))
-				    (point)))
+				    (if (article-goto-body)
+					(1- (point))
+				      (point))))
 		(when (and (not not-restore-window)
-			   new-sum-point)
+			   new-sum-point
+			   (with-current-buffer (window-buffer win)
+			     (eq major-mode 'gnus-summary-mode)))
 		  (set-window-point win new-sum-point)
 		  (set-window-start win new-sum-start)
 		  (set-window-hscroll win new-sum-hscroll))))
 	  (set-window-configuration owin)
-	  (ding))))))
+	  (if err
+	      (signal (car err) (cdr err))
+	    (ding))))))))
 (defun gnus-article-describe-key (key)
 "Display documentation of the function invoked by KEY.  KEY is a string."
 (interactive "kDescribe key: ")
 (gnus-article-check-buffer)
 	   ;; Refuse to select canceled articles.
 	   ((and (numberp article)
 		 gnus-summary-buffer
 		 (get-buffer gnus-summary-buffer)
 		 (gnus-buffer-exists-p gnus-summary-buffer)
-		 (eq (cdr (save-excursion
+		 (eq (cdr (with-current-buffer gnus-summary-buffer
-			    (set-buffer gnus-summary-buffer)
 			    (assq article gnus-newsgroup-reads)))
 		     gnus-canceled-mark))
 	    nil)
 	   ;; We first check `gnus-original-article-buffer'.
 	   ((and (get-buffer gnus-original-article-buffer)
 		 (numberp article)
-		 (save-excursion
+		 (with-current-buffer gnus-original-article-buffer
-		   (set-buffer gnus-original-article-buffer)
 		   (and (equal (car gnus-original-article) group)
 			(eq (cdr gnus-original-article) article))))
 	    (insert-buffer-substring gnus-original-article-buffer)
 	    'article)
 	   ;; Check the backlog.
 :type 'hook)
 (defvar gnus-article-edit-done-function nil)
 (defvar gnus-article-edit-mode-map nil)
-(defvar gnus-article-edit-mode nil)
 ;; Should we be using derived.el for this?
 (unless gnus-article-edit-mode-map
 (setq gnus-article-edit-mode-map (make-keymap))
 (set-keymap-parent gnus-article-edit-mode-map text-mode-map)
 'ignore
 (gnus-summary-edit-article-done
 ,(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)
 (let ((message-auto-save-directory
 	   ;; Don't associate the article buffer with a draft file.
 (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."
 (interactive "P")
 (let ((func gnus-article-edit-done-function)
 (when gnus-use-cache
 (gnus-cache-update-article
 (car gnus-article-current) (cdr gnus-article-current)))
 ;; We remove all text props from the article buffer.
 (kill-all-local-variables)
-(gnus-set-text-properties (point-min) (point-max) nil)
+(set-text-properties (point-min) (point-max) nil)
 (gnus-article-mode)
 (set-window-configuration winconf)
 (set-buffer buf)
 (set-window-start (get-buffer-window buf) start)
 (set-window-point (get-buffer-window buf) (point)))
 ;; Written by Per Abrahamsen <abraham@iesd.auc.dk>.
 ;;; Internal Variables:
 (defcustom gnus-button-url-regexp
-(if (string-match "[[:digit:]]" "1") ;; support POSIX?
+(concat
-"\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|nntp\\|news\\|telnet\\|wais\\|mailto\\|info\\):\\)\\(//[-a-z0-9_.]+:[0-9]*\\)?[-a-z0-9_=!?#$@~%&*+\\/:;.,[:word:]]+[-a-z0-9_=#$@~%&*+\\/[:word:]]\\)"
+"\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|"
-"\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|nntp\\|news\\|telnet\\|wais\\|mailto\\|info\\):\\)\\(//[-a-z0-9_.]+:[0-9]*\\)?\\([-a-z0-9_=!?#$@~%&*+\\/:;.,]\\|\\w\\)+\\([-a-z0-9_=#$@~%&*+\\/]\\|\\w\\)\\)")
+"nntp\\|news\\|telnet\\|wais\\|mailto\\|info\\):\\)"
+"\\(//[-a-z0-9_.]+:[0-9]*\\)?"
+(if (string-match "[[:digit:]]" "1") ;; Support POSIX?
+(let ((chars "-a-z0-9_=#$@~%&*+\\/[:word:]")
+	     (punct "!?:;.,"))
+	 (concat
+	  "\\(?:"
+	  ;; Match paired parentheses, e.g. in Wikipedia URLs:
+	  "[" chars punct "]+" "(" "[" chars punct "]+" "[" chars "]*)" "[" chars "]"
+	  "\\|"
+	  "[" chars punct     "]+" "[" chars "]"
+	  "\\)"))
+(concat ;; XEmacs 21.4 doesn't support POSIX.
+"\\([-a-z0-9_=!?#$@~%&*+\\/:;.,]\\|\\w\\)+"
+"\\([-a-z0-9_=#$@~%&*+\\/]\\|\\w\\)"))
+"\\)")
 "Regular expression that matches URLs."
 :group 'gnus-article-buttons
 :type 'regexp)
 (defcustom gnus-button-valid-fqdn-regexp
 	  ((eq pref 'mail)
 	   (gnus-message 8 "calling `gnus-url-mailto'  %s" url-mailto)
 	   (gnus-url-mailto url-mailto))
 	  (t (gnus-message 3 "Invalid string.")))))
-(defun gnus-button-handle-custom (url)
+(defun gnus-button-handle-custom (fun arg)
-"Follow a Custom URL."
+"Call function FUN on argument ARG.
-(customize-apropos (gnus-url-unhex-string url)))
+Both FUN and ARG are supposed to be strings.  ARG will be passed
+as a symbol to FUN."
+(funcall (intern fun)
+	   (if (string-match "^customize-apropos" fun)
+	       arg
+	     (intern arg))))
 (defvar gnus-button-handle-describe-prefix "^\\(C-h\\|<?[Ff]1>?\\)")
 ;; FIXME: Maybe we should merge some of the functions that do quite similar
 ;; stuff?
 0 (>= gnus-button-message-level 0) gnus-button-fetch-group 3)
 ;; RFC 2392 (Don't allow `/' in domain part --> CID)
 ("\\bmid:\\(//\\)?\\([^'\">\n\t ]+@[^'\">\n\t /]+\\)"
 0 (>= gnus-button-message-level 0) gnus-button-message-id 2)
 ("\\bin\\( +article\\| +message\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)"
+2 (>= gnus-button-message-level 0) gnus-button-message-id 3)
+("\\b\\(mid\\|message-id\\):? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)"
 2 (>= gnus-button-message-level 0) gnus-button-message-id 3)
 ("\\(<URL: *\\)mailto: *\\([^> \n\t]+\\)>"
 0 (>= gnus-button-message-level 0) gnus-url-mailto 2)
 ;; RFC 2368 (The mailto URL scheme)
 ("\\bmailto:\\([-a-z.@_+0-9%=?&/]+\\)"
 (>= gnus-button-emacs-level 1) gnus-button-handle-info-url 2)
 ("\\b\\(C-h\\|<?[Ff]1>?\\)[ \t\n]+i[ \t\n]+d?[ \t\n]?m[ \t\n]+\\([^ ]+ ?[^ ]+\\)[ \t\n]+RET"
 ;; Info links like `C-h i d m CC Mode RET'
 0 (>= gnus-button-emacs-level 1) gnus-button-handle-info-keystrokes 2)
 ;; This is custom
-("\\bcustom:\\(//\\)?\\([^'\">\n\t ]+\\)"
+("M-x[ \t\n]\\(customize-[^ ]+\\)[ \t\n]RET[ \t\n]\\([^ ]+\\)[ \t\n]RET" 0
-0 (>= gnus-button-emacs-level 5) gnus-button-handle-custom 2)
+(>= gnus-button-emacs-level 1) gnus-button-handle-custom 1 2)
-("M-x[ \t\n]customize-[^ ]+[ \t\n]RET[ \t\n]\\([^ ]+\\)[ \t\n]RET" 0
-(>= gnus-button-emacs-level 1) gnus-button-handle-custom 1)
 ;; Emacs help commands
 ("M-x[ \t\n]+apropos[ \t\n]+RET[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET"
 ;; regexp doesn't match arguments containing ` '.
 0 (>= gnus-button-emacs-level 1) gnus-button-handle-apropos 1)
 ("M-x[ \t\n]+apropos-command[ \t\n]+RET[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET"
 ("/\\([a-z][-a-z0-9]+\\.el\\)\\>[^.?]"
 ;; Exclude [.?] for URLs in gmane.emacs.cvs
 1 (>= gnus-button-emacs-level 8) gnus-button-handle-library 1)
 ("`\\([a-z][-a-z0-9]+\\.el\\)'"
 1 (>= gnus-button-emacs-level 8) gnus-button-handle-library 1)
-("`\\([a-z][a-z0-9]+-[a-z]+-[-a-z]+\\|\\(gnus\\|message\\)-[-a-z]+\\)'"
+("`\\([a-z][a-z0-9]+-[a-z0-9]+-[-a-z0-9]*[a-z]\\|\\(gnus\\|message\\)-[-a-z]+\\)'"
 0 (>= gnus-button-emacs-level 8) gnus-button-handle-symbol 1)
 ("`\\([a-z][a-z0-9]+-[a-z]+\\)'"
 0 (>= gnus-button-emacs-level 9) gnus-button-handle-symbol 1)
 ("(setq[ \t\n]+\\([a-z][a-z0-9]+-[-a-z0-9]+\\)[ \t\n]+.+)"
 1 (>= gnus-button-emacs-level 7) gnus-button-handle-describe-variable 1)
 ("`\\(\\(C-h\\|<?[Ff]1>?\\)[ \t\n]+k[ \t\n]+\\([^']+\\)\\)'"
 ;; Unlike the other regexps we really have to require quoting
 ;; here to determine where it ends.
 1 (>= gnus-button-emacs-level 1) gnus-button-handle-describe-key 3)
 ;; This is how URLs _should_ be embedded in text (RFC 1738, RFC 2396)...
-("<URL: *\\([^<>]*\\)>"
+("<URL: *\\([^\n<>]*\\)>"
 1 (>= gnus-button-browse-level 0) gnus-button-embedded-url 1)
 ;; RFC 2396 (2.4.3., delims) ...
-("\"URL: *\\([^\"]*\\)\""
+("\"URL: *\\([^\n\"]*\\)\""
-1 (>= gnus-button-browse-level 0) gnus-button-embedded-url 1)
-;; RFC 2396 (2.4.3., delims) ...
-("\"URL: *\\([^\"]*\\)\""
 1 (>= gnus-button-browse-level 0) gnus-button-embedded-url 1)
 ;; Raw URLs.
 (gnus-button-url-regexp
 0 (>= gnus-button-browse-level 0) browse-url 0)
 ;; man pages
 gnus-button-handle-man 1)
 ;; even more: Apache::PerlRun(3pm), PDL::IO::FastRaw(3pm),
 ;; SoWWWAnchor(3iv), XSelectInput(3X11), X(1), X(7)
 ("\\b\\(\\(?:[a-z][-+_.:a-z0-9]+([1-9][X1a-z]*)\\)\\|\\b\\(?:X([1-9])\\)\\)\\W"
 0 (>= gnus-button-man-level 5) gnus-button-handle-man 1)
+;; Recognizing patches to .el files.  This is somewhat obscure,
+;; but considering the percentage of Gnus users who hack Emacs
+;; Lisp files...
+("^--- \\([^ .]+\\.el\\).*\n.*\n@@ -?\\([0-9]+\\)" 1
+(>= gnus-button-message-level 4) gnus-button-patch 1 2)
+("^\\*\\*\\* \\([^ .]+\\.el\\).*\n.*\n\\*+\n\\*\\*\\* \\([0-9]+\\)" 1
+(>= gnus-button-message-level 4) gnus-button-patch 1 2)
 ;; MID or mail: To avoid too many false positives we don't try to catch
 ;; all kind of allowed MIDs or mail addresses.  Domain part must contain
 ;; at least one dot.  TLD must contain two or three chars or be a know TLD
 ;; (info|name|...).  Put this entry near the _end_ of `gnus-button-alist'
 ;; so that non-ambiguous entries (see above) match first.
 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 ]*\\)>\\)"
 1 (>= gnus-button-message-level 0) gnus-button-message-id 4))
 "*Alist of headers and regexps to match buttons in article heads.
 (gnus-article-add-buttons))
 (defun gnus-article-highlight-headers ()
 "Highlight article headers as specified by `gnus-header-face-alist'."
 (interactive)
-(save-excursion
+(gnus-with-article-headers
-(set-buffer gnus-article-buffer)
+(let (regexp header-face field-face from hpoints fpoints)
-(save-restriction
+(dolist (entry gnus-header-face-alist)
-(let ((alist gnus-header-face-alist)
+	(goto-char (point-min))
-	    (inhibit-read-only t)
+	(setq regexp (concat "^\\("
-	    (case-fold-search t)
+			     (if (string-equal "" (nth 0 entry))
-	    (inhibit-point-motion-hooks t)
+				 "[^\t ]"
-	    entry regexp header-face field-face from hpoints fpoints)
+			       (nth 0 entry))
-	(article-narrow-to-head)
+			     "\\)")
-	(while (setq entry (pop alist))
+	      header-face (nth 1 entry)
-	  (goto-char (point-min))
+	      field-face (nth 2 entry))
-	  (setq regexp (concat "^\\("
+	(while (and (re-search-forward regexp nil t)
-			       (if (string-equal "" (nth 0 entry))
+		    (not (eobp)))
-				   "[^\t ]"
+	  (beginning-of-line)
-				 (nth 0 entry))
+	  (setq from (point))
-			       "\\)")
+	  (unless (search-forward ":" nil t)
-		header-face (nth 1 entry)
+	    (forward-char 1))
-		field-face (nth 2 entry))
+	  (when (and header-face
-	  (while (and (re-search-forward regexp nil t)
+		     (not (memq (point) hpoints)))
-		      (not (eobp)))
+	    (push (point) hpoints)
-	    (beginning-of-line)
+	    (gnus-put-text-property from (point) 'face header-face))
-	    (setq from (point))
+	  (when (and field-face
-	    (unless (search-forward ":" nil t)
+		     (not (memq (setq from (point)) fpoints)))
-	      (forward-char 1))
+	    (push from fpoints)
-	    (when (and header-face
+	    (if (re-search-forward "^[^ \t]" nil t)
-		       (not (memq (point) hpoints)))
+		(forward-char -2)
-	      (push (point) hpoints)
+	      (goto-char (point-max)))
-	      (gnus-put-text-property from (point) 'face header-face))
+	    (gnus-put-text-property from (point) 'face field-face)))))))
-	    (when (and field-face
-		       (not (memq (setq from (point)) fpoints)))
-	      (push from fpoints)
-	      (if (re-search-forward "^[^ \t]" nil t)
-		  (forward-char -2)
-		(goto-char (point-max)))
-	      (gnus-put-text-property from (point) 'face field-face))))))))
 (defun gnus-article-highlight-signature ()
 "Highlight the signature in an article.
 It does this by highlighting everything after
 `gnus-signature-separator' using the face `gnus-signature'."
 (interactive)
-(save-excursion
+(gnus-with-article-buffer
-(set-buffer gnus-article-buffer)
+(let ((inhibit-point-motion-hooks t))
-(let ((inhibit-read-only t)
-	  (inhibit-point-motion-hooks t))
 (save-restriction
 	(when (and gnus-signature-face
 		   (gnus-article-narrow-to-signature))
-	  (gnus-overlay-put (gnus-make-overlay (point-min) (point-max))
+	  (gnus-overlay-put (gnus-make-overlay (point-min) (point-max) nil t)
 			    'face gnus-signature-face)
 	  (widen)
 	  (gnus-article-search-signature)
 	  (let ((start (match-beginning 0))
 		(end (set-marker (make-marker) (1+ (match-end 0)))))
 (defun gnus-article-add-buttons (&optional force)
 "Find external references in the article and make buttons of them.
 \"External references\" are things like Message-IDs and URLs, as
 specified by `gnus-button-alist'."
 (interactive (list 'force))
-(save-excursion
+(gnus-with-article-buffer
-(set-buffer gnus-article-buffer)
+(let ((inhibit-point-motion-hooks t)
-(let ((inhibit-read-only t)
-	  (inhibit-point-motion-hooks t)
 	  (case-fold-search t)
 	  (alist gnus-button-alist)
 	  beg entry regexp)
 ;; Remove all old markers.
 (let (marker entry new-list)
 (setq beg (point))
 (while (setq entry (pop alist))
 	(setq regexp (eval (car entry)))
 	(goto-char beg)
 	(while (re-search-forward regexp nil t)
-	  (let* ((start (and entry (match-beginning (nth 1 entry))))
+	  (let ((start (match-beginning (nth 1 entry)))
-		 (end (and entry (match-end (nth 1 entry))))
+		(end (match-end (nth 1 entry)))
-		 (from (match-beginning 0)))
+		(from (match-beginning 0)))
 	    (when (and (or (eq t (nth 2 entry))
 			   (eval (nth 2 entry)))
 		       (not (gnus-button-in-region-p
 			     start end 'gnus-callback)))
 	      ;; That optional form returned non-nil, so we add the
 	      ;; button.
-	      (gnus-article-add-button
+	      (setq from (set-marker (make-marker) from))
-	       start end 'gnus-button-push
+	      (push from gnus-button-marker-list)
-	       (car (push (set-marker (make-marker) from)
+	      (unless (and (eq (car entry) 'gnus-button-url-regexp)
-			  gnus-button-marker-list))))))))))
+			   (gnus-article-extend-url-button from start end))
+		(gnus-article-add-button start end
+					 'gnus-button-push from)))))))))
+(defun gnus-article-extend-url-button (beg start end)
+"Extend url button if url is folded into two or more lines.
+Return non-nil if button is extended.  BEG is a marker that points to
+the beginning position of a text containing url.  START and END are
+the endpoints of a url button before it is extended.  The concatenated
+url is put as the `gnus-button-url' overlay property on the button."
+(let ((opoint (point))
+	(points (list start end))
+	url delim regexp)
+(prog1
+	(when (and (progn
+		     (goto-char end)
+		     (not (looking-at "[\t ]*[\">]")))
+		   (progn
+		     (goto-char start)
+		     (string-match
+		      "\\(?:\"\\|\\(<\\)\\)[\t ]*\\(?:url[\t ]*:[\t ]*\\)?\\'"
+		      (buffer-substring (point-at-bol) start)))
+		   (progn
+		     (setq url (list (buffer-substring start end))
+			   delim (if (match-beginning 1) ">" "\""))
+		     (beginning-of-line)
+		     (setq regexp (concat
+				   (when (and (looking-at
+					       message-cite-prefix-regexp)
+					      (< (match-end 0) start))
+				     (regexp-quote (match-string 0)))
+				   "\
+\[\t ]*\\(?:\\([^\t\n \">]+\\)[\t ]*$\\|\\([^\t\n \">]*\\)[\t ]*"
+				   delim "\\)"))
+		     (while (progn
+			      (forward-line 1)
+			      (and (looking-at regexp)
+				   (prog1
+				       (match-beginning 1)
+				     (push (or (match-string 2)
+					       (match-string 1))
+					   url)
+				     (push (setq end (or (match-end 2)
+							 (match-end 1)))
+					   points)
+				     (push (or (match-beginning 2)
+					       (match-beginning 1))
+					   points)))))
+		     (match-beginning 2)))
+	  (let (gnus-article-mouse-face widget-mouse-face)
+	    (while points
+	      (gnus-article-add-button (pop points) (pop points)
+				       'gnus-button-push beg)))
+	  (let ((overlay (gnus-make-overlay start end)))
+	    (gnus-overlay-put overlay 'evaporate t)
+	    (gnus-overlay-put overlay 'gnus-button-url
+			      (list (mapconcat 'identity (nreverse url) "")))
+	    (when gnus-article-mouse-face
+	      (gnus-overlay-put overlay 'mouse-face gnus-article-mouse-face)))
+	  t)
+(goto-char opoint))))
 ;; Add buttons to the head of an article.
 (defun gnus-article-add-buttons-to-head ()
 "Add buttons to the head of the article."
 (interactive)
-(save-excursion
+(gnus-with-article-headers
-(set-buffer gnus-article-buffer)
+(let (beg end)
-(save-restriction
+(dolist (entry gnus-header-button-alist)
-(let ((inhibit-read-only t)
+	;; Each alist entry.
-	    (inhibit-point-motion-hooks t)
+	(goto-char (point-min))
-	    (case-fold-search t)
+	(while (re-search-forward (car entry) nil t)
-	    (alist gnus-header-button-alist)
+	  ;; Each header matching the entry.
-	    entry beg end)
+	  (setq beg (match-beginning 0))
-	(article-narrow-to-head)
+	  (setq end (or (and (re-search-forward "^[^ \t]" nil t)
-	(while alist
+			     (match-beginning 0))
-	  ;; Each alist entry.
+			(point-max)))
-	  (setq entry (car alist)
+	  (goto-char beg)
-		alist (cdr alist))
+	  (while (re-search-forward (eval (nth 1 entry)) end t)
-	  (goto-char (point-min))
+	    ;; Each match within a header.
-	  (while (re-search-forward (car entry) nil t)
+	    (let* ((entry (cdr entry))
-	    ;; Each header matching the entry.
+		   (start (match-beginning (nth 1 entry)))
-	    (setq beg (match-beginning 0))
+		   (end (match-end (nth 1 entry)))
-	    (setq end (or (and (re-search-forward "^[^ \t]" nil t)
+		   (form (nth 2 entry)))
-			       (match-beginning 0))
+	      (goto-char (match-end 0))
-			  (point-max)))
+	      (when (eval form)
-	    (goto-char beg)
+		(gnus-article-add-button
-	    (while (re-search-forward (eval (nth 1 entry)) end t)
+		 start end (nth 3 entry)
-	      ;; Each match within a header.
+		 (buffer-substring (match-beginning (nth 4 entry))
-	      (let* ((entry (cdr entry))
+				   (match-end (nth 4 entry)))))))
-		     (start (match-beginning (nth 1 entry)))
+	  (goto-char end))))))
-		     (end (match-end (nth 1 entry)))
-		     (form (nth 2 entry)))
-		(goto-char (match-end 0))
-		(when (eval form)
-		  (gnus-article-add-button
-		   start end (nth 3 entry)
-		   (buffer-substring (match-beginning (nth 4 entry))
-				     (match-end (nth 4 entry)))))))
-	    (goto-char end)))))))
 ;;; External functions:
 (defun gnus-article-add-button (from to fun &optional data)
 "Create a button between FROM and TO with callback FUN and data DATA."
 (when gnus-article-button-face
-(gnus-overlay-put (gnus-make-overlay from to)
+(gnus-overlay-put (gnus-make-overlay from to nil t)
 		      'face gnus-article-button-face))
 (gnus-add-text-properties
 from to
 (nconc (and gnus-article-mouse-face
 	       (list gnus-mouse-face-prop gnus-article-mouse-face))
 			 :button-keymap gnus-widget-button-keymap))
 ;;; Internal functions:
 (defun gnus-article-set-globals ()
-(save-excursion
+(with-current-buffer gnus-summary-buffer
-(set-buffer gnus-summary-buffer)
 (gnus-set-global-variables)))
 (defun gnus-signature-toggle (end)
-(save-excursion
+(gnus-with-article-buffer
-(set-buffer gnus-article-buffer)
+(let ((inhibit-point-motion-hooks t))
-(let ((inhibit-read-only t)
-	  (inhibit-point-motion-hooks t))
 (if (text-property-any end (point-max) 'article-type 'signature)
 	  (progn
 	    (gnus-delete-wash-type 'signature)
 	    (gnus-remove-text-properties-when
 	     'article-type 'signature end (point-max)
 (save-excursion
 (goto-char marker)
 (let* ((entry (gnus-button-entry))
 	   (inhibit-point-motion-hooks t)
 	   (fun (nth 3 entry))
-	   (args (mapcar (lambda (group)
+	   (args (or (and (eq (car entry) 'gnus-button-url-regexp)
-			   (let ((string (match-string group)))
+			  (get-char-property marker 'gnus-button-url))
-			     (gnus-set-text-properties
+		     (mapcar (lambda (group)
-			      0 (length string) nil string)
+			       (let ((string (match-string group)))
-			     string))
+				 (set-text-properties
-			 (nthcdr 4 entry))))
+				  0 (length string) nil string)
+				 string))
+			     (nthcdr 4 entry)))))
 (cond
 ((fboundp fun)
 	(apply fun args))
 ((and (boundp fun)
 	     (fboundp (symbol-value fun)))
 	      (gnus-summary-refer-article message-id))
 	  (gnus-summary-refer-article message-id))))
 (group
 (gnus-button-fetch-group url)))))
+(defun gnus-button-patch (library line)
+"Visit an Emacs Lisp library LIBRARY on line LINE."
+(interactive)
+(let ((file (locate-library (file-name-nondirectory library))))
+(unless file
+(error "Couldn't find library %s" library))
+(find-file file)
+(goto-line (string-to-number line))))
 (defun gnus-button-handle-man (url)
 "Fetch a man page."
 (gnus-message 9 "`%s' `%s'" gnus-button-man-handler url)
 (when (eq gnus-button-man-handler 'woman)
 (setq url (gnus-replace-in-string url "([1-9][X1a-z]*).*\\'" "")))
 ;; For links like `C-h i d m gnus RET', `C-h i d m CC Mode RET'.
 (info)
 (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."
-(save-excursion
+(with-current-buffer gnus-summary-buffer
-(set-buffer gnus-summary-buffer)
 (gnus-summary-refer-article message-id)))
-(defun gnus-button-fetch-group (address)
+(defun gnus-button-fetch-group (address &rest ignore)
 "Fetch GROUP specified by ADDRESS."
+(when (string-match "\\`\\(nntp\\|news\\):\\(//\\)?\\(.*\\)\\'"
+		      address)
+;; Allow to use `gnus-button-fetch-group' in `browse-url-browser-function'
+;; for nntp:// and news://
+(setq address (match-string 3 address)))
 (if (not (string-match "[:/]" address))
 ;; This is just a simple group url.
 (gnus-group-read-ephemeral-group address gnus-select-method)
 (if (not
 	 (string-match
 (defvar gnus-next-page-line-format "%{%(Next page...%)%}\n")
 (defvar gnus-prev-page-line-format "%{%(Previous page...%)%}\n")
 (defvar gnus-prev-page-map
 (let ((map (make-sparse-keymap)))
-(unless (>= emacs-major-version 21)
-;; XEmacs doesn't care.
-(set-keymap-parent map gnus-article-mode-map))
 (define-key map gnus-mouse-2 'gnus-button-prev-page)
 (define-key map "\r" 'gnus-button-prev-page)
 map))
 (defvar gnus-next-page-map
 (define-key map gnus-mouse-2 'gnus-button-next-page)
 (define-key map "\r" 'gnus-button-next-page)
 map))
 (defun gnus-insert-prev-page-button ()
-(let ((b (point))
+(let ((b (point)) e
 	(inhibit-read-only t))
 (gnus-eval-format
 gnus-prev-page-line-format nil
-`(,@(gnus-local-map-property gnus-prev-page-map)
+`(keymap ,gnus-prev-page-map
-	 gnus-prev t
+	      gnus-prev t
-	 gnus-callback gnus-article-button-prev-page
+	      gnus-callback gnus-article-button-prev-page
-	 article-type annotation))
+	      article-type annotation))
+(setq e (if (bolp)
+		;; Exclude a newline.
+		(1- (point))
+	      (point)))
+(when gnus-article-button-face
+(gnus-overlay-put (gnus-make-overlay b e nil t)
+'face gnus-article-button-face))
 (widget-convert-button
-'link b (if (bolp)
+'link b e
-		 ;; Exclude a newline.
-		 (1- (point))
-	       (point))
 :action 'gnus-button-prev-page
 :button-keymap gnus-prev-page-map)))
 (defun gnus-button-next-page (&optional args more-args)
 "Go to the next page."
 (select-window (gnus-get-buffer-window gnus-article-buffer t))
 (gnus-article-prev-page)
 (select-window win)))
 (defun gnus-insert-next-page-button ()
-(let ((b (point))
+(let ((b (point)) e
 	(inhibit-read-only t))
 (gnus-eval-format gnus-next-page-line-format nil
-		      `(,@(gnus-local-map-property gnus-next-page-map)
+		      `(keymap ,gnus-next-page-map
-			  gnus-next t
+gnus-next t
-			  gnus-callback gnus-article-button-next-page
+gnus-callback gnus-article-button-next-page
-			  article-type annotation))
+article-type annotation))
+(setq e (if (bolp)
+		;; Exclude a newline.
+		(1- (point))
+	      (point)))
+(when gnus-article-button-face
+(gnus-overlay-put (gnus-make-overlay b e nil t)
+'face gnus-article-button-face))
 (widget-convert-button
-'link b (if (bolp)
+'link b e
-		 ;; Exclude a newline.
-		 (1- (point))
-	       (point))
 :action 'gnus-button-next-page
 :button-keymap gnus-next-page-map)))
 (defun gnus-article-button-next-page (arg)
 "Go to the next page."
 "Apply the functions from `gnus-encoded-word-methods' that match."
 (unless (and gnus-decode-header-methods-cache
 	       (eq gnus-newsgroup-name
 		   (car gnus-decode-header-methods-cache)))
 (setq gnus-decode-header-methods-cache (list gnus-newsgroup-name))
-(mapcar (lambda (x)
+(dolist (x gnus-decode-header-methods)
-	      (if (symbolp x)
+(if (symbolp x)
-		  (nconc gnus-decode-header-methods-cache (list x))
+	  (nconc gnus-decode-header-methods-cache (list x))
-		(if (and gnus-newsgroup-name
+	(if (and gnus-newsgroup-name
-			 (string-match (car x) gnus-newsgroup-name))
+		 (string-match (car x) gnus-newsgroup-name))
-		    (nconc gnus-decode-header-methods-cache
+	    (nconc gnus-decode-header-methods-cache
-			   (list (cdr x))))))
+		   (list (cdr x)))))))
-	  gnus-decode-header-methods))
 (let ((xlist gnus-decode-header-methods-cache))
 (pop xlist)
 (save-restriction
 (narrow-to-region start end)
 (while xlist
 	(error "%S is not a valid predicate" pred)))))
 ((eq val t)
 t)
 ((eq val 'head)
 nil)
+((eq val 'first)
+(eq part-number 1))
 ((eq val 'last)
 (eq part-number total-parts))
 ((numberp val)
 (< length val))
 (t
 '((?t gnus-tmp-type ?s)
 (?i gnus-tmp-info ?s)
 (?d gnus-tmp-details ?s)
 (?D gnus-tmp-pressed-details ?s)))
+(defvar gnus-mime-security-button-commands
+'((gnus-article-press-button "\r" "Show Detail")
+(undefined "v")
+(undefined "t")
+(undefined "C")
+(gnus-mime-security-save-part "o" "Save...")
+(undefined "\C-o")
+(undefined "r")
+(undefined "d")
+(undefined "c")
+(undefined "i")
+(undefined "E")
+(undefined "e")
+(undefined "p")
+(gnus-mime-security-pipe-part "|" "Pipe To Command...")
+(undefined ".")))
 (defvar gnus-mime-security-button-map
 (let ((map (make-sparse-keymap)))
-(unless (>= (string-to-number emacs-version) 21)
-(set-keymap-parent map gnus-article-mode-map))
 (define-key map gnus-mouse-2 'gnus-article-push-button)
-(define-key map "\r" 'gnus-article-press-button)
+(define-key map gnus-down-mouse-3 'gnus-mime-security-button-menu)
+(dolist (c gnus-mime-security-button-commands)
+(define-key map (cadr c) (car c)))
 map))
+(easy-menu-define
+gnus-mime-security-button-menu gnus-mime-security-button-map
+"Security button menu."
+`("Security Part"
+,@(delq nil
+	    (mapcar (lambda (c)
+		      (unless (eq (car c) 'undefined)
+			(vector (caddr c) (car c) :active t)))
+		    gnus-mime-security-button-commands))))
+(defun gnus-mime-security-button-menu (event prefix)
+"Construct a context-sensitive menu of security commands."
+(interactive "e\nP")
+(save-window-excursion
+(let ((pos (event-start event)))
+(select-window (posn-window pos))
+(goto-char (posn-point pos))
+(gnus-article-check-buffer)
+(popup-menu gnus-mime-security-button-menu nil prefix))))
 (defvar gnus-mime-security-details-buffer nil)
 (defvar gnus-mime-security-button-pressed nil)
 (mm-remove-parts (cdr handle))
 (let ((region (mm-handle-multipart-ctl-parameter handle 'gnus-region))
 	point (inhibit-read-only t))
 (if region
 	(goto-char (car region)))
-(save-restriction
+(setq point (point))
-(narrow-to-region (point) (point))
+(with-current-buffer (mm-handle-multipart-original-buffer handle)
-(with-current-buffer (mm-handle-multipart-original-buffer handle)
+(let* ((mm-verify-option 'known)
-	(let* ((mm-verify-option 'known)
+	     (mm-decrypt-option 'known)
-	       (mm-decrypt-option 'known)
+	     (nparts (mm-possibly-verify-or-decrypt (cdr handle) handle)))
-	       (nparts (mm-possibly-verify-or-decrypt (cdr handle) handle)))
+	(unless (eq nparts (cdr handle))
-	  (unless (eq nparts (cdr handle))
+	  (mm-destroy-parts (cdr handle))
-	    (mm-destroy-parts (cdr handle))
+	  (setcdr handle nparts))))
-	    (setcdr handle nparts))))
+(gnus-mime-display-security handle)
-(setq point (point))
-(gnus-mime-display-security handle)
-(goto-char (point-max)))
 (when region
 (delete-region (point) (cdr region))
 (set-marker (car region) nil)
 (set-marker (cdr region) nil))
 (goto-char point)))
 (insert "\n"))
 (setq b (point))
 (gnus-eval-format
 gnus-mime-security-button-line-format
 gnus-mime-security-button-line-format-alist
-`(,@(gnus-local-map-property gnus-mime-security-button-map)
+`(keymap ,gnus-mime-security-button-map
 	 gnus-callback gnus-mime-security-press-button
 	 gnus-line-format ,gnus-mime-security-button-line-format
 	 gnus-mime-details ,gnus-mime-security-button-pressed
 	 article-type annotation
 	 gnus-data ,handle))
 (setq e (if (bolp)
 		;; Exclude a newline.
 		(1- (point))
 	      (point)))
+(when gnus-article-button-face
+(gnus-overlay-put (gnus-make-overlay b e nil t)
+'face gnus-article-button-face))
 (widget-convert-button
 'link b e
 :mime-handle handle
 :action 'gnus-widget-press-button
 :button-keymap gnus-mime-security-button-map
 ;; Needed to properly clear the message due to a bug in
 ;; wid-edit (XEmacs only).
 (when (boundp 'help-echo-owns-message)
 	 (setq help-echo-owns-message t))
 (format
-	"%S: show detail"
+	"%S: show detail; %S: more options"
-	(aref gnus-mouse-2 0))))))
+	(aref gnus-mouse-2 0)
+	(aref gnus-down-mouse-3 0))))))
 (defun gnus-mime-display-security (handle)
 (save-restriction
 (narrow-to-region (point) (point))
 (unless (gnus-unbuttonized-mime-type-p (car handle))
 (gnus-insert-mime-security-button handle))
-(gnus-mime-display-mixed (cdr handle))
+(gnus-mime-display-part (cadr handle))
 (unless (bolp)
 (insert "\n"))
 (unless (gnus-unbuttonized-mime-type-p (car handle))
 (let ((gnus-mime-security-button-line-format
 	     gnus-mime-security-button-end-line-format))
 	(gnus-insert-mime-security-button handle)))
 (mm-set-handle-multipart-parameter
 handle 'gnus-region
 (cons (set-marker (make-marker) (point-min))
-	   (set-marker (make-marker) (point-max))))))
+	   (set-marker (make-marker) (point-max))))
+(goto-char (point-max))))
+(defun gnus-mime-security-run-function (function)
+"Run FUNCTION with the security part under point."
+(gnus-article-check-buffer)
+(let ((data (get-text-property (point) 'gnus-data))
+	buffer handle)
+(when (and (stringp (car-safe data))
+	       (setq buffer (mm-handle-multipart-original-buffer data))
+	       (setq handle (cadr data)))
+(if (bufferp (mm-handle-buffer handle))
+	  (progn
+	    (setq handle (cons buffer (copy-sequence (cdr handle))))
+	    (mm-handle-set-undisplayer handle nil))
+	(setq handle (mm-make-handle
+		      buffer
+		      (mm-handle-multipart-ctl-parameter handle 'protocol)
+		      nil nil nil nil nil nil)))
+(funcall function handle))))
+(defun gnus-mime-security-save-part ()
+"Save the security part under point."
+(interactive)
+(gnus-mime-security-run-function 'mm-save-part))
+(defun gnus-mime-security-pipe-part ()
+"Pipe the security part under point to a process."
+(interactive)
+(gnus-mime-security-run-function 'mm-pipe-part))
 (gnus-ems-redefine)
 (provide 'gnus-art)

Mercurial > emacs

comparison lisp/gnus/gnus-art.el @ 85712:a3c27999decb