X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-art.el;h=e33f25c935277257f2dc09c946c77e3ed3f453a9;hb=a469ddcc3be84b5f7924665489126f9f386017c2;hp=d8f154ce02ba928ad49404700b71e1bb1d3d5e3e;hpb=5fc32454309653cba01d5ffd1f79ba1cd8c4f7e4;p=gnus

diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el
index d8f154ce0..e33f25c93 100644
--- a/lisp/gnus-art.el
+++ b/lisp/gnus-art.el
@@ -149,7 +149,7 @@
      "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-Abuse-and-DMCA-Info" "X-Postfilter" "X-Gpg-.*" "X-Disclaimer"))
   "*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."
@@ -243,8 +243,8 @@ regexp.  If it matches, the text in question is not a signature."
   :type 'sexp
   :group 'gnus-article-hiding)
 
-;; Fixme: This isn't the right thing for mixed graphical and and
-;; non-graphical frames in a session.
+;; Fixme: This isn't the right thing for mixed graphical and non-graphical
+;; frames in a session.
 (defcustom gnus-article-x-face-command
   (if (featurep 'xemacs)
       (if (or (gnus-image-type-available-p 'xface)
@@ -560,8 +560,7 @@ The following additional specs are available:
   :type 'hook
   :group 'gnus-article-various)
 
-(defvar gnus-article-hide-pgp-hook nil)
-(make-obsolete-variable 'gnus-article-hide-pgp-hook 
+(make-obsolete-variable 'gnus-article-hide-pgp-hook
 			"This variable is obsolete in Gnus 5.10.")
 
 (defcustom gnus-article-button-face 'bold
@@ -629,7 +628,9 @@ Obsolete; use the face `gnus-signature-face' for customizations instead."
      (:foreground "MidnightBlue" :italic t))
     (t
      (:italic t)))
-  "Face used for displaying newsgroups headers."
+  "Face used for displaying newsgroups headers.
+In the default setup this face is only used for crossposted
+articles."
   :group 'gnus-article-headers
   :group 'gnus-article-highlight)
 
@@ -663,17 +664,17 @@ Obsolete; use the face `gnus-signature-face' for customizations instead."
     ("Subject" nil gnus-header-subject-face)
     ("Newsgroups:.*," nil gnus-header-newsgroups-face)
     ("" gnus-header-name-face gnus-header-content-face))
-  "*Controls highlighting of article header.
+  "*Controls highlighting of article headers.
 
 An alist of the form (HEADER NAME CONTENT).
 
-HEADER is a regular expression which should match the name of an
-header header and NAME and CONTENT are either face names or nil.
+HEADER is a regular expression which should match the name of a
+header and NAME and CONTENT are either face names or nil.
 
 The name of each header field will be displayed using the face
-specified by the first element in the list where HEADER match the
-header name and NAME is non-nil.  Similarly, the content will be
-displayed by the first non-nil matching CONTENT face."
+specified by the first element in the list where HEADER matches
+the header name and NAME is non-nil.  Similarly, the content will
+be displayed by the first non-nil matching CONTENT face."
   :group 'gnus-article-headers
   :group 'gnus-article-highlight
   :type '(repeat (list (regexp :tag "Header")
@@ -982,7 +983,7 @@ See Info node `(gnus)Customizing Articles' for details."
   :link '(custom-manual "(gnus)Customizing Articles")
   :type gnus-article-treat-custom)
 
-(make-obsolete-variable 'gnus-treat-strip-pgp 
+(make-obsolete-variable 'gnus-treat-strip-pgp
 			"This option is obsolete in Gnus 5.10.")
 
 (defcustom gnus-treat-strip-pem nil
@@ -1144,7 +1145,10 @@ See Info node `(gnus)Customizing Articles' for details."
   :type gnus-article-treat-custom)
 (put 'gnus-treat-overstrike 'highlight t)
 
-(defcustom gnus-treat-display-xface
+(make-obsolete-variable 'gnus-treat-display-xface
+			'gnus-treat-display-x-face)
+
+(defcustom gnus-treat-display-x-face
   (and (not noninteractive)
        (or (and (fboundp 'image-type-available-p)
 		(image-type-available-p 'xbm)
@@ -1161,8 +1165,25 @@ See Info node `(gnus)Customizing Articles' and Info node
   :version "21.1"
   :link '(custom-manual "(gnus)Customizing Articles")
   :link '(custom-manual "(gnus)X-Face")
-  :type gnus-article-treat-head-custom)
-(put 'gnus-treat-display-xface 'highlight t)
+  :type gnus-article-treat-head-custom
+  :set (lambda (symbol value)
+	 (set-default
+	  symbol
+	  (cond ((or (boundp symbol) (get symbol 'saved-value))
+		 value)
+		((boundp 'gnus-treat-display-xface)
+		 (message "\
+** gnus-treat-display-xface is an obsolete variable;\
+ use gnus-treat-display-x-face instead")
+		 (default-value 'gnus-treat-display-xface))
+		((get 'gnus-treat-display-xface 'saved-value)
+		 (message "\
+** gnus-treat-display-xface is an obsolete variable;\
+ use gnus-treat-display-x-face instead")
+		 (eval (car (get 'gnus-treat-display-xface 'saved-value))))
+		(t
+		 value)))))
+(put 'gnus-treat-display-x-face 'highlight t)
 
 (defcustom gnus-treat-display-face
   (and (not noninteractive)
@@ -1180,7 +1201,7 @@ See Info node `(gnus)Customizing Articles' and Info node
   :link '(custom-manual "(gnus)Customizing Articles")
   :link '(custom-manual "(gnus)X-Face")
   :type gnus-article-treat-head-custom)
-(put 'gnus-treat-display-xface 'highlight t)
+(put 'gnus-treat-display-face 'highlight t)
 
 (defcustom gnus-treat-display-smileys
   (if (or (and (featurep 'xemacs)
@@ -1325,8 +1346,8 @@ It is a string, such as \"PGP\". If nil, ask user."
   "Function used for converting HTML into text.")
 
 (defcustom gnus-use-idna (and (condition-case nil (require 'idna) (file-error))
-			      (fboundp 'coding-system-p)
-			      (coding-system-p 'utf-8))
+			      (mm-coding-system-p 'utf-8)
+			      (executable-find idna-program))
   "Whether IDNA decoding of headers is used when viewing messages.
 This requires GNU Libidn, and by default only enabled if it is found."
   :group 'gnus-article-headers
@@ -1366,7 +1387,7 @@ This requires GNU Libidn, and by default only enabled if it is found."
     (gnus-treat-date-original gnus-article-date-original)
     (gnus-treat-date-user-defined gnus-article-date-user)
     (gnus-treat-date-iso8601 gnus-article-date-iso8601)
-    (gnus-treat-display-xface gnus-article-display-x-face)
+    (gnus-treat-display-x-face gnus-article-display-x-face)
     (gnus-treat-display-face gnus-article-display-face)
     (gnus-treat-hide-headers gnus-article-maybe-hide-headers)
     (gnus-treat-hide-boring-headers gnus-article-hide-boring-headers)
@@ -1977,20 +1998,40 @@ unfolded."
 (defun article-display-face ()
   "Display any Face headers in the header."
   (interactive)
-  (gnus-with-article-headers
-    (let ((face (message-fetch-field "face")))
-      (when face
-	(let ((png (gnus-convert-face-to-png face))
-	      image)
-	  (when png
-	    (setq image (gnus-create-image png 'png t))
-	    (gnus-article-goto-header "from")
-	    (when (bobp)
-	      (insert "From: [no `from' set]\n")
-	      (forward-char -17))
-	    (gnus-add-wash-type 'face)
-	    (gnus-add-image 'face image)
-	    (gnus-put-image image)))))))
+  (let ((wash-face-p buffer-read-only))
+    (gnus-with-article-headers
+      ;; When displaying parts, this function can be called several times on
+      ;; the same article, without any intended toggle semantic (as typing `W
+      ;; D d' would have). So face deletion must occur only when we come from
+      ;; an interactive command, that is when the *Article* buffer is
+      ;; read-only.
+      (if (and wash-face-p (memq 'face gnus-article-wash-types))
+	  (gnus-delete-images 'face)
+	(let (face faces)
+	  (save-excursion
+	    (when (and wash-face-p
+		       (progn
+			 (goto-char (point-min))
+			 (not (re-search-forward "^Face:[\t ]*" nil t)))
+		       (gnus-buffer-live-p gnus-original-article-buffer))
+	      (set-buffer gnus-original-article-buffer))
+	    (save-restriction
+	      (mail-narrow-to-head)
+	      (while (gnus-article-goto-header "Face")
+		(push (mail-header-field-value) faces))))
+	  (while (setq face (pop faces))
+	    (let ((png (gnus-convert-face-to-png face))
+		  image)
+	      (when png
+		(setq image (gnus-create-image png 'png t))
+		(gnus-article-goto-header "from")
+		(when (bobp)
+		  (insert "From: [no `from' set]\n")
+		  (forward-char -17))
+		(gnus-add-wash-type 'face)
+		(gnus-add-image 'face image)
+		(gnus-put-image image nil 'face))))))
+      )))
 
 (defun article-display-x-face (&optional force)
   "Look for an X-Face header and display it if present."
@@ -2000,7 +2041,8 @@ unfolded."
       ;; Delete the old process, if any.
       (when (process-status "article-x-face")
 	(delete-process "article-x-face"))
-      (if (memq 'xface gnus-article-wash-types)
+      ;; See the comment in `article-display-face'.
+      (if (and wash-face-p (memq 'xface gnus-article-wash-types))
 	  ;; We have already displayed X-Faces, so we remove them
 	  ;; instead.
 	  (gnus-delete-images 'xface)
@@ -2035,23 +2077,25 @@ unfolded."
 			       (not (string-match gnus-article-x-face-too-ugly
 						  from)))))
 	    ;; We display the face.
-	    (if (symbolp gnus-article-x-face-command)
-		;; The command is a lisp function, so we call it.
-		(if (gnus-functionp gnus-article-x-face-command)
-		    (funcall gnus-article-x-face-command face)
-		  (error "%s is not a function" gnus-article-x-face-command))
-	      ;; The command is a string, so we interpret the command
-	      ;; as a, well, command, and fork it off.
-	      (let ((process-connection-type nil))
-		(process-kill-without-query
-		 (start-process
-		  "article-x-face" nil shell-file-name shell-command-switch
-		  gnus-article-x-face-command))
-		(with-temp-buffer
-		  (insert face)
-		  (process-send-region "article-x-face"
-				       (point-min) (point-max)))
-		(process-send-eof "article-x-face")))))))))
+	    (cond ((stringp gnus-article-x-face-command)
+		   ;; The command is a string, so we interpret the command
+		   ;; as a, well, command, and fork it off.
+		   (let ((process-connection-type nil))
+		     (process-kill-without-query
+		      (start-process
+		       "article-x-face" nil shell-file-name
+		       shell-command-switch gnus-article-x-face-command))
+		     (with-temp-buffer
+		       (insert face)
+		       (process-send-region "article-x-face"
+					    (point-min) (point-max)))
+		     (process-send-eof "article-x-face")))
+		  ((functionp gnus-article-x-face-command)
+		   ;; The command is a lisp function, so we call it.
+		   (funcall gnus-article-x-face-command face))
+		  (t
+		   (error "%s is not a function"
+			  gnus-article-x-face-command)))))))))
 
 (defun article-decode-mime-words ()
   "Decode all MIME-encoded words in the article."
@@ -2110,7 +2154,7 @@ If PROMPT (the prefix), prompt for a coding system to use."
 	(mm-decode-body
 	 charset (and cte (intern (downcase
 				   (gnus-strip-whitespace cte))))
-	 (car ctl) prompt))))))
+	 (car ctl)))))))
 
 (defun article-decode-encoded-words ()
   "Remove encoded-word encoding from headers."
@@ -2273,8 +2317,8 @@ If READ-CHARSET, ask for a coding system."
       (while (re-search-forward
 	      "^\\(\\(https?\\|ftp\\)://\\S-+\\) *\n\\(\\S-+\\)" nil t)
 	(replace-match "\\1\\3" t)))
-    (when (and gnus-display-mime-function (interactive-p))
-      (funcall gnus-display-mime-function))))
+    (when (interactive-p)
+      (gnus-treat-article nil))))
 
 
 (defun article-wash-html (&optional read-charset)
@@ -2307,7 +2351,7 @@ If READ-CHARSET, ask for a coding system."
 	    (when entry
 	      (setq func (cdr entry)))
 	    (cond
-	     ((gnus-functionp func)
+	     ((functionp func)
 	      (funcall func))
 	     (t
 	      (apply (car func) (cdr func))))))))))
@@ -2581,7 +2625,7 @@ Point is left at the beginning of the narrowed-to region."
 		       (< (- (point-max) (point)) limit))
 		  (and (floatp limit)
 		       (< (count-lines (point) (point-max)) limit))
-		  (and (gnus-functionp limit)
+		  (and (functionp limit)
 		       (funcall limit))
 		  (and (stringp limit)
 		       (not (re-search-forward limit nil t))))
@@ -2783,7 +2827,7 @@ should replace the \"Date:\" one, or should be added below it."
 				  gnus-article-time-format)
 			      (error nil))
 			    gnus-article-time-format)))
-	    (if (gnus-functionp format)
+	    (if (functionp format)
 		(funcall format time)
 	      (concat "Date: " (format-time-string format time)))))
 	 ;; ISO 8601.
@@ -2893,9 +2937,12 @@ function and want to see what the date was before converting."
 	 (lambda (w)
 	   (set-buffer (window-buffer w))
 	   (when (eq major-mode 'gnus-article-mode)
-	     (goto-char (point-min))
-	     (when (re-search-forward "^X-Sent:" nil t)
-	       (article-date-lapsed t))))
+	     (let ((mark (point-marker)))
+	       (goto-char (point-min))
+	       (when (re-search-forward "^X-Sent:" nil t)
+		 (article-date-lapsed t))
+	       (goto-char (marker-position mark))
+	       (move-marker mark nil))))
 	 nil 'visible)))))
 
 (defun gnus-start-date-timer (&optional n)
@@ -3228,9 +3275,17 @@ The directory to save in defaults to `gnus-article-save-directory'."
       (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 (read-string
+  (setq command (gnus-read-string
 		 "Print using command: " gnus-summary-muttprint-program
 		 nil gnus-summary-muttprint-program))
   (gnus-summary-save-in-pipe command))
@@ -3916,9 +3971,7 @@ General format specifiers can also be used.  See Info node
 	     (let ((mbl1 mml-buffer-list))
 	       (setq mml-buffer-list mbl)
 	       (set (make-local-variable 'mml-buffer-list) mbl1))
-	     ;; LOCAL argument of add-hook differs between GNU Emacs
-	     ;; and XEmacs. make-local-hook makes sure they are local.
-	     (make-local-hook 'kill-buffer-hook)
+	     (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
@@ -3943,77 +3996,78 @@ General format specifiers can also be used.  See Info node
 Replace it with some information about the removed part."
   (interactive)
   (gnus-article-check-buffer)
-  (let* ((data (get-text-property (point) 'gnus-data))
-	 (handles gnus-article-mime-handles)
-	 (none "(none)")
-	 (description
-	  (or
-	   (mail-decode-encoded-word-string (or (mm-handle-description data)
-						none))))
-	 (filename
-	  (or (mail-content-type-get (mm-handle-disposition data) 'filename)
-	      none))
-	 (type (mm-handle-media-type data)))
-    (if (mm-multiple-handles gnus-article-mime-handles)
-	(error "This function is not implemented"))
-    (with-current-buffer (mm-handle-buffer data)
-      (let ((bsize (format "%s" (buffer-size))))
-	(erase-buffer)
-	(insert
-	 (concat
-	  "<#part type=text/plain nofile=yes disposition=attachment"
-	  " description=\"Deleted attachment (" bsize " Byte)\">"
-	  ",----\n"
-	  "| The following attachment has been deleted:\n"
-	  "|\n"
-	  "| Type:           " type "\n"
-	  "| Filename:       " filename "\n"
-	  "| Size (encoded): " bsize " Byte\n"
-	  "| Description:    " description "\n"
-	  "`----\n"
-	  "<#/part>"))
-	(setcdr data
-		(cdr (mm-make-handle nil `("text/plain"))))))
-    (set-buffer gnus-summary-buffer)
-    ;; FIXME: maybe some of the following code (borrowed from
-    ;; `gnus-mime-save-part-and-strip') isn't necessary?
-    (gnus-article-edit-article
-     `(lambda ()
-	(erase-buffer)
-	(let ((mail-parse-charset (or gnus-article-charset
-				      ',gnus-newsgroup-charset))
-	      (mail-parse-ignored-charsets
-	       (or gnus-article-ignored-charsets
-		   ',gnus-newsgroup-ignored-charsets))
-	      (mbl mml-buffer-list))
-	  (setq mml-buffer-list nil)
-	  (insert-buffer gnus-original-article-buffer)
-	  (mime-to-mml ',handles)
-	  (setq gnus-article-mime-handles nil)
-	  (let ((mbl1 mml-buffer-list))
-	    (setq mml-buffer-list mbl)
-	    (set (make-local-variable 'mml-buffer-list) mbl1))
-	  ;; LOCAL argument of add-hook differs between GNU Emacs
-	  ;; and XEmacs. make-local-hook makes sure they are local.
-	  (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))))
+  (unless (and gnus-novice-user
+	       (not (gnus-yes-or-no-p
+		     "Really delete attachment forever? ")))
+    (let* ((data (get-text-property (point) 'gnus-data))
+	   (handles gnus-article-mime-handles)
+	   (none "(none)")
+	   (description
+	    (or
+	     (mail-decode-encoded-word-string (or (mm-handle-description data)
+						  none))))
+	   (filename
+	    (or (mail-content-type-get (mm-handle-disposition data) 'filename)
+		none))
+	   (type (mm-handle-media-type data)))
+      (if (mm-multiple-handles gnus-article-mime-handles)
+	  (error "This function is not implemented"))
+      (with-current-buffer (mm-handle-buffer data)
+	(let ((bsize (format "%s" (buffer-size))))
+	  (erase-buffer)
+	  (insert
+	   (concat
+	    "<#part type=text/plain nofile=yes disposition=attachment"
+	    " description=\"Deleted attachment (" bsize " Byte)\">"
+	    ",----\n"
+	    "| The following attachment has been deleted:\n"
+	    "|\n"
+	    "| Type:           " type "\n"
+	    "| Filename:       " filename "\n"
+	    "| Size (encoded): " bsize " Byte\n"
+	    "| Description:    " description "\n"
+	    "`----\n"
+	    "<#/part>"))
+	  (setcdr data
+		  (cdr (mm-make-handle nil `("text/plain"))))))
+      (set-buffer gnus-summary-buffer)
+      ;; FIXME: maybe some of the following code (borrowed from
+      ;; `gnus-mime-save-part-and-strip') isn't necessary?
+      (gnus-article-edit-article
+       `(lambda ()
+	  (erase-buffer)
+	  (let ((mail-parse-charset (or gnus-article-charset
+					',gnus-newsgroup-charset))
+		(mail-parse-ignored-charsets
+		 (or gnus-article-ignored-charsets
+		     ',gnus-newsgroup-ignored-charsets))
+		(mbl mml-buffer-list))
+	    (setq mml-buffer-list nil)
+	    (insert-buffer gnus-original-article-buffer)
+	    (mime-to-mml ',handles)
+	    (setq gnus-article-mime-handles nil)
+	    (let ((mbl1 mml-buffer-list))
+	      (setq mml-buffer-list mbl)
+	      (set (make-local-variable 'mml-buffer-list) mbl1))
+	    (gnus-make-local-hook 'kill-buffer-hook)
+	    (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t)))
+       `(lambda (no-highlight)
+	  (let ((mail-parse-charset (or gnus-article-charset
+					',gnus-newsgroup-charset))
+		(message-options message-options)
+		(message-options-set-recipient)
+		(mail-parse-ignored-charsets
+		 (or gnus-article-ignored-charsets
+		     ',gnus-newsgroup-ignored-charsets)))
+	    (mml-to-mime)
+	    (mml-destroy-buffers)
+	    (remove-hook 'kill-buffer-hook
+			 'mml-destroy-buffers t)
+	    (kill-local-variable 'mml-buffer-list))
+	  (gnus-summary-edit-article-done
+	   ,(or (mail-header-references gnus-current-headers) "")
+	   ,(gnus-group-read-only-p)
+	   ,gnus-summary-buffer no-highlight)))))
   ;; Not in `gnus-mime-save-part-and-strip':
   (gnus-article-edit-done)
   (gnus-summary-expand-window)
@@ -4101,7 +4155,7 @@ The uncompress method used is derived from `buffer-file-name'."
               (message "%s %s..." message basename))
           (unwind-protect
               (unless (memq (apply 'call-process-region
-                                   (point-min) (point-max) 
+                                   (point-min) (point-max)
                                    prog
                                    t (list t err-file) nil
                                    args)
@@ -4288,7 +4342,8 @@ If no internal viewer is available, use an external viewer."
   (gnus-article-part-wrapper n 'gnus-mime-copy-part))
 
 (defun gnus-article-view-part-as-charset (n)
-  "Copy MIME part N, which is the numerical prefix."
+  "View MIME part N using a specified charset.
+N is the numerical prefix."
   (interactive "p")
   (gnus-article-part-wrapper n 'gnus-mime-view-part-as-charset))
 
@@ -4513,9 +4568,28 @@ If no internal viewer is available, use an external viewer."
 	      (narrow-to-region (point-min) (point))
 	      (gnus-treat-article 'head))))))))
 
-(defvar gnus-mime-display-multipart-as-mixed nil)
-(defvar gnus-mime-display-multipart-alternative-as-mixed nil)
-(defvar gnus-mime-display-multipart-related-as-mixed nil)
+(defcustom gnus-mime-display-multipart-as-mixed nil
+  "Display \"multipart\" parts as  \"multipart/mixed\".
+
+If t, it overrides nil values of
+`gnus-mime-display-multipart-alternative-as-mixed' and
+`gnus-mime-display-multipart-related-as-mixed'."
+  :group 'gnus-article-mime
+  :type 'boolean)
+
+(defcustom gnus-mime-display-multipart-alternative-as-mixed nil
+  "Display \"multipart/alternative\" parts as  \"multipart/mixed\"."
+  :group 'gnus-article-mime
+  :type 'boolean)
+
+(defcustom gnus-mime-display-multipart-related-as-mixed nil
+  "Display \"multipart/related\" parts as  \"multipart/mixed\".
+
+If displaying \"text/html\" is discouraged \(see
+`mm-discouraged-alternatives'\) images or other material inside a
+\"multipart/related\" part might be overlooked when this variable is nil."
+  :group 'gnus-article-mime
+  :type 'boolean)
 
 (defun gnus-mime-display-part (handle)
   (cond
@@ -4816,7 +4890,7 @@ is the string to use when it is inactive.")
   "Delete all images in CATEGORY."
   (let ((entry (assq category gnus-article-image-alist)))
     (dolist (image (cdr entry))
-      (gnus-remove-image image))
+      (gnus-remove-image image category))
     (setq gnus-article-image-alist (delq entry gnus-article-image-alist))
     (gnus-delete-wash-type category)))
 
@@ -4887,14 +4961,31 @@ If given a numerical ARG, move forward ARG pages."
 (defun gnus-article-goto-next-page ()
   "Show the next page of the article."
   (interactive)
-  (gnus-eval-in-buffer-window gnus-summary-buffer
-    (gnus-summary-next-page)))
+  (when (gnus-article-next-page)
+    (goto-char (point-min))
+    (gnus-article-read-summary-keys nil (gnus-character-to-event ?n))))
+
 
 (defun gnus-article-goto-prev-page ()
   "Show the next page of the article."
   (interactive)
-  (gnus-eval-in-buffer-window gnus-summary-buffer
-    (gnus-summary-prev-page)))
+  (if (bobp)
+      (gnus-article-read-summary-keys nil (gnus-character-to-event ?p))
+    (gnus-article-prev-page nil)))
+
+;; This is cleaner but currently breaks `gnus-pick-mode':
+;;
+;; (defun gnus-article-goto-next-page ()
+;;   "Show the next page of the article."
+;;   (interactive)
+;;   (gnus-eval-in-buffer-window gnus-summary-buffer
+;;     (gnus-summary-next-page)))
+;;
+;; (defun gnus-article-goto-prev-page ()
+;;   "Show the next page of the article."
+;;   (interactive)
+;;   (gnus-eval-in-buffer-window gnus-summary-buffer
+;;     (gnus-summary-prev-page)))
 
 (defun gnus-article-next-page (&optional lines)
   "Show the next page of the current article.
@@ -4910,7 +5001,8 @@ Argument LINES specifies lines to be scrolled up."
       (if (or (not gnus-page-broken)
 	      (save-excursion
 		(save-restriction
-		  (widen) (forward-line 1) (eobp)))) ;Real end-of-buffer?
+		  (widen)
+		  (eobp)))) ;Real end-of-buffer?
 	  (progn
 	    (when gnus-article-over-scroll
 	      (gnus-article-next-page-1 lines))
@@ -5534,7 +5626,8 @@ groups."
     (set-window-configuration winconf)
     (set-buffer buf)
     (set-window-start (get-buffer-window buf) start)
-    (set-window-point (get-buffer-window buf) (point))))
+    (set-window-point (get-buffer-window buf) (point)))
+  (gnus-summary-show-article))
 
 (defun gnus-article-edit-exit ()
   "Exit the article editing without updating."
@@ -5555,7 +5648,8 @@ groups."
 	(save-current-buffer
 	  (set-buffer curbuf)
 	  (set-window-start (get-buffer-window (current-buffer)) window-start)
-	  (goto-char p))))))
+	  (goto-char p))))
+    (gnus-summary-show-article)))
 
 (defun gnus-article-edit-full-stops ()
   "Interactively repair spacing at end of sentences."
@@ -5576,8 +5670,8 @@ groups."
 
 (defcustom gnus-button-url-regexp
   (if (string-match "[[:digit:]]" "1") ;; support POSIX?
-      "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|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\\|news\\|telnet\\|wais\\|mailto\\|info\\):\\)\\(//[-a-z0-9_.]+:[0-9]*\\)?\\([-a-z0-9_=!?#$@~%&*+\\/:;.,]\\|\\w\\)+\\([-a-z0-9_=#$@~%&*+\\/]\\|\\w\\)\\)")
+      "\\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\\|nntp\\|news\\|telnet\\|wais\\|mailto\\|info\\):\\)\\(//[-a-z0-9_.]+:[0-9]*\\)?\\([-a-z0-9_=!?#$@~%&*+\\/:;.,]\\|\\w\\)+\\([-a-z0-9_=#$@~%&*+\\/]\\|\\w\\)\\)")
   "Regular expression that matches URLs."
   :group 'gnus-article-buttons
   :type 'regexp)
@@ -5646,7 +5740,7 @@ It should match all directories in the top level of `gnus-ctan-url'."
   "What to do when the button on a string as \"foo123@bar.invalid\" is pushed.
 Strings like this can be either a message ID or a mail address.  If it is one
 of the symbols `mid' or `mail', Gnus will always assume that the string is a
-message ID or a mail address, respectivly.  If this variable is set to the
+message ID or a mail address, respectively.  If this variable is set to the
 symbol `ask', always query the user what do do.  If it is a function, this
 function will be called with the string as it's only argument.  The function
 must return `mid', `mail', `invalid' or `ask'."
@@ -5712,7 +5806,7 @@ must return `mid', `mail', `invalid' or `ask'."
   "An alist of \(RATE . REGEXP\) pairs for `gnus-button-mid-or-mail-heuristic'.
 
 A negative RATE indicates a message IDs, whereas a positive indicates a mail
-address.  The REGEXP is processed with `case-fold-search' set to `nil'."
+address.  The REGEXP is processed with `case-fold-search' set to nil."
   :group 'gnus-article-buttons
   :type '(repeat (cons (number :tag "Rate")
 		       (regexp :tag "Regexp"))))
@@ -5891,7 +5985,7 @@ Calls `describe-variable' or `describe-function'."
   "*Integer that says how many TeX-related buttons Gnus will show.
 The higher the number, the more buttons will appear and the more false
 positives are possible.  Note that you can set this variable local to
-specifific groups.  Setting it higher in TeX groups is probably a good idea.
+specific groups.  Setting it higher in TeX groups is probably a good idea.
 See Info node `(gnus)Group Parameters' and the variable `gnus-parameters' on
 how to set variables in specific groups."
   :group 'gnus-article-buttons
@@ -5902,7 +5996,7 @@ how to set variables in specific groups."
   "*Integer that says how many man-related buttons Gnus will show.
 The higher the number, the more buttons will appear and the more false
 positives are possible.  Note that you can set this variable local to
-specifific groups.  Setting it higher in Unix groups is probably a good idea.
+specific groups.  Setting it higher in Unix groups is probably a good idea.
 See Info node `(gnus)Group Parameters' and the variable `gnus-parameters' on
 how to set variables in specific groups."
   :group 'gnus-article-buttons
@@ -5913,7 +6007,7 @@ how to set variables in specific groups."
   "*Integer that says how many emacs-related buttons Gnus will show.
 The higher the number, the more buttons will appear and the more false
 positives are possible.  Note that you can set this variable local to
-specifific groups.  Setting it higher in Emacs or Gnus related groups is
+specific groups.  Setting it higher in Emacs or Gnus related groups is
 probably a good idea.  See Info node `(gnus)Group Parameters' and the variable
 `gnus-parameters' on how to set variables in specific groups."
   :group 'gnus-article-buttons
@@ -5941,9 +6035,9 @@ positives are possible."
      0 (>= gnus-button-message-level 0) gnus-button-handle-news 3)
     ("\\b\\(nntp\\|news\\):\\([^>\n\t ]*@[^>)!;:,\n\t ]*\\)" 0 t
      gnus-button-handle-news 2)
-    ("\\(\\b<\\(url:[>\n\t ]*\\)?\\(news\\|nntp\\):[>\n\t ]*\\(//\\)?\\([^>\n\t ]*\\)>\\)"
+    ("\\(\\b<\\(url:[>\n\t ]*\\)?\\(nntp\\|news\\):[>\n\t ]*\\(//\\)?\\([^>\n\t ]*\\)>\\)"
      1 (>= gnus-button-message-level 0) gnus-button-fetch-group 5)
-    ("\\b\\(news\\|nntp\\):\\(//\\)?\\([^'\">\n\t ]+\\)"
+    ("\\b\\(nntp\\|news\\):\\(//\\)?\\([^'\">\n\t ]+\\)"
      0 (>= gnus-button-message-level 0) gnus-button-fetch-group 3)
     ("\\bin\\( +article\\| +message\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)"
      2 (>= gnus-button-message-level 0) gnus-button-message-id 3)
@@ -5954,7 +6048,9 @@ positives are possible."
     ("\\bmailto:\\([^ \n\t]+\\)"
      0 (>= gnus-button-message-level 0) gnus-url-mailto 1)
     ;; CTAN
-    ("\\bCTAN:[ \t\n]*\\([^>)!;:,'\n\t ]*\\)"
+    ((concat "\\bCTAN:[ \t\n]?[^>)!;:,'\n\t ]*\\("
+	     gnus-button-ctan-directory-regexp
+	     "[^][>)!;:,'\n\t ]+\\)")
      0 (>= gnus-button-tex-level 1) gnus-button-handle-ctan 1)
     ((concat "\\btex-archive/\\("
 	     gnus-button-ctan-directory-regexp
@@ -5965,9 +6061,15 @@ positives are possible."
       gnus-button-ctan-directory-regexp
       "/[-_.a-z0-9]+/[-_./a-z0-9]+[/a-z0-9]\\)")
      1 (>= gnus-button-tex-level 8) gnus-button-handle-ctan 1)
-    ;; This is info
-    ("\\binfo:\\(//\\)?\\([^'\">\n\t ]+\\)"
-     0 (>= gnus-button-emacs-level 1) gnus-button-handle-info-url 2)
+    ;; This is info (home-grown style) <info://foo/bar+baz>
+    ("\\binfo://\\([^'\">\n\t ]+\\)"
+     0 (>= gnus-button-emacs-level 1) gnus-button-handle-info-url 1)
+    ;; Info GNOME style <info:foo#bar_baz>
+    ("\\binfo:\\([^('\n\t\r \"><][^'\n\t\r \"><]*\\)"
+     0 (>= gnus-button-emacs-level 1) gnus-button-handle-info-url-gnome 1)
+    ;; Info KDE style <info:(foo)bar baz>
+    ("<\\(info:\\(([^)]+)[^>\n\r]*\\)\\)>"
+     1 (>= gnus-button-emacs-level 1) gnus-button-handle-info-url-kde 2)
     ("\\((Info-goto-node\\|(info\\)[ \t\n]*\\(\"[^\"]*\"\\))" 0
      (>= 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"
@@ -5994,9 +6096,9 @@ positives are possible."
      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-z]+-[-a-z]+\\|\\(gnus\\|message\\)-[-a-z]+\\)'"
+    ("`\\([a-z][a-z0-9]+-[a-z]+-[-a-z]+\\|\\(gnus\\|message\\)-[-a-z]+\\)'"
      0 (>= gnus-button-emacs-level 8) gnus-button-handle-symbol 1)
-    ("`\\([a-z]+-[a-z]+\\)'"
+    ("`\\([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)
@@ -6024,7 +6126,7 @@ positives are possible."
      gnus-button-handle-man 1)
     ;; even more: Apache::PerlRun(3pm), PDL::IO::FastRaw(3pm),
     ;; SoWWWAnchor(3iv), XSelectInput(3X11), X(1), X(7)
-    ("\\b\\([a-z][-_.:a-z0-9]+\\)([1-9][X1a-z]*)\\W\\|\\b\\(X\\)([1-9])\\W"
+    ("\\b\\([a-z][-+_.:a-z0-9]+\\)([1-9][X1a-z]*)\\W\\|\\b\\(X\\)([1-9])\\W"
      0 (>= gnus-button-man-level 5) gnus-button-handle-man 1)
     ;; MID or mail: To avoid too many false positives we don't try to catch
     ;; all kind of allowed MIDs or mail addresses.  Domain part must contain
@@ -6037,9 +6139,9 @@ positives are possible."
 
 Each entry has the form (REGEXP BUTTON FORM CALLBACK PAR...), where
 REGEXP: is the string (case insensitive) matching text around the button (can
-also be lisp expression evaluating to a string),
+also be Lisp expression evaluating to a string),
 BUTTON: is the number of the regexp grouping actually matching the button,
-FORM: is a lisp expression which must eval to true for the button to
+FORM: is a Lisp expression which must eval to true for the button to
 be added,
 CALLBACK: is the function to call when the user push this button, and each
 PAR: is a number of a regexp grouping whose text will be passed to CALLBACK.
@@ -6047,7 +6149,7 @@ PAR: is a number of a regexp grouping whose text will be passed to CALLBACK.
 CALLBACK can also be a variable, in that case the value of that
 variable it the real callback function."
   :group 'gnus-article-buttons
-  :type '(repeat (list (choice regexp variable)
+  :type '(repeat (list (choice regexp variable sexp)
 		       (integer :tag "Button")
 		       (sexp :tag "Form")
 		       (function :tag "Callback")
@@ -6056,7 +6158,7 @@ variable it the real callback function."
 			       (integer :tag "Regexp group")))))
 
 (defcustom gnus-header-button-alist
-  '(("^\\(References\\|Message-I[Dd]\\):" "<[^<>]+>"
+  '(("^\\(References\\|Message-I[Dd]\\|^In-Reply-To\\):" "<[^<>]+>"
      0 (>= gnus-button-message-level 0) gnus-button-message-id 0)
     ("^\\(From\\|Reply-To\\):" ": *\\(.+\\)$"
      1 (>= gnus-button-message-level 0) gnus-button-reply 1)
@@ -6070,7 +6172,7 @@ variable it the real callback function."
      0 (>= gnus-button-browse-level 0) browse-url 0)
     ("^[^:]+:" "\\bmailto:\\([-a-z.@_+0-9%=?]+\\)"
      0 (>= gnus-button-message-level 0) gnus-url-mailto 1)
-    ("^[^:]+:" "\\(<\\(url: \\)?\\(news\\|nntp\\):\\([^>\n ]*\\)>\\)"
+    ("^[^:]+:" "\\(<\\(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.
 
@@ -6084,7 +6186,7 @@ HEADER is a regexp to match a header.  For a fuller explanation, see
   :group 'gnus-article-buttons
   :group 'gnus-article-headers
   :type '(repeat (list (regexp :tag "Header")
-		       regexp
+		       (choice regexp variable)
 		       (integer :tag "Button")
 		       (sexp :tag "Form")
 		       (function :tag "Callback")
@@ -6417,6 +6519,7 @@ specified by `gnus-button-alist'."
 
 (defun gnus-button-handle-info-url (url)
   "Fetch an info URL."
+  (setq url (mm-subst-char-in-string ?+ ?\  url))
   (cond
    ((string-match "^\\([^:/]+\\)?/\\(.*\\)" url)
     (gnus-info-find-node
@@ -6430,6 +6533,24 @@ specified by `gnus-button-alist'."
     (gnus-info-find-node url))
    (t (error "Can't parse %s" url))))
 
+(defun gnus-button-handle-info-url-gnome (url)
+  "Fetch GNOME style info URL."
+  (setq url (mm-subst-char-in-string ?_ ?\  url))
+  (if (string-match "\\([^#]+\\)#?\\(.*\\)" url)
+      (gnus-info-find-node
+       (concat "("
+	       (gnus-url-unhex-string 
+		 (match-string 1 url))
+	       ")"
+	       (or (gnus-url-unhex-string 
+		    (match-string 2 url))
+		   "Top")))
+    (error "Can't parse %s" url)))
+
+(defun gnus-button-handle-info-url-kde (url)
+  "Fetch KDE style info URL."
+  (gnus-info-find-node (gnus-url-unhex-string url)))
+
 (defun gnus-button-handle-info-keystrokes (url)
   "Call `info' when pushing the corresponding URL button."
   ;; For links like `C-h i d m gnus RET', `C-h i d m CC Mode RET'.
@@ -6612,7 +6733,7 @@ specified by `gnus-button-alist'."
 
 This variable is a list of FUNCTION or (REGEXP . FUNCTION).  If item
 is FUNCTION, FUNCTION will be apply to all newsgroups.  If item is a
-\(REGEXP . FUNCTION), FUNCTION will be only apply to thes newsgroups
+\(REGEXP . FUNCTION), FUNCTION will be only apply to the newsgroups
 whose names match REGEXP.
 
 For example: