projects / gnus / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Add "Keywords: comm", as per net/net-utils.el, by Kevin Ryde.
[gnus] / lisp / gnus-art.el
diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el
index 9db4408..fa13947 100644 (file)
--- a/lisp/gnus-art.el
+++ b/lisp/gnus-art.el
@@ -1,17 +1,17 @@
 ;;; gnus-art.el --- article mode commands for Gnus
 
 ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
 ;;; gnus-art.el --- article mode commands for Gnus
 
 ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;;   2005, 2006, 2007 Free Software Foundation, Inc.
+;;   2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news
 
 ;; This file is part of GNU Emacs.
 
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news
 
 ;; This file is part of GNU Emacs.
 
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -19,18 +19,19 @@
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
 ;;; Code:
 
 
 ;;; Commentary:
 
 ;;; Code:
 
+;; For Emacs < 22.2.
+(eval-and-compile
+  (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
 (eval-when-compile
 (eval-when-compile
-  (require 'cl)
-  (defvar tool-bar-map)
-  (defvar w3m-minor-mode-map))
+  (require 'cl))
+(defvar tool-bar-map)
+(defvar w3m-minor-mode-map)
 
 (require 'gnus)
 ;; Avoid the "Recursive load suspected" error in Emacs 21.1.
 
 (require 'gnus)
 ;; Avoid the "Recursive load suspected" error in Emacs 21.1.
@@ -175,12 +176,15 @@ If `gnus-visible-headers' is non-nil, this variable will be ignored."
   "*All headers that do not match this regexp will be hidden.
 This variable can also be a list of regexp of headers to remain visible.
 If this variable is non-nil, `gnus-ignored-headers' will be ignored."
   "*All headers that do not match this regexp will be hidden.
 This variable can also be a list of regexp of headers to remain visible.
 If this variable is non-nil, `gnus-ignored-headers' will be ignored."
-  :type '(repeat :value-to-internal (lambda (widget value)
-                                     (custom-split-regexp-maybe value))
-                :match (lambda (widget value)
-                         (or (stringp value)
-                             (widget-editable-list-match widget value)))
-                regexp)
+  :type '(choice
+         (repeat :value-to-internal (lambda (widget value)
+                                      (custom-split-regexp-maybe value))
+                 :match (lambda (widget value)
+                          (or (stringp value)
+                              (widget-editable-list-match widget value)))
+                 regexp)
+         (const :tag "Use gnus-ignored-headers" nil)
+         regexp)
   :group 'gnus-article-hiding)
 
 (defcustom gnus-sorted-header-list
   :group 'gnus-article-hiding)
 
 (defcustom gnus-sorted-header-list
@@ -533,6 +537,7 @@ that the symbol of the saver function, which is specified by
   :group 'gnus-article-saving
   :type 'regexp)
 
   :group 'gnus-article-saving
   :type 'regexp)
 
+;; Note that "Rmail format" is mbox since Emacs 23, but Babyl before.
 (defcustom gnus-default-article-saver 'gnus-summary-save-in-rmail
   "A function to save articles in your favourite format.
 The function will be called by way of the `gnus-summary-save-article'
 (defcustom gnus-default-article-saver 'gnus-summary-save-in-rmail
   "A function to save articles in your favourite format.
 The function will be called by way of the `gnus-summary-save-article'
@@ -548,13 +553,15 @@ Gnus provides the following functions:
 * gnus-summary-save-in-vm (use VM's folder format)
 * gnus-summary-write-to-file (article format -- overwrite)
 * gnus-summary-write-body-to-file (article body -- overwrite)
 * gnus-summary-save-in-vm (use VM's folder format)
 * gnus-summary-write-to-file (article format -- overwrite)
 * gnus-summary-write-body-to-file (article body -- overwrite)
+* gnus-summary-save-in-pipe (article format)
 
 The symbol of each function may have the following properties:
 
 * :decode
 The value non-nil means save decoded articles.  This is meaningful
 only with `gnus-summary-save-in-file', `gnus-summary-save-body-in-file',
 
 The symbol of each function may have the following properties:
 
 * :decode
 The value non-nil means save decoded articles.  This is meaningful
 only with `gnus-summary-save-in-file', `gnus-summary-save-body-in-file',
-`gnus-summary-write-to-file', and `gnus-summary-write-body-to-file'.
+`gnus-summary-write-to-file', `gnus-summary-write-body-to-file', and
+`gnus-summary-save-in-pipe'.
 
 * :function
 The value specifies an alternative function which appends, not
 
 * :function
 The value specifies an alternative function which appends, not
@@ -577,6 +584,7 @@ headers should be saved."
                (function-item gnus-summary-save-in-vm)
                (function-item gnus-summary-write-to-file)
                (function-item gnus-summary-write-body-to-file)
                (function-item gnus-summary-save-in-vm)
                (function-item gnus-summary-write-to-file)
                (function-item gnus-summary-write-body-to-file)
+               (function-item gnus-summary-save-in-pipe)
                (function)))
 
 (defcustom gnus-article-save-coding-system
                (function)))
 
 (defcustom gnus-article-save-coding-system
@@ -715,12 +723,12 @@ The following additional specs are available:
 (defcustom gnus-copy-article-ignored-headers nil
   "List of headers to be removed when copying an article.
 Each element is a regular expression."
 (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
+  :version "23.1" ;; No Gnus
   :type '(repeat regexp)
   :group 'gnus-article-various)
 
   :type '(repeat regexp)
   :group 'gnus-article-various)
 
-(make-obsolete-variable 'gnus-article-hide-pgp-hook
-                       "This variable is obsolete in Gnus 5.10.")
+(make-obsolete-variable 'gnus-article-hide-pgp-hook nil
+                       "Gnus 5.10 (Emacs-22.1)")
 
 (defface gnus-button
   '((t (:weight bold)))
 
 (defface gnus-button
   '((t (:weight bold)))
@@ -758,6 +766,7 @@ Obsolete; use the face `gnus-signature' for customizations instead."
   :group 'gnus-article-signature)
 ;; backward-compatibility alias
 (put 'gnus-signature-face 'face-alias 'gnus-signature)
   :group 'gnus-article-signature)
 ;; backward-compatibility alias
 (put 'gnus-signature-face 'face-alias 'gnus-signature)
+(put 'gnus-signature-face 'obsolete-face "22.1")
 
 (defface gnus-header-from
   '((((class color)
 
 (defface gnus-header-from
   '((((class color)
@@ -773,6 +782,7 @@ Obsolete; use the face `gnus-signature' for customizations instead."
   :group 'gnus-article-highlight)
 ;; backward-compatibility alias
 (put 'gnus-header-from-face 'face-alias 'gnus-header-from)
   :group 'gnus-article-highlight)
 ;; backward-compatibility alias
 (put 'gnus-header-from-face 'face-alias 'gnus-header-from)
+(put 'gnus-header-from-face 'obsolete-face "22.1")
 
 (defface gnus-header-subject
   '((((class color)
 
 (defface gnus-header-subject
   '((((class color)
@@ -788,6 +798,7 @@ Obsolete; use the face `gnus-signature' for customizations instead."
   :group 'gnus-article-highlight)
 ;; backward-compatibility alias
 (put 'gnus-header-subject-face 'face-alias 'gnus-header-subject)
   :group 'gnus-article-highlight)
 ;; backward-compatibility alias
 (put 'gnus-header-subject-face 'face-alias 'gnus-header-subject)
+(put 'gnus-header-subject-face 'obsolete-face "22.1")
 
 (defface gnus-header-newsgroups
   '((((class color)
 
 (defface gnus-header-newsgroups
   '((((class color)
@@ -805,6 +816,7 @@ articles."
   :group 'gnus-article-highlight)
 ;; backward-compatibility alias
 (put 'gnus-header-newsgroups-face 'face-alias 'gnus-header-newsgroups)
   :group 'gnus-article-highlight)
 ;; backward-compatibility alias
 (put 'gnus-header-newsgroups-face 'face-alias 'gnus-header-newsgroups)
+(put 'gnus-header-newsgroups-face 'obsolete-face "22.1")
 
 (defface gnus-header-name
   '((((class color)
 
 (defface gnus-header-name
   '((((class color)
@@ -820,6 +832,7 @@ articles."
   :group 'gnus-article-highlight)
 ;; backward-compatibility alias
 (put 'gnus-header-name-face 'face-alias 'gnus-header-name)
   :group 'gnus-article-highlight)
 ;; backward-compatibility alias
 (put 'gnus-header-name-face 'face-alias 'gnus-header-name)
+(put 'gnus-header-name-face 'obsolete-face "22.1")
 
 (defface gnus-header-content
   '((((class color)
 
 (defface gnus-header-content
   '((((class color)
@@ -834,6 +847,7 @@ articles."
   :group 'gnus-article-highlight)
 ;; backward-compatibility alias
 (put 'gnus-header-content-face 'face-alias 'gnus-header-content)
   :group 'gnus-article-highlight)
 ;; backward-compatibility alias
 (put 'gnus-header-content-face 'face-alias 'gnus-header-content)
+(put 'gnus-header-content-face 'obsolete-face "22.1")
 
 (defcustom gnus-header-face-alist
   '(("From" nil gnus-header-from)
 
 (defcustom gnus-header-face-alist
   '(("From" nil gnus-header-from)
@@ -882,7 +896,7 @@ 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."
 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
+  :version "23.1" ;; No Gnus
   :group 'gnus-article-headers
   :type '(repeat (cons :format "%v" (symbol :tag "Image type") plist)))
 
   :group 'gnus-article-headers
   :type '(repeat (cons :format "%v" (symbol :tag "Image type") plist)))
 
@@ -1054,7 +1068,7 @@ used."
 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."
 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
+  :version "23.1" ;; No Gnus
   :group 'gnus-article-mime
   :type '(choice (const nil :tag "Redisplay article.")
                 (const 1 :tag "Next part.")
   :group 'gnus-article-mime
   :type '(choice (const nil :tag "Redisplay article.")
                 (const 1 :tag "Next part.")
@@ -1116,10 +1130,7 @@ predicate.  See Info node `(gnus)Customizing Articles'."
   :type gnus-article-treat-head-custom)
 (put 'gnus-treat-buttonize-head 'highlight t)
 
   :type gnus-article-treat-head-custom)
 (put 'gnus-treat-buttonize-head 'highlight t)
 
-(defcustom gnus-treat-emphasize
-  (and (or window-system
-          (featurep 'xemacs))
-       50000)
+(defcustom gnus-treat-emphasize 50000
   "Emphasize text.
 Valid values are nil, t, `head', `first', `last', an integer or a
 predicate.  See Info node `(gnus)Customizing Articles'."
   "Emphasize text.
 Valid values are nil, t, `head', `first', `last', an integer or a
 predicate.  See Info node `(gnus)Customizing Articles'."
@@ -1212,8 +1223,8 @@ predicate.  See Info node `(gnus)Customizing Articles'."
   :link '(custom-manual "(gnus)Customizing Articles")
   :type gnus-article-treat-custom)
 
   :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.")
+(make-obsolete-variable 'gnus-treat-strip-pgp nil
+                       "Gnus 5.10 (Emacs 22.1)")
 
 (defcustom gnus-treat-strip-pem nil
   "Strip PEM signatures.
 
 (defcustom gnus-treat-strip-pem nil
   "Strip PEM signatures.
@@ -1362,7 +1373,7 @@ 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."
 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
+  :version "23.1" ;; No Gnus
   :group 'gnus-article-treat
   :type '(choice (const nil)
                 (const :tag "all" t)
   :group 'gnus-article-treat
   :type '(choice (const nil)
                 (const :tag "all" t)
@@ -1404,7 +1415,7 @@ predicate.  See Info node `(gnus)Customizing Articles'."
   :type gnus-article-treat-custom)
 
 (make-obsolete-variable 'gnus-treat-display-xface
   :type gnus-article-treat-custom)
 
 (make-obsolete-variable 'gnus-treat-display-xface
-                       'gnus-treat-display-x-face)
+                       'gnus-treat-display-x-face "22.1")
 
 (defcustom gnus-treat-display-x-face
   (and (not noninteractive)
 
 (defcustom gnus-treat-display-x-face
   (and (not noninteractive)
@@ -1449,7 +1460,7 @@ See Info node `(gnus)Customizing Articles' and Info node
   "Display Face headers.
 Valid values are nil, t, `head', `first', `last', an integer or a
 predicate.  See Info node `(gnus)Customizing Articles' and Info
   "Display Face headers.
 Valid values are nil, t, `head', `first', `last', an integer or a
 predicate.  See Info node `(gnus)Customizing Articles' and Info
-node `(gnus)X-Face' for details."
+node `(gnus)Face' for details."
   :group 'gnus-article-treat
   :version "22.1"
   :link '(custom-manual "(gnus)Customizing Articles")
   :group 'gnus-article-treat
   :version "22.1"
   :link '(custom-manual "(gnus)Customizing Articles")
@@ -1518,11 +1529,12 @@ node `(gnus)Picons' for details."
 (put 'gnus-treat-newsgroups-picon 'highlight t)
 
 (defcustom gnus-treat-body-boundary
 (put 'gnus-treat-newsgroups-picon 'highlight t)
 
 (defcustom gnus-treat-body-boundary
-  (if (and (eq window-system 'x)
-          (or gnus-treat-newsgroups-picon
-              gnus-treat-mail-picon
-              gnus-treat-from-picon))
-      'head nil)
+  (if (or gnus-treat-newsgroups-picon
+         gnus-treat-mail-picon
+         gnus-treat-from-picon)
+      ;; If there's much decoration, the user might prefer a boundery.
+      '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."
   "Draw a boundary at the end of the headers.
 Valid values are nil and `head'.
 See Info node `(gnus)Customizing Articles' for details."
@@ -1699,11 +1711,6 @@ Initialized from `text-mode-syntax-table.")
 
 (defvar gnus-save-article-buffer nil)
 
 
 (defvar gnus-save-article-buffer nil)
 
-(defvar gnus-article-mode-line-format-alist
-  (nconc '((?w (gnus-article-wash-status) ?s)
-          (?m (gnus-article-mime-part-status) ?s))
-        gnus-summary-mode-line-format-alist))
-
 (defvar gnus-number-of-articles-to-be-saved nil)
 
 (defvar gnus-inhibit-hiding nil)
 (defvar gnus-number-of-articles-to-be-saved nil)
 
 (defvar gnus-inhibit-hiding nil)
@@ -1713,8 +1720,7 @@ Initialized from `text-mode-syntax-table.")
 ;;; Macros for dealing with the article buffer.
 
 (defmacro gnus-with-article-headers (&rest forms)
 ;;; Macros for dealing with the article buffer.
 
 (defmacro gnus-with-article-headers (&rest forms)
-  `(save-excursion
-     (set-buffer gnus-article-buffer)
+  `(with-current-buffer gnus-article-buffer
      (save-restriction
        (let ((inhibit-read-only t)
             (inhibit-point-motion-hooks t)
      (save-restriction
        (let ((inhibit-read-only t)
             (inhibit-point-motion-hooks t)
@@ -1726,8 +1732,7 @@ Initialized from `text-mode-syntax-table.")
 (put 'gnus-with-article-headers 'edebug-form-spec '(body))
 
 (defmacro gnus-with-article-buffer (&rest forms)
 (put 'gnus-with-article-headers 'edebug-form-spec '(body))
 
 (defmacro gnus-with-article-buffer (&rest forms)
-  `(save-excursion
-     (set-buffer gnus-article-buffer)
+  `(with-current-buffer gnus-article-buffer
      (let ((inhibit-read-only t))
        ,@forms)))
 
      (let ((inhibit-read-only t))
        ,@forms)))
 
@@ -2224,11 +2229,11 @@ unfolded."
        (mail-header-fold-field)
        (goto-char (point-max))))))
 
        (mail-header-fold-field)
        (goto-char (point-max))))))
 
-(defcustom gnus-article-truncate-lines default-truncate-lines
+(defcustom gnus-article-truncate-lines (default-value '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'."
   "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
+  :version "23.1" ;; No Gnus
   :group 'gnus-article
   ;; :link '(custom-manual "(gnus)Customizing Articles")
   :type 'boolean)
   :group 'gnus-article
   ;; :link '(custom-manual "(gnus)Customizing Articles")
   :type 'boolean)
@@ -2237,7 +2242,7 @@ predicate.  See Info node `(gnus)Customizing Articles'."
   "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
   "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."
+long lines if and only if arg is positive."
   (interactive "P")
   (cond
    ((and (numberp arg) (> arg 0))
   (interactive "P")
   (cond
    ((and (numberp arg) (> arg 0))
@@ -2334,12 +2339,11 @@ long lines iff arg is positive."
         (forward-line 1)
         (point))))))
 
         (forward-line 1)
         (point))))))
 
-(eval-when-compile
-  (defvar gnus-face-properties-alist))
+(defvar gnus-face-properties-alist)
 
 
-(defun article-display-face ()
+(defun article-display-face (&optional force)
   "Display any Face headers in the header."
   "Display any Face headers in the header."
-  (interactive)
+  (interactive (list 'force))
   (let ((wash-face-p buffer-read-only))
     (gnus-with-article-headers
       ;; When displaying parts, this function can be called several times on
   (let ((wash-face-p buffer-read-only))
     (gnus-with-article-headers
       ;; When displaying parts, this function can be called several times on
@@ -2349,7 +2353,8 @@ long lines iff arg is positive."
       ;; read-only.
       (if (and wash-face-p (memq 'face gnus-article-wash-types))
          (gnus-delete-images 'face)
       ;; read-only.
       (if (and wash-face-p (memq 'face gnus-article-wash-types))
          (gnus-delete-images 'face)
-       (let (face faces from)
+       (let ((from (message-fetch-field "from"))
+             face faces)
          (save-current-buffer
            (when (and wash-face-p
                       (gnus-buffer-live-p gnus-original-article-buffer)
          (save-current-buffer
            (when (and wash-face-p
                       (gnus-buffer-live-p gnus-original-article-buffer)
@@ -2357,16 +2362,22 @@ long lines iff arg is positive."
              (set-buffer gnus-original-article-buffer))
            (save-restriction
              (mail-narrow-to-head)
              (set-buffer gnus-original-article-buffer))
            (save-restriction
              (mail-narrow-to-head)
-             (while (gnus-article-goto-header "Face")
-               (push (mail-header-field-value) faces))))
+             (when (or force
+                       ;; Check whether this face is censored.
+                       (not (and gnus-article-x-face-too-ugly
+                                 (or from
+                                     (setq from (message-fetch-field "from")))
+                                 (string-match gnus-article-x-face-too-ugly
+                                               from))))
+               (while (gnus-article-goto-header "Face")
+                 (push (mail-header-field-value) faces)))))
          (when faces
            (goto-char (point-min))
          (when faces
            (goto-char (point-min))
-           (let ((from (gnus-article-goto-header "from"))
-                 png image)
-             (unless from
+           (let (png image)
+             (unless (setq from (gnus-article-goto-header "from"))
                (insert "From:")
                (setq from (point))
                (insert "From:")
                (setq from (point))
-               (insert "[no `from' set]\n"))
+               (insert " [no `from' set]\n"))
              (while faces
                (when (setq png (gnus-convert-face-to-png (pop faces)))
                  (setq image
              (while faces
                (when (setq png (gnus-convert-face-to-png (pop faces)))
                  (setq image
@@ -2391,7 +2402,8 @@ long lines iff arg is positive."
          ;; instead.
          (gnus-delete-images 'xface)
        ;; Display X-Faces.
          ;; instead.
          (gnus-delete-images 'xface)
        ;; Display X-Faces.
-       (let (x-faces from face)
+       (let ((from (message-fetch-field "from"))
+             x-faces face)
          (save-current-buffer
            (when (and wash-face-p
                       (gnus-buffer-live-p gnus-original-article-buffer)
          (save-current-buffer
            (when (and wash-face-p
                       (gnus-buffer-live-p gnus-original-article-buffer)
@@ -2402,43 +2414,41 @@ long lines iff arg is positive."
              (set-buffer gnus-original-article-buffer))
            (save-restriction
              (mail-narrow-to-head)
              (set-buffer gnus-original-article-buffer))
            (save-restriction
              (mail-narrow-to-head)
-             (while (gnus-article-goto-header "X-Face")
-               (push (mail-header-field-value) x-faces))
-             (setq from (message-fetch-field "from"))))
-         ;; Sending multiple EOFs to xv doesn't work, so we only do a
-         ;; single external face.
-         (when (stringp gnus-article-x-face-command)
-           (setq x-faces (list (car x-faces))))
-         (when (and x-faces
-                    gnus-article-x-face-command
-                    (or force
-                        ;; Check whether this face is censored.
-                        (not gnus-article-x-face-too-ugly)
-                        (and from
-                             (not (string-match gnus-article-x-face-too-ugly
-                                                from)))))
-           (while (setq face (pop x-faces))
-             ;; We display the face.
-             (cond ((stringp gnus-article-x-face-command)
-                    ;; The command is a string, so we interpret the command
-                    ;; as a, well, command, and fork it off.
-                    (let ((process-connection-type nil))
-                      (gnus-set-process-query-on-exit-flag
-                       (start-process
-                        "article-x-face" nil shell-file-name
-                        shell-command-switch gnus-article-x-face-command)
-                       nil)
-                      (with-temp-buffer
-                        (insert face)
-                        (process-send-region "article-x-face"
-                                             (point-min) (point-max)))
-                      (process-send-eof "article-x-face")))
-                   ((functionp gnus-article-x-face-command)
-                    ;; The command is a lisp function, so we call it.
-                    (funcall gnus-article-x-face-command face))
-                   (t
-                    (error "%s is not a function"
-                           gnus-article-x-face-command))))))))))
+             (and gnus-article-x-face-command
+                  (or force
+                      ;; Check whether this face is censored.
+                      (not (and gnus-article-x-face-too-ugly
+                                (or from
+                                    (setq from (message-fetch-field "from")))
+                                (string-match gnus-article-x-face-too-ugly
+                                              from))))
+                  (while (gnus-article-goto-header "X-Face")
+                    (push (mail-header-field-value) x-faces)))))
+         (when x-faces
+           ;; We display the face.
+           (cond ((functionp gnus-article-x-face-command)
+                  ;; The command is a lisp function, so we call it.
+                  (mapc gnus-article-x-face-command x-faces))
+                 ((stringp gnus-article-x-face-command)
+                  ;; The command is a string, so we interpret the command
+                  ;; as a, well, command, and fork it off.
+                  (let ((process-connection-type nil))
+                    (gnus-set-process-query-on-exit-flag
+                     (start-process
+                      "article-x-face" nil shell-file-name
+                      shell-command-switch gnus-article-x-face-command)
+                     nil)
+                    ;; Sending multiple EOFs to xv doesn't work,
+                    ;; so we only do a single external face.
+                    (with-temp-buffer
+                      (insert (car x-faces))
+                      (process-send-region "article-x-face"
+                                           (point-min) (point-max)))
+                    (process-send-eof "article-x-face")))
+                 (t
+                  (error "`%s' set to `%s' is not a function"
+                         gnus-article-x-face-command
+                         'gnus-article-x-face-command)))))))))
 
 (defun article-decode-mime-words ()
   "Decode all MIME-encoded words in the article."
 
 (defun article-decode-mime-words ()
   "Decode all MIME-encoded words in the article."
@@ -2702,6 +2712,9 @@ charset defined in `gnus-summary-show-article-charset-alist' is used."
             (t
              (apply (car func) (cdr func))))))))))
 
             (t
              (apply (car func) (cdr func))))))))))
 
+;; External.
+(declare-function w3-region "ext:w3-display" (st nd))
+
 (defun gnus-article-wash-html-with-w3 ()
   "Wash the current buffer with w3."
   (mm-setup-w3)
 (defun gnus-article-wash-html-with-w3 ()
   "Wash the current buffer with w3."
   (mm-setup-w3)
@@ -2713,22 +2726,44 @@ charset defined in `gnus-summary-show-article-charset-alist' is used."
        (w3-region (point-min) (point-max))
       (error))))
 
        (w3-region (point-min) (point-max))
       (error))))
 
+;; External.
+(declare-function w3m-region "ext:w3m" (start end &optional url charset))
+
 (defun gnus-article-wash-html-with-w3m ()
   "Wash the current buffer with emacs-w3m."
   (mm-setup-w3m)
   (let ((w3m-safe-url-regexp mm-w3m-safe-url-regexp)
        w3m-force-redisplay)
     (w3m-region (point-min) (point-max)))
 (defun gnus-article-wash-html-with-w3m ()
   "Wash the current buffer with emacs-w3m."
   (mm-setup-w3m)
   (let ((w3m-safe-url-regexp mm-w3m-safe-url-regexp)
        w3m-force-redisplay)
     (w3m-region (point-min) (point-max)))
+  ;; Put the mark meaning this part was rendered by emacs-w3m.
+  (put-text-property (point-min) (point-max) 'mm-inline-text-html-with-w3m t)
   (when (and mm-inline-text-html-with-w3m-keymap
             (boundp 'w3m-minor-mode-map)
             w3m-minor-mode-map)
   (when (and mm-inline-text-html-with-w3m-keymap
             (boundp 'w3m-minor-mode-map)
             w3m-minor-mode-map)
-    (add-text-properties
-     (point-min) (point-max)
-     (list 'keymap w3m-minor-mode-map
-          ;; Put the mark meaning this part was rendered by emacs-w3m.
-          'mm-inline-text-html-with-w3m t))))
-
-(eval-when-compile (defvar charset)) ;; Bound by `article-wash-html'.
+    (if (and (boundp 'w3m-link-map)
+            w3m-link-map)
+       (let* ((start (point-min))
+              (end (point-max))
+              (on (get-text-property start 'w3m-href-anchor))
+              (map (copy-keymap w3m-link-map))
+              next)
+         (set-keymap-parent map w3m-minor-mode-map)
+         (while (< start end)
+           (if on
+               (progn
+                 (setq next (or (text-property-any start end
+                                                   'w3m-href-anchor nil)
+                                end))
+                 (put-text-property start next 'keymap map))
+             (setq next (or (text-property-not-all start end
+                                                   'w3m-href-anchor nil)
+                            end))
+             (put-text-property start next 'keymap w3m-minor-mode-map))
+           (setq start next
+                 on (not on))))
+      (put-text-property (point-min) (point-max) 'keymap w3m-minor-mode-map))))
+
+(defvar charset) ;; Bound by `article-wash-html'.
 
 (defun gnus-article-wash-html-with-w3m-standalone ()
   "Wash the current buffer with w3m."
 
 (defun gnus-article-wash-html-with-w3m-standalone ()
   "Wash the current buffer with w3m."
@@ -2756,7 +2791,7 @@ 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
 on each file, if it is `ask' ask once when exiting from the
 summary buffer."
   :group 'gnus-article
-  :version "23.0" ;; No Gnus
+  :version "23.1" ;; No Gnus
   :type '(choice (const :tag "Don't delete" nil)
                 (const :tag "Don't ask" t)
                 (const :tag "Ask" ask)
   :type '(choice (const :tag "Don't delete" nil)
                 (const :tag "Don't ask" t)
                 (const :tag "Ask" ask)
@@ -2770,9 +2805,9 @@ summary buffer."
             (or how
                 (setq how gnus-article-browse-delete-temp)))
     (when (and (eq how 'ask)
             (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)))
+              (gnus-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)
               (setq how t)))
     (dolist (file gnus-article-browse-html-temp-list)
       (when (and (file-exists-p file)
@@ -2786,62 +2821,223 @@ summary buffer."
     (setq gnus-article-browse-html-temp-list nil))
   gnu