(gnus-group-completing-read): Remove all newlines from group names. They mess up...

[gnus] / lisp / gnus-art.el
diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el

index b55a0d4..530e72f 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, 2008 Free Software Foundation, Inc.
+;;   2005, 2006, 2007, 2008, 2009, 2010 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,15 +19,13 @@
  ;; 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.
+;; For Emacs <22.2 and XEmacs.
  (eval-and-compile
    (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
  (eval-when-compile
  (eval-and-compile
    (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
  (eval-when-compile
@@ -36,10 +34,7 @@
  (defvar w3m-minor-mode-map)
  
  (require 'gnus)
  (defvar w3m-minor-mode-map)
  
  (require 'gnus)
-;; Avoid the "Recursive load suspected" error in Emacs 21.1.
-(eval-and-compile
-  (let ((recursive-load-depth-limit 100))
-    (require 'gnus-sum)))
+(require 'gnus-sum)
  (require 'gnus-spec)
  (require 'gnus-int)
  (require 'gnus-win)
  (require 'gnus-spec)
  (require 'gnus-int)
  (require 'gnus-win)
@@ -178,12 +173,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
@@ -536,6 +534,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'
@@ -551,13 +550,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
@@ -580,6 +581,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
@@ -722,8 +724,8 @@ Each element is a regular expression."
    :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)))
@@ -761,6 +763,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)
@@ -776,6 +779,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)
@@ -791,6 +795,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)
@@ -808,6 +813,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)
@@ -823,6 +829,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)
@@ -837,6 +844,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)
@@ -908,25 +916,25 @@ image type in XEmacs if it is built with the libcompface library."
    "Function used to decode addresses.")
  
  (defvar gnus-article-dumbquotes-map
    "Function used to decode addresses.")
  
  (defvar gnus-article-dumbquotes-map
-  '(("\200" "EUR")
-    ("\202" ",")
-    ("\203" "f")
-    ("\204" ",,")
-    ("\205" "...")
-    ("\213" "<")
-    ("\214" "OE")
-    ("\221" "`")
-    ("\222" "'")
-    ("\223" "``")
-    ("\224" "\"")
-    ("\225" "*")
-    ("\226" "-")
-    ("\227" "--")
-    ("\230" "~")
-    ("\231" "(TM)")
-    ("\233" ">")
-    ("\234" "oe")
-    ("\264" "'"))
+  '((?\200 "EUR")
+    (?\202 ",")
+    (?\203 "f")
+    (?\204 ",,")
+    (?\205 "...")
+    (?\213 "<")
+    (?\214 "OE")
+    (?\221 "`")
+    (?\222 "'")
+    (?\223 "``")
+    (?\224 "\"")
+    (?\225 "*")
+    (?\226 "-")
+    (?\227 "--")
+    (?\230 "~")
+    (?\231 "(TM)")
+    (?\233 ">")
+    (?\234 "oe")
+    (?\264 "'"))
    "Table for MS-to-Latin1 translation.")
  
  (defcustom gnus-ignored-mime-types nil
    "Table for MS-to-Latin1 translation.")
  
  (defcustom gnus-ignored-mime-types nil
@@ -1212,8 +1220,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.
@@ -1404,15 +1412,19 @@ 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 "Emacs 22.1")
  
  (defcustom gnus-treat-display-x-face
    (and (not noninteractive)
         (gnus-image-type-available-p 'xbm)
         (if (featurep 'xemacs)
            (featurep 'xface)
  
  (defcustom gnus-treat-display-x-face
    (and (not noninteractive)
         (gnus-image-type-available-p 'xbm)
         (if (featurep 'xemacs)
            (featurep 'xface)
-        (and (string-match "^0x" (shell-command-to-string "uncompface"))
-             (executable-find "icontopbm")))
+        (condition-case nil
+             (and (string-match "^0x" (shell-command-to-string "uncompface"))
+                  (executable-find "icontopbm"))
+           ;; shell-command-to-string may signal an error, e.g. if
+           ;; shell-file-name is not found.
+           (error nil)))
         'head)
    "Display X-Face headers.
  Valid values are nil and `head'.
         'head)
    "Display X-Face headers.
  Valid values are nil and `head'.
@@ -1449,7 +1461,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")
@@ -1517,10 +1529,38 @@ node `(gnus)Picons' for details."
    :type gnus-article-treat-head-custom)
  (put 'gnus-treat-newsgroups-picon 'highlight t)
  
    :type gnus-article-treat-head-custom)
  (put 'gnus-treat-newsgroups-picon 'highlight t)
  
+(defcustom gnus-treat-from-gravatar nil
+  "Display gravatars in the From header.
+Valid values are nil, t, `head', `first', `last', an integer or a
+predicate.  See Info node `(gnus)Customizing Articles' and Info
+node `(gnus)Gravatars' for details."
+  :version "24.1"
+  :group 'gnus-article-treat
+  :group 'gnus-gravatar
+  :link '(custom-manual "(gnus)Customizing Articles")
+  :link '(custom-manual "(gnus)Gravatars")
+  :type gnus-article-treat-head-custom)
+(put 'gnus-treat-from-gravatar 'highlight t)
+
+(defcustom gnus-treat-mail-gravatar nil
+  "Display gravatars in To and Cc headers.
+Valid values are nil, t, `head', `first', `last', an integer or a
+predicate.  See Info node `(gnus)Customizing Articles' and Info
+node `(gnus)Gravatars' for details."
+  :version "24.1"
+  :group 'gnus-article-treat
+  :group 'gnus-gravatar
+  :link '(custom-manual "(gnus)Customizing Articles")
+  :link '(custom-manual "(gnus)Gravatars")
+  :type gnus-article-treat-head-custom)
+(put 'gnus-treat-mail-gravatar 'highlight t)
+
  (defcustom gnus-treat-body-boundary
    (if (or gnus-treat-newsgroups-picon
           gnus-treat-mail-picon
  (defcustom gnus-treat-body-boundary
    (if (or gnus-treat-newsgroups-picon
           gnus-treat-mail-picon
-         gnus-treat-from-picon)
+         gnus-treat-from-picon
+          gnus-treat-from-gravatar
+          gnus-treat-mail-gravatar)
        ;; If there's much decoration, the user might prefer a boundery.
        'head
      nil)
        ;; If there's much decoration, the user might prefer a boundery.
        'head
      nil)
@@ -1558,24 +1598,6 @@ 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)
  
-(defcustom gnus-treat-play-sounds nil
-  "Play sounds.
-Valid values are nil, t, `head', `first', `last', an integer or a
-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', `first', `last', an integer or a
-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.
  (defcustom gnus-treat-x-pgp-sig nil
    "Verify X-PGP-Sig.
  To automatically treat X-PGP-Sig, set it to head.
@@ -1599,9 +1621,6 @@ It is a string, such as \"PGP\". If nil, ask user."
    :type 'string
    :group 'mime-security)
  
    :type 'string
    :group 'mime-security)
  
-(defvar gnus-article-wash-function nil
-  "Function used for converting HTML into text.")
-
  (defcustom gnus-use-idna (and (condition-case nil (require 'idna) (file-error))
                               (mm-coding-system-p 'utf-8)
                               (executable-find idna-program))
  (defcustom gnus-use-idna (and (condition-case nil (require 'idna) (file-error))
                               (mm-coding-system-p 'utf-8)
                               (executable-find idna-program))
@@ -1617,6 +1636,15 @@ This requires GNU Libidn, and by default only enabled if it is found."
    :group 'gnus-article
    :type 'boolean)
  
    :group 'gnus-article
    :type 'boolean)
  
+(defcustom gnus-blocked-images 'gnus-block-private-groups
+  "Images that have URLs matching this regexp will be blocked.
+This can also be a function to be evaluated.  If so, it will be
+called with the group name as the parameter, and should return a
+regexp."
+  :version "24.1"
+  :group 'gnus-art
+  :type 'regexp)
+
  ;;; Internal variables
  
  (defvar gnus-english-month-names
  ;;; Internal variables
  
  (defvar gnus-english-month-names
@@ -1653,10 +1681,12 @@ This requires GNU Libidn, and by default only enabled if it is found."
      (gnus-treat-hide-signature gnus-article-hide-signature)
      (gnus-treat-strip-list-identifiers gnus-article-hide-list-identifiers)
      (gnus-treat-leading-whitespace gnus-article-remove-leading-whitespace)
      (gnus-treat-hide-signature gnus-article-hide-signature)
      (gnus-treat-strip-list-identifiers gnus-article-hide-list-identifiers)
      (gnus-treat-leading-whitespace gnus-article-remove-leading-whitespace)
-    (gnus-treat-strip-pem gnus-article-hide-pem)
      (gnus-treat-from-picon gnus-treat-from-picon)
      (gnus-treat-mail-picon gnus-treat-mail-picon)
      (gnus-treat-newsgroups-picon gnus-treat-newsgroups-picon)
      (gnus-treat-from-picon gnus-treat-from-picon)
      (gnus-treat-mail-picon gnus-treat-mail-picon)
      (gnus-treat-newsgroups-picon gnus-treat-newsgroups-picon)
+    (gnus-treat-strip-pem gnus-article-hide-pem)
+    (gnus-treat-from-gravatar gnus-treat-from-gravatar)
+    (gnus-treat-mail-gravatar gnus-treat-mail-gravatar)
      (gnus-treat-highlight-headers gnus-article-highlight-headers)
      (gnus-treat-highlight-signature gnus-article-highlight-signature)
      (gnus-treat-strip-trailing-blank-lines
      (gnus-treat-highlight-headers gnus-article-highlight-headers)
      (gnus-treat-highlight-signature gnus-article-highlight-signature)
      (gnus-treat-strip-trailing-blank-lines
@@ -1678,8 +1708,7 @@ This requires GNU Libidn, and by default only enabled if it is found."
      (gnus-treat-hide-citation gnus-article-hide-citation)
      (gnus-treat-hide-citation-maybe gnus-article-hide-citation-maybe)
      (gnus-treat-highlight-citation gnus-article-highlight-citation)
      (gnus-treat-hide-citation gnus-article-hide-citation)
      (gnus-treat-hide-citation-maybe gnus-article-hide-citation-maybe)
      (gnus-treat-highlight-citation gnus-article-highlight-citation)
-    (gnus-treat-body-boundary gnus-article-treat-body-boundary)
-    (gnus-treat-play-sounds gnus-earcon-display)))
+    (gnus-treat-body-boundary gnus-article-treat-body-boundary)))
  
  (defvar gnus-article-mime-handle-alist nil)
  (defvar article-lapsed-timer nil)
  
  (defvar gnus-article-mime-handle-alist nil)
  (defvar article-lapsed-timer nil)
@@ -1700,11 +1729,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)
@@ -2114,9 +2138,18 @@ MAP is an alist where the elements are on the form (\"from\" \"to\")."
      (when (article-goto-body)
        (let ((inhibit-read-only t))
         (dolist (elem map)
      (when (article-goto-body)
        (let ((inhibit-read-only t))
         (dolist (elem map)
-         (save-excursion
-           (while (search-forward (car elem) nil t)
-             (replace-match (cadr elem)))))))))
+         (let ((from (car elem))
+               (to (cadr elem)))
+           (save-excursion
+             (if (stringp from)
+                 (while (search-forward from nil t)
+                   (replace-match to))
+               (while (not (eobp))
+                 (if (eq (following-char) from)
+                     (progn
+                       (delete-char 1)
+                       (insert to))
+                   (forward-char 1)))))))))))
  
  (defun article-treat-overstrike ()
    "Translate overstrikes into bold text."
  
  (defun article-treat-overstrike ()
    "Translate overstrikes into bold text."
@@ -2236,7 +2269,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))
@@ -2267,9 +2300,9 @@ long lines iff arg is positive."
         (insert "X-Boundary: ")
         (gnus-add-text-properties start (point) '(invisible t intangible t))
         (insert (let (str)
         (insert "X-Boundary: ")
         (gnus-add-text-properties start (point) '(invisible t intangible t))
         (insert (let (str)
-                 (while (>= (1- (window-width)) (length str))
+                 (while (>= (window-width) (length str))
                     (setq str (concat str gnus-body-boundary-delimiter)))
                     (setq str (concat str gnus-body-boundary-delimiter)))
-                 (substring str 0 (1- (window-width))))
+                 (substring str 0 (window-width)))
                 "\n")
         (gnus-put-text-property start (point) 'gnus-decoration 'header)))))
  
                 "\n")
         (gnus-put-text-property start (point) 'gnus-decoration 'header)))))
  
@@ -2661,99 +2694,16 @@ If READ-CHARSET, ask for a coding system."
      (when (interactive-p)
        (gnus-treat-article nil))))
  
      (when (interactive-p)
        (gnus-treat-article nil))))
  
-
-(defun article-wash-html (&optional read-charset)
-  "Format an HTML article.
-If READ-CHARSET, ask for a coding system.  If it is a number, the
-charset defined in `gnus-summary-show-article-charset-alist' is used."
-  (interactive "P")
-  (save-excursion
-    (let ((inhibit-read-only t)
-         charset)
-      (if read-charset
-         (if (or (and (numberp read-charset)
-                      (setq charset
-                            (cdr
-                             (assq read-charset
-                                   gnus-summary-show-article-charset-alist))))
-                 (setq charset (mm-read-coding-system "Charset: ")))
-             (let ((gnus-summary-show-article-charset-alist
-                    (list (cons 1 charset))))
-               (with-current-buffer gnus-summary-buffer
-                 (gnus-summary-show-article 1)))
-           (error "No charset is given"))
-       (when (gnus-buffer-live-p gnus-original-article-buffer)
-         (with-current-buffer gnus-original-article-buffer
-           (let* ((ct (gnus-fetch-field "content-type"))
-                  (ctl (and ct (mail-header-parse-content-type ct))))
-             (setq charset (and ctl
-                                (mail-content-type-get ctl 'charset)))
-             (when (stringp charset)
-               (setq charset (intern (downcase charset)))))))
-       (unless charset
-         (setq charset gnus-newsgroup-charset)))
-      (article-goto-body)
-      (save-window-excursion
-       (save-restriction
-         (narrow-to-region (point) (point-max))
-         (let* ((func (or gnus-article-wash-function mm-text-html-renderer))
-                (entry (assq func mm-text-html-washer-alist)))
-           (when entry
-             (setq func (cdr entry)))
-           (cond
-            ((functionp func)
-             (funcall 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)
-  (let ((w3-strict-width (window-width))
-       (url-standalone-mode t)
-       (url-gateway-unplugged t)
-       (w3-honor-stylesheets nil))
-    (condition-case ()
-       (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)))
-  (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))))
-
-(defvar charset) ;; Bound by `article-wash-html'.
-
-(defun gnus-article-wash-html-with-w3m-standalone ()
-  "Wash the current buffer with w3m."
-  (if (mm-w3m-standalone-supports-m17n-p)
-      (progn
-       (unless (mm-coding-system-p charset) ;; Bound by `article-wash-html'.
-         ;; The default.
-         (setq charset 'iso-8859-1))
-       (let ((coding-system-for-write charset)
-             (coding-system-for-read charset))
-         (call-process-region
-          (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")))
+(defun article-wash-html ()
+  "Format an HTML article."
+  (interactive)
+  (let ((handles nil)
+       (buffer-read-only nil))
+    (when (gnus-buffer-live-p gnus-original-article-buffer)
+      (setq handles (mm-dissect-buffer t t)))
+    (article-goto-body)
+    (delete-region (point) (point-max))
+    (mm-inline-text-html handles)))
  
  (defvar gnus-article-browse-html-temp-list nil
    "List of temporary files created by `gnus-article-browse-html-parts'.
  
  (defvar gnus-article-browse-html-temp-list nil
    "List of temporary files created by `gnus-article-browse-html-parts'.
@@ -2777,31 +2727,66 @@ summary buffer."
  (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
  (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)
-              (gnus-y-or-n-p (format
-                              "Delete all %s temporary HTML file(s)? "
-                              (length gnus-article-browse-html-temp-list)))
-              (setq how t)))
+            (progn
+              (or how (setq how gnus-article-browse-delete-temp))
+              (if (eq how 'ask)
+                  (let ((files (length gnus-article-browse-html-temp-list)))
+                    (gnus-y-or-n-p (format
+                                    "Delete all %s temporary HTML file%s? "
+                                    files
+                                    (if (> files 1) "s" ""))))
+                how)))
      (dolist (file gnus-article-browse-html-temp-list)
      (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)))
+      (cond ((file-directory-p file)
+            (when (or (not (eq how 'file))
+                      (gnus-y-or-n-p
+                       (format
+                        "Delete temporary HTML file(s) in directory `%s'? "
+                        (file-name-as-directory file))))
+              (gnus-delete-directory file)))
+           ((file-exists-p file)
+            (when (or (not (eq how '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)
  
      ;; 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-save-cid-content (cid handles directory)
+  "Find CID content in HANDLES and save it in a file in DIRECTORY.
+Return file name."
+  (save-match-data
+    (let (file type)
+      (catch 'found
+       (dolist (handle handles)
+         (cond
+          ((not (listp handle)))
+          ((equal (mm-handle-media-supertype handle) "multipart")
+           (when (setq file (gnus-article-browse-html-save-cid-content
+                             cid handle directory))
+             (throw 'found file)))
+          ((equal (concat "<" cid ">") (mm-handle-id handle))
+           (setq file
+                 (expand-file-name
+                  (or (mail-content-type-get
+                       (mm-handle-disposition handle) 'filename)
+                      (mail-content-type-get
+                       (setq type (mm-handle-type handle)) 'name)
+                      (concat
+                       (make-temp-name "cid")
+                       (car (rassoc (car type) mailcap-mime-extensions))))
+                  directory))
+           (mm-save-part-to-file handle file)
+           (throw 'found file))))))))
+
  (defun gnus-article-browse-html-parts (list &optional header)
    "View all \"text/html\" parts from LIST.
  Recurse into multiparts.  The optional HEADER that should be a decoded
  message header will be added to the bodies of the \"text/html\" parts."
    ;; Internal function used by `gnus-article-browse-html-article'.
  (defun gnus-article-browse-html-parts (list &optional header)
    "View all \"text/html\" parts from LIST.
  Recurse into multiparts.  The optional HEADER that should be a decoded
  message header will be added to the bodies of the \"text/html\" parts."
    ;; Internal function used by `gnus-article-browse-html-article'.
-  (let (type file charset tmp-file showed)
+  (let (type file charset content cid-dir tmp-file showed)
      ;; Find and show the html-parts.
      (dolist (handle list)
        ;; If HTML, show it:
      ;; Find and show the html-parts.
      (dolist (handle list)
        ;; If HTML, show it:
@@ -2824,16 +2809,42 @@ message header will be added to the bodies of the \"text/html\" parts."
                         (setq handle (mm-handle-cache handle)
                               type (mm-handle-type handle))
                         (equal (car type) "text/html"))))
                         (setq handle (mm-handle-cache handle)
                               type (mm-handle-type handle))
                         (equal (car type) "text/html"))))
-            (when (or (setq charset (mail-content-type-get type 'charset))
-                      header
-                      (not file))
+            (setq charset (mail-content-type-get type 'charset)
+                  content (mm-get-part handle))
+            (with-temp-buffer
+              (if (eq charset 'gnus-decoded)
+                  (mm-enable-multibyte)
+                (mm-disable-multibyte))
+              (insert content)
+              ;; resolve cid contents
+              (let ((case-fold-search t)
+                    cid-file)
+                (goto-char (point-min))
+                (while (re-search-forward "\
+<img[\t\n ]+\\(?:[^\t\n >]+[\t\n ]+\\)*src=\"\\(cid:\\([^\"]+\\)\\)\""
+                                          nil t)
+                  (unless cid-dir
+                    (setq cid-dir (mm-make-temp-file "cid" t))
+                    (add-to-list 'gnus-article-browse-html-temp-list cid-dir))
+                  (setq file nil
+                        content nil)
+                  (when (setq cid-file
+                              (gnus-article-browse-html-save-cid-content
+                               (match-string 2)
+                               (with-current-buffer gnus-article-buffer
+                                 gnus-article-mime-handles)
+                               cid-dir))
+                    (replace-match (concat "file://" cid-file)
+                                   nil nil nil 1))))
+              (unless content (setq content (buffer-string))))
+            (when (or charset header (not file))
                (setq tmp-file (mm-make-temp-file
                                ;; Do we need to care for 8.3 filenames?
                                "mm-" nil ".html")))
              ;; Add a meta html tag to specify charset and a header.
              (cond
               (header
                (setq tmp-file (mm-make-temp-file
                                ;; Do we need to care for 8.3 filenames?
                                "mm-" nil ".html")))
              ;; Add a meta html tag to specify charset and a header.
              (cond
               (header
-              (let (title eheader body hcharset coding)
+              (let (title eheader body hcharset coding force-charset)
                  (with-temp-buffer
                    (mm-enable-multibyte)
                    (setq case-fold-search t)
                  (with-temp-buffer
                    (mm-enable-multibyte)
                    (setq case-fold-search t)
@@ -2856,8 +2867,8 @@ message header will be added to the bodies of the \"text/html\" parts."
                                                               charset)
                              title (when title
                                      (mm-encode-coding-string title charset))
                                                               charset)
                              title (when title
                                      (mm-encode-coding-string title charset))
-                            body (mm-encode-coding-string (mm-get-part handle)
-                                                          charset))
+                            body (mm-encode-coding-string content charset)
+                            force-charset t)
                      (setq hcharset (mm-find-mime-charset-region (point-min)
                                                                  (point-max)))
                      (cond ((= (length hcharset) 1)
                      (setq hcharset (mm-find-mime-charset-region (point-min)
                                                                  (point-max)))
                      (cond ((= (length hcharset) 1)
@@ -2878,7 +2889,7 @@ message header will be added to the bodies of the \"text/html\" parts."
                                          title (when title
                                                  (mm-encode-coding-string
                                                   title coding))
                                          title (when title
                                                  (mm-encode-coding-string
                                                   title coding))
-                                        body (mm-get-part handle))
+                                        body content)
                                  (setq charset 'utf-8
                                        eheader (mm-encode-coding-string
                                                 (buffer-string) charset)
                                  (setq charset 'utf-8
                                        eheader (mm-encode-coding-string
                                                 (buffer-string) charset)
@@ -2887,22 +2898,23 @@ message header will be added to the bodies of the \"text/html\" parts."
                                                 title charset))
                                        body (mm-encode-coding-string
                                              (mm-decode-coding-string
                                                 title charset))
                                        body (mm-encode-coding-string
                                              (mm-decode-coding-string
-                                             (mm-get-part handle) body)
-                                            charset))))
+                                             content body)
+                                            charset)
+                                      force-charset t)))
                            (setq charset hcharset
                                  eheader (mm-encode-coding-string
                                           (buffer-string) coding)
                                  title (when title
                                          (mm-encode-coding-string
                                           title coding))
                            (setq charset hcharset
                                  eheader (mm-encode-coding-string
                                           (buffer-string) coding)
                                  title (when title
                                          (mm-encode-coding-string
                                           title coding))
-                                body (mm-get-part handle)))
+                                body content))
                        (setq eheader (mm-string-as-unibyte (buffer-string))
                        (setq eheader (mm-string-as-unibyte (buffer-string))
-                            body (mm-get-part handle))))
+                            body content)))
                    (erase-buffer)
                    (mm-disable-multibyte)
                    (insert body)
                    (when charset
                    (erase-buffer)
                    (mm-disable-multibyte)
                    (insert body)
                    (when charset
-                    (mm-add-meta-html-tag handle charset))
+                    (mm-add-meta-html-tag handle charset force-charset))
                    (when title
                      (goto-char (point-min))
                      (unless (search-forward "<title>" nil t)
                    (when title
                      (goto-char (point-min))
                      (unless (search-forward "<title>" nil t)
@@ -2919,10 +2931,9 @@ message header will be added to the bodies of the \"text/html\" parts."
               (charset
                (mm-with-unibyte-buffer
                  (insert (if (eq charset 'gnus-decoded)
               (charset
                (mm-with-unibyte-buffer
                  (insert (if (eq charset 'gnus-decoded)
-                            (mm-encode-coding-string
-                             (mm-get-part handle)
-                             (setq charset 'utf-8))
-                          (mm-get-part handle)))
+                            (mm-encode-coding-string content
+                                                     (setq charset 'utf-8))
+                          content))
                  (if (or (mm-add-meta-html-tag handle charset)
                          (not file))
                      (mm-write-region (point-min) (point-max)
                  (if (or (mm-add-meta-html-tag handle charset)
                          (not file))
                      (mm-write-region (point-min) (point-max)
@@ -2967,26 +2978,33 @@ message header will be added to the bodies of the \"text/html\" parts."
                (setq showed t)))))
      showed))
  
                (setq showed t)))))
      showed))
  
-;; FIXME: Documentation in texi/gnus.texi missing.
  (defun gnus-article-browse-html-article (&optional arg)
    "View \"text/html\" parts of the current article with a WWW browser.
  (defun gnus-article-browse-html-article (&optional arg)
    "View \"text/html\" parts of the current article with a WWW browser.
+Inline images embedded in a message using the cid scheme, as they are
+generally considered to be safe, will be processed properly.
  The message header is added to the beginning of every html part unless
  the prefix argument ARG is given.
  
  The message header is added to the beginning of every html part unless
  the prefix argument ARG is given.
  
-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.
+Warning: Spammers use links to images (using the http scheme) in HTML
+articles to verify whether you have read the message.  As
+`gnus-article-browse-html-article' passes the HTML content to the
+browser without eliminating these \"web bugs\" you should only
+use it for mails from trusted senders.
  
  
-If you alwasy want to display HTML part in the browser, set
-`mm-text-html-renderer' to nil."
+If you always want to display HTML parts in the browser, set
+`mm-text-html-renderer' to nil.
+
+This command creates temporary files to pass HTML contents including
+images if any to the browser, and deletes them when exiting the group
+\(if you want)."
    ;; Cf. `mm-w3m-safe-url-regexp'
    (interactive "P")
    (if arg
        (gnus-summary-show-article)
      (let ((gnus-visible-headers (or (get 'gnus-visible-headers 'standard-value)
    ;; Cf. `mm-w3m-safe-url-regexp'
    (interactive "P")
    (if arg
        (gnus-summary-show-article)
      (let ((gnus-visible-headers (or (get 'gnus-visible-headers 'standard-value)
-                                   gnus-visible-headers)))
+                                   gnus-visible-headers))
+         ;; As we insert a <hr>, there's no need for the body boundary.
+         (gnus-treat-body-boundary nil))
        (gnus-summary-show-article)))
    (with-current-buffer gnus-article-buffer
      (let ((header (unless arg
        (gnus-summary-show-article)))
    (with-current-buffer gnus-article-buffer
      (let ((header (unless arg
@@ -3385,9 +3403,15 @@ should replace the \"Date:\" one, or should be added below it."
                                     (point) 'original-date))
                      (setq date (get-text-property pos 'original-date))
                      t))
                                     (point) 'original-date))
                      (setq date (get-text-property pos 'original-date))
                      t))
-         (narrow-to-region pos (or (text-property-any pos (point-max)
-                                                      'original-date nil)
-                                   (point-max)))
+         (narrow-to-region
+          pos (if (setq pos (text-property-any pos (point-max)
+                                               'original-date nil))
+                  (progn
+                    (goto-char pos)
+                    (if (or (bolp) (eobp))
+                        (point)
+                      (1+ (point))))
+                (point-max)))
           (goto-char (point-min))
           (when (re-search-forward tdate-regexp nil t)
             (setq bface (get-text-property (point-at-bol) 'face)
           (goto-char (point-min))
           (when (re-search-forward tdate-regexp nil t)
             (setq bface (get-text-property (point-at-bol) 'face)
@@ -3715,7 +3739,8 @@ This format is defined by the `gnus-article-time-format' variable."
      (let ((gnus-visible-headers
            (or (symbol-value (get gnus-default-article-saver :headers))
                gnus-saved-headers gnus-visible-headers))
      (let ((gnus-visible-headers
            (or (symbol-value (get gnus-default-article-saver :headers))
                gnus-saved-headers gnus-visible-headers))
-         (gnus-article-buffer save-buffer))
+         ;; Ignore group parameter.  See `article-hide-headers'.
+         (gnus-summary-buffer nil))
        (with-current-buffer save-buffer
         (article-hide-headers 1 t))))
    (save-window-excursion
        (with-current-buffer save-buffer
         (article-hide-headers 1 t))))
    (save-window-excursion
@@ -3846,10 +3871,13 @@ Directory to save to is default to `gnus-article-save-directory'."
                   "Save %s in rmail file" filename
                   gnus-rmail-save-name gnus-newsgroup-name
                   gnus-current-headers 'gnus-newsgroup-last-rmail))
                   "Save %s in rmail file" filename
                   gnus-rmail-save-name gnus-newsgroup-name
                   gnus-current-headers 'gnus-newsgroup-last-rmail))
-  (gnus-eval-in-buffer-window gnus-save-article-buffer
+  (with-current-buffer gnus-save-article-buffer
      (save-excursion
        (save-restriction
         (widen)
      (save-excursion
        (save-restriction
         (widen)
+       ;; Note that unlike gnus-summary-save-in-mail, there is no
+       ;; check to see if filename is Babyl.  Rmail in Emacs 23 does
+       ;; not use Babyl.
         (gnus-output-to-rmail filename))))
    filename)
  
         (gnus-output-to-rmail filename))))
    filename)
  
@@ -3861,14 +3889,14 @@ Directory to save to is default to `gnus-article-save-directory'."
                   "Save %s in Unix mail file" filename
                   gnus-mail-save-name gnus-newsgroup-name
                   gnus-current-headers 'gnus-newsgroup-last-mail))
                   "Save %s in Unix mail file" filename
                   gnus-mail-save-name gnus-newsgroup-name
                   gnus-current-headers 'gnus-newsgroup-last-mail))
-  (gnus-eval-in-buffer-window gnus-save-article-buffer
+  (with-current-buffer gnus-save-article-buffer
      (save-excursion
        (save-restriction
         (widen)
         (if (and (file-readable-p filename)
                  (file-regular-p filename)
                  (mail-file-babyl-p filename))
      (save-excursion
        (save-restriction
         (widen)
         (if (and (file-readable-p filename)
                  (file-regular-p filename)
                  (mail-file-babyl-p filename))
-           (rmail-output-to-rmail-file filename t)
+           (gnus-output-to-rmail filename)
           (gnus-output-to-mail filename)))))
    filename)
  
           (gnus-output-to-mail filename)))))
    filename)
  
@@ -3882,7 +3910,7 @@ Directory to save to is default to `gnus-article-save-directory'."
                   "Save %s in file" filename
                   gnus-file-save-name gnus-newsgroup-name
                   gnus-current-headers 'gnus-newsgroup-last-file))
                   "Save %s in file" filename
                   gnus-file-save-name gnus-newsgroup-name
                   gnus-current-headers 'gnus-newsgroup-last-file))
-  (gnus-eval-in-buffer-window gnus-save-article-buffer
+  (with-current-buffer gnus-save-article-buffer
      (save-excursion
        (save-restriction
         (widen)
      (save-excursion
        (save-restriction
         (widen)
@@ -3914,7 +3942,7 @@ The directory to save in defaults to `gnus-article-save-directory'."
                   "Save %s body in file" filename
                   gnus-file-save-name gnus-newsgroup-name
                   gnus-current-headers 'gnus-newsgroup-last-file))
                   "Save %s body in file" filename
                   gnus-file-save-name gnus-newsgroup-name
                   gnus-current-headers 'gnus-newsgroup-last-file))
-  (gnus-eval-in-buffer-window gnus-save-article-buffer
+  (with-current-buffer gnus-save-article-buffer
      (save-excursion
        (save-restriction
         (widen)
      (save-excursion
        (save-restriction
         (widen)
@@ -3939,39 +3967,77 @@ The directory to save in defaults to `gnus-article-save-directory'."
                   gnus-current-headers nil 'gnus-newsgroup-last-directory))
    (gnus-summary-save-body-in-file filename t))
  
                   gnus-current-headers nil 'gnus-newsgroup-last-directory))
    (gnus-summary-save-body-in-file filename t))
  
-(defun gnus-summary-save-in-pipe (&optional command)
-  "Pipe this article to subprocess."
-  (setq command
-       (cond ((and (eq command 'default)
-                   gnus-last-shell-command)
-              gnus-last-shell-command)
-             ((stringp command)
-              command)
-             (t (read-string
-                 (format
-                  "Shell command on %s: "
-                  (if (and gnus-number-of-articles-to-be-saved
-                           (> gnus-number-of-articles-to-be-saved 1))
-                      (format "these %d articles"
-                              gnus-number-of-articles-to-be-saved)
-                    "this article"))
-                 gnus-last-shell-command))))
-  (when (string-equal command "")
-    (if gnus-last-shell-command
-       (setq command gnus-last-shell-command)
-      (error "A command is required")))
-  (gnus-eval-in-buffer-window gnus-article-buffer
-    (save-restriction
-      (widen)
-      (shell-command-on-region (point-min) (point-max) command nil)))
-  (setq gnus-last-shell-command command))
+(put 'gnus-summary-save-in-pipe :decode t)
+(put 'gnus-summary-save-in-pipe :headers 'gnus-saved-headers)
+(defun gnus-summary-save-in-pipe (&optional command raw)
+  "Pipe this article to subprocess COMMAND.
+Valid values for COMMAND include:
+  a string
+    The executable command name and possibly arguments.
+  nil
+    You will be prompted for the command in the minibuffer.
+  the symbol `default'
+    It will be replaced with the command which the variable
+    `gnus-summary-pipe-output-default-command' holds or the command
+    last used for saving.
+Non-nil value for RAW overrides `:decode' and `:headers' properties
+and the raw article including all headers will be piped."
+  (let ((article (gnus-summary-article-number))
+       (decode (unless raw
+                 (get 'gnus-summary-save-in-pipe :decode)))
+       save-buffer default)
+    (if article
+       (if (vectorp (gnus-summary-article-header article))
+           (save-current-buffer
+             (gnus-summary-select-article decode decode nil article)
+             (insert-buffer-substring
+              (prog1
+                  (if decode
+                      gnus-article-buffer
+                    gnus-original-article-buffer)
+                (setq save-buffer
+                      (nnheader-set-temp-buffer " *Gnus Save*"))))
+             ;; Remove unwanted headers.
+             (when (and (not raw)
+                        (or (get 'gnus-summary-save-in-pipe :headers)
+                            (not gnus-save-all-headers)))
+               (let ((gnus-visible-headers
+                      (or (symbol-value (get 'gnus-summary-save-in-pipe
+                                             :headers))
+                          gnus-saved-headers gnus-visible-headers))
+                     (gnus-summary-buffer nil))
+                 (article-hide-headers 1 t))))
+         (error "%d is not a real article" article))
+      (error "No article to pipe"))
+    (setq default (or gnus-summary-pipe-output-default-command
+                     gnus-last-shell-command))
+    (unless (stringp command)
+      (setq command
+           (if (and (eq command 'default) default)
+               default
+             (gnus-read-shell-command "Shell command on this article: "
+                                      default))))
+    (when (string-equal command "")
+      (if default
+         (setq command default)
+       (error "A command is required")))
+    (with-current-buffer save-buffer
+      (save-restriction
+       (widen)
+       (shell-command-on-region (point-min) (point-max) command nil)))
+    (gnus-kill-buffer save-buffer))
+  (setq gnus-summary-pipe-output-default-command command))
  
  (defun gnus-summary-pipe-to-muttprint (&optional command)
    "Pipe this article to muttprint."
  
  (defun gnus-summary-pipe-to-muttprint (&optional command)
    "Pipe this article to muttprint."
-  (setq command (read-string
-                "Print using command: " gnus-summary-muttprint-program
-                nil gnus-summary-muttprint-program))
-  (gnus-summary-save-in-pipe command))
+  (unless (stringp command)
+    (setq command (read-string
+                  "Print using command: " gnus-summary-muttprint-program
+                  nil gnus-summary-muttprint-program)))
+  (let ((gnus-summary-pipe-output-default-command
+        gnus-summary-pipe-output-default-command))
+    (gnus-summary-save-in-pipe command))
+  (setq gnus-summary-muttprint-program command))
  
  ;;; Article file names when saving.
  
  
  ;;; Article file names when saving.
  
@@ -4114,6 +4180,8 @@ If variable `gnus-use-long-file-name' is non-nil, it is
                   (put-text-property (match-end 0) (point-max)
                                      'face eface)))))))))
  
                   (put-text-property (match-end 0) (point-max)
                                      'face eface)))))))))
  
+(autoload 'canlock-verify "canlock" nil t) ;; for XEmacs.
+
  (defun article-verify-cancel-lock ()
    "Verify Cancel-Lock header."
    (interactive)
  (defun article-verify-cancel-lock ()
    "Verify Cancel-Lock header."
    (interactive)
@@ -4202,7 +4270,6 @@ If variable `gnus-use-long-file-name' is non-nil, it is
    "s" gnus-article-show-summary
    "\C-c\C-m" gnus-article-mail
    "?" gnus-article-describe-briefly
    "s" gnus-article-show-summary
    "\C-c\C-m" gnus-article-mail
    "?" gnus-article-describe-briefly
-  "e" gnus-summary-edit-article
    "<" beginning-of-buffer
    ">" end-of-buffer
    "\C-c\C-i" gnus-info-find-node
    "<" beginning-of-buffer
    ">" end-of-buffer
    "\C-c\C-i" gnus-info-find-node
@@ -4213,6 +4280,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is
    "\C-hc" gnus-article-describe-key-briefly
    "\C-hb" gnus-article-describe-bindings
  
    "\C-hc" gnus-article-describe-key-briefly
    "\C-hb" gnus-article-describe-bindings
  
+  "e" gnus-article-read-summary-keys
    "\C-d" gnus-article-read-summary-keys
    "\M-*" gnus-article-read-summary-keys
    "\M-#" gnus-article-read-summary-keys
    "\C-d" gnus-article-read-summary-keys
    "\M-*" gnus-article-read-summary-keys
    "\M-#" gnus-article-read-summary-keys
@@ -4232,7 +4300,6 @@ If variable `gnus-use-long-file-name' is non-nil, it is
  (defun gnus-article-make-menu-bar ()
    (unless (boundp 'gnus-article-commands-menu)
      (gnus-summary-make-menu-bar))
  (defun gnus-article-make-menu-bar ()
    (unless (boundp 'gnus-article-commands-menu)
      (gnus-summary-make-menu-bar))
-  (gnus-turn-off-edit-menu 'article)
    (unless (boundp 'gnus-article-article-menu)
      (easy-menu-define
       gnus-article-article-menu gnus-article-mode-map ""
    (unless (boundp 'gnus-article-article-menu)
      (easy-menu-define
       gnus-article-article-menu gnus-article-mode-map ""
@@ -4267,6 +4334,8 @@ If variable `gnus-use-long-file-name' is non-nil, it is
  
      (gnus-run-hooks 'gnus-article-menu-hook)))
  
  
      (gnus-run-hooks 'gnus-article-menu-hook)))
  
+(defvar bookmark-make-record-function)
+
  (defun gnus-article-mode ()
    "Major mode for displaying an article.
  
  (defun gnus-article-mode ()
    "Major mode for displaying an article.
  
@@ -4305,11 +4374,12 @@ commands:
    (make-local-variable 'gnus-article-image-alist)
    (make-local-variable 'gnus-article-charset)
    (make-local-variable 'gnus-article-ignored-charsets)
    (make-local-variable 'gnus-article-image-alist)
    (make-local-variable 'gnus-article-charset)
    (make-local-variable 'gnus-article-ignored-charsets)
+  (set (make-local-variable 'bookmark-make-record-function)
+       'gnus-summary-bookmark-make-record)
    ;; 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)
    ;; 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
    (gnus-set-default-directory)
    (buffer-disable-undo)
    (setq buffer-read-only t
@@ -4369,9 +4439,11 @@ Internal variable.")
           (setq gnus-button-marker-list nil)
           (unless (eq major-mode 'gnus-article-mode)
             (gnus-article-mode))
           (setq gnus-button-marker-list nil)
           (unless (eq major-mode 'gnus-article-mode)
             (gnus-article-mode))
+         (setq truncate-lines gnus-article-truncate-lines)
           (current-buffer))
        (with-current-buffer (gnus-get-buffer-create name)
         (gnus-article-mode)
           (current-buffer))
        (with-current-buffer (gnus-get-buffer-create name)
         (gnus-article-mode)
+       (setq truncate-lines gnus-article-truncate-lines)
         (make-local-variable 'gnus-summary-buffer)
         (setq gnus-summary-buffer
               (gnus-summary-buffer-name gnus-newsgroup-name))
         (make-local-variable 'gnus-summary-buffer)
         (setq gnus-summary-buffer
               (gnus-summary-buffer-name gnus-newsgroup-name))
@@ -4672,6 +4744,43 @@ General format specifiers can also be used.  See Info node
                 (vector (caddr c) (car c) :active t))
               gnus-mime-button-commands)))
  
                 (vector (caddr c) (car c) :active t))
               gnus-mime-button-commands)))
  
+(defvar gnus-url-button-commands
+  '((gnus-article-copy-string "u" "Copy URL to kill ring")))
+
+(defvar gnus-url-button-map
+  (let ((map (make-sparse-keymap)))
+    (dolist (c gnus-url-button-commands)
+      (define-key map (cadr c) (car c)))
+    map))
+
+(easy-menu-define
+  gnus-url-button-menu gnus-url-button-map "URL button menu."
+  `("Url Button"
+    ,@(mapcar (lambda (c)
+               (vector (caddr c) (car c) :active t))
+             gnus-url-button-commands)))
+
+(defmacro gnus-bind-safe-url-regexp (&rest body)
+  "Bind `mm-w3m-safe-url-regexp' according to `gnus-safe-html-newsgroups'."
+  `(let ((mm-w3m-safe-url-regexp
+         (let ((group (if (and (eq major-mode 'gnus-article-mode)
+                               (gnus-buffer-live-p
+                                gnus-article-current-summary))
+                          (with-current-buffer gnus-article-current-summary
+                            gnus-newsgroup-name)
+                        gnus-newsgroup-name)))
+           (if (cond ((not group)
+                      ;; Maybe we're in a mml-preview buffer
+                      ;; and no group is selected.
+                      t)
+                     ((stringp gnus-safe-html-newsgroups)
+                      (string-match gnus-safe-html-newsgroups group))
+                     ((consp gnus-safe-html-newsgroups)
+                      (member group gnus-safe-html-newsgroups)))
+               nil
+             mm-w3m-safe-url-regexp))))
+     ,@body))
+
  (defun gnus-mime-button-menu (event prefix)
   "Construct a context-sensitive menu of MIME commands."
   (interactive "e\nP")
  (defun gnus-mime-button-menu (event prefix)
   "Construct a context-sensitive menu of MIME commands."
   (interactive "e\nP")
@@ -4697,7 +4806,7 @@ General format specifiers can also be used.  See Info node
         (or (search-forward "\n\n") (goto-char (point-max)))
         (let ((inhibit-read-only t))
           (delete-region (point) (point-max))
         (or (search-forward "\n\n") (goto-char (point-max)))
         (let ((inhibit-read-only t))
           (delete-region (point) (point-max))
-         (mm-display-parts handles))))))
+         (gnus-bind-safe-url-regexp (mm-display-parts handles)))))))
  
  (defun gnus-article-jump-to-part (n)
    "Jump to MIME part N."
  
  (defun gnus-article-jump-to-part (n)
    "Jump to MIME part N."
@@ -4706,10 +4815,7 @@ General format specifiers can also be used.  See Info node
    ;; FIXME: why is it necessary?
    (sit-for 0)
    (let ((parts (length gnus-article-mime-handle-alist)))
    ;; 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)))))
+    (or n (setq n (read-number (format "Jump to part (2..%s): " parts))))
      (unless (and (integerp n) (<= n parts) (>= n 1))
        (setq n
             (progn
      (unless (and (integerp n) (<= n parts) (>= n 1))
        (setq n
             (progn
@@ -4728,6 +4834,10 @@ General format specifiers can also be used.  See Info node
           (t
            (gnus-article-goto-part n)))))
  
           (t
            (gnus-article-goto-part n)))))
  
+(defvar gnus-mime-buttonized-part-id nil
+  "ID of a mime part that should be buttonized.
+`gnus-mime-save-part-and-strip' and `gnus-mime-delete-part' bind it.")
+
  (eval-when-compile
    (defsubst gnus-article-edit-part (handles &optional current-id)
      "Edit an article in order to delete a mime part.
  (eval-when-compile
    (defsubst gnus-article-edit-part (handles &optional current-id)
      "Edit an article in order to delete a mime part.
@@ -4770,26 +4880,24 @@ and `gnus-mime-delete-part', and not provided at run-time normally."
          ,(gnus-group-read-only-p)
          ,gnus-summary-buffer no-highlight))
       t)
          ,(gnus-group-read-only-p)
          ,gnus-summary-buffer no-highlight))
       t)
-    (gnus-article-edit-done)
-    (gnus-summary-expand-window)
-    (gnus-summary-show-article)
+    ;; Force buttonizing this part.
+    (let ((gnus-mime-buttonized-part-id current-id))
+      (gnus-article-edit-done))
+    (gnus-configure-windows 'article)
      (when (and current-id (integerp gnus-auto-select-part))
        (gnus-article-jump-to-part
      (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)))))))
+       (min (max (+ current-id gnus-auto-select-part) 1)
+           (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
  
  (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))))
+    (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)
    (gnus-mime-save-part-and-strip file))
  
  (defun gnus-mime-save-part-and-strip (&optional file)
@@ -4861,7 +4969,7 @@ Deleting parts may malfunction or destroy the article; continue? "))
        (unless data
         (error "No MIME part under point"))
        (with-current-buffer (mm-handle-buffer data)
        (unless data
         (error "No MIME part under point"))
        (with-current-buffer (mm-handle-buffer data)
-       (let ((bsize (format "%s" (buffer-size))))
+       (let ((bsize (buffer-size)))
           (erase-buffer)
           (insert
            (concat
           (erase-buffer)
           (insert
            (concat
@@ -4870,13 +4978,16 @@ Deleting parts may malfunction or destroy the article; continue? "))
             "|\n"
             "| Type:           " type "\n"
             "| Filename:       " filename "\n"
             "|\n"
             "| Type:           " type "\n"
             "| Filename:       " filename "\n"
-           "| Size (encoded): " bsize " Byte\n"
+           "| Size (encoded): " (format "%s byte%s\n"
+                                        bsize (if (= bsize 1)
+                                                  ""
+                                                "s"))
             (when description
               (concat    "| Description:    " description "\n"))
             "`----\n"))
           (setcdr data
                   (cdr (mm-make-handle
             (when description
               (concat    "| Description:    " description "\n"))
             "`----\n"))
           (setcdr data
                   (cdr (mm-make-handle
-                       nil `("text/plain") nil nil
+                       nil `("text/plain" (charset . gnus-decoded)) nil nil
                         (list "attachment")
                         (format "Deleted attachment (%s bytes)" bsize))))))
        ;; (set-buffer gnus-summary-buffer)
                         (list "attachment")
                         (format "Deleted attachment (%s bytes)" bsize))))))
        ;; (set-buffer gnus-summary-buffer)
@@ -4890,13 +5001,14 @@ Deleting parts may malfunction or destroy the article; continue? "))
      (when data
        (mm-save-part data))))
  
      (when data
        (mm-save-part data))))
  
-(defun gnus-mime-pipe-part ()
-  "Pipe the MIME part under point to a process."
+(defun gnus-mime-pipe-part (&optional cmd)
+  "Pipe the MIME part under point to a process.
+Use CMD as the process."
    (interactive)
    (gnus-article-check-buffer)
    (let ((data (get-text-property (point) 'gnus-data)))
      (when data
    (interactive)
    (gnus-article-check-buffer)
    (let ((data (get-text-property (point) 'gnus-data)))
      (when data
-      (mm-pipe-part data))))
+      (mm-pipe-part data cmd))))
  
  (defun gnus-mime-view-part ()
    "Interactively choose a viewing method for the MIME part under point."
  
  (defun gnus-mime-view-part ()
    "Interactively choose a viewing method for the MIME part under point."
@@ -4932,11 +5044,12 @@ available media-types."
    (unless mime-type
      (setq mime-type
           (let ((default (gnus-mime-view-part-as-type-internal)))
    (unless mime-type
      (setq mime-type
           (let ((default (gnus-mime-view-part-as-type-internal)))
-           (completing-read
-            (format "View as MIME type (default %s): "
-                    (car default))
-            (mapcar #'list (mailcap-mime-types))
-            pred nil nil nil
+           (gnus-completing-read
+            "View as MIME type"
+            (if pred
+                (gnus-remove-if-not pred (mailcap-mime-types))
+              (mailcap-mime-types))
+            nil nil nil
              (car default)))))
    (gnus-article-check-buffer)
    (let ((handle (get-text-property (point) 'gnus-data)))
              (car default)))))
    (gnus-article-check-buffer)
    (let ((handle (get-text-property (point) 'gnus-data)))
@@ -5100,10 +5213,14 @@ Compressed files like .gz and .bz2 are decompressed."
            (mm-string-to-multibyte contents)))
         (goto-char b)))))
  
            (mm-string-to-multibyte contents)))
         (goto-char b)))))
  
-(defun gnus-mime-strip-charset-parameters (handle)
-  "Strip charset parameters from HANDLE."
+(defun gnus-mime-set-charset-parameters (handle charset)
+  "Set CHARSET to parameters in HANDLE.
+CHARSET may either be a string or a symbol."
+  (unless (stringp charset)
+    (setq charset (symbol-name charset)))
    (if (stringp (car handle))
    (if (stringp (car handle))
-      (mapc #'gnus-mime-strip-charset-parameters (cdr handle))
+      (dolist (h (cdr handle))
+       (gnus-mime-set-charset-parameters h charset))
      (let* ((type (mm-handle-type (if (equal (mm-handle-media-type handle)
                                             "message/external-body")
                                      (progn
      (let* ((type (mm-handle-type (if (equal (mm-handle-media-type handle)
                                             "message/external-body")
                                      (progn
@@ -5111,9 +5228,10 @@ Compressed files like .gz and .bz2 are decompressed."
                                          (mm-extern-cache-contents handle))
                                        (mm-handle-cache handle))
                                    handle)))
                                          (mm-extern-cache-contents handle))
                                        (mm-handle-cache handle))
                                    handle)))
-          (charset (assq 'charset (cdr type))))
-      (when charset
-       (delq charset type)))))
+          (param (assq 'charset (cdr type))))
+      (if param
+         (setcdr param charset)
+       (setcdr type (cons (cons 'charset charset) (cdr type)))))))
  
  (defun gnus-mime-view-part-as-charset (&optional handle arg)
    "Insert the MIME part under point into the current buffer using the
  
  (defun gnus-mime-view-part-as-charset (&optional handle arg)
    "Insert the MIME part under point into the current buffer using the
@@ -5123,18 +5241,18 @@ specified charset."
    (let ((handle (or handle (get-text-property (point) 'gnus-data)))
         (fun (get-text-property (point) 'gnus-callback))
         (gnus-newsgroup-ignored-charsets 'gnus-all)
    (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)
+       charset form preferred parts)
      (when handle
        (when (prog1
                 (and fun
      (when handle
        (when (prog1
                 (and fun
-                    (setq gnus-newsgroup-charset
+                    (setq charset
                            (or (cdr (assq
                                      arg
                                      gnus-summary-show-article-charset-alist))
                                (mm-read-coding-system "Charset: "))))
               (if (mm-handle-undisplayer handle)
                   (mm-remove-part handle)))
                            (or (cdr (assq
                                      arg
                                      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)
+       (gnus-mime-set-charset-parameters handle charset)
         (when (and (consp (setq form (cdr-safe fun)))
                    (setq form (ignore-errors
                                 (assq 'gnus-mime-display-alternative form)))
         (when (and (consp (setq form (cdr-safe fun)))
                    (setq form (ignore-errors
                                 (assq 'gnus-mime-display-alternative form)))
@@ -5170,7 +5288,7 @@ specified charset."
           (mm-enable-external t))
      (if (not (stringp method))
         (gnus-mime-view-part-as-type
           (mm-enable-external t))
      (if (not (stringp method))
         (gnus-mime-view-part-as-type
-        nil (lambda (types) (stringp (mailcap-mime-info (car types)))))
+        nil (lambda (type) (stringp (mailcap-mime-info type))))
        (when handle
         (if (mm-handle-undisplayer handle)
             (mm-remove-part handle)
        (when handle
         (if (mm-handle-undisplayer handle)
             (mm-remove-part handle)
@@ -5191,16 +5309,16 @@ If no internal viewer is available, use an external viewer."
          (inhibit-read-only t))
      (if (not (mm-inlinable-p handle))
          (gnus-mime-view-part-as-type
          (inhibit-read-only t))
      (if (not (mm-inlinable-p handle))
          (gnus-mime-view-part-as-type
-         nil (lambda (types) (mm-inlinable-p handle (car types))))
+         nil (lambda (type) (mm-inlinable-p handle type)))
        (when handle
         (if (mm-handle-undisplayer handle)
             (mm-remove-part handle)
        (when handle
         (if (mm-handle-undisplayer handle)
             (mm-remove-part handle)
-         (mm-display-part handle))))))
+         (gnus-bind-safe-url-regexp (mm-display-part handle)))))))
  
  (defun gnus-mime-action-on-part (&optional action)
    "Do something with the MIME attachment at \(point\)."
    (interactive
  
  (defun gnus-mime-action-on-part (&optional action)
    "Do something with the MIME attachment at \(point\)."
    (interactive
-   (list (completing-read "Action: " gnus-mime-action-alist nil t)))
+   (list (gnus-completing-read "Action" (mapcar 'car gnus-mime-action-alist) t)))
    (gnus-article-check-buffer)
    (let ((action-pair (assoc action gnus-mime-action-alist)))
      (if action-pair
    (gnus-article-check-buffer)
    (let ((action-pair (assoc action gnus-mime-action-alist)))
      (if action-pair
@@ -5369,7 +5487,9 @@ N is the numerical prefix."
      1))
  
  (defun gnus-article-view-part (&optional n)
      1))
  
  (defun gnus-article-view-part (&optional n)
-  "View MIME part N, which is the numerical prefix."
+  "View MIME part N, which is the numerical prefix.
+If the part is already shown, hide the part.  If N is nil, view
+all parts."
    (interactive "P")
    (with-current-buffer gnus-article-buffer
      (or (numberp n) (setq n (gnus-article-mime-match-handle-first
    (interactive "P")
    (with-current-buffer gnus-article-buffer
      (or (numberp n) (setq n (gnus-article-mime-match-handle-first
@@ -5416,7 +5536,7 @@ N is the numerical prefix."
                     (save-restriction
                       (narrow-to-region (point)
                                         (if (eobp) (point) (1+ (point))))
                     (save-restriction
                       (narrow-to-region (point)
                                         (if (eobp) (point) (1+ (point))))
-                     (mm-display-part handle)
+                     (gnus-bind-safe-url-regexp (mm-display-part handle))
                       ;; We narrow to the part itself and
                       ;; then call the treatment functions.
                       (goto-char (point-min))
                       ;; We narrow to the part itself and
                       ;; then call the treatment functions.
                       (goto-char (point-min))
@@ -5483,7 +5603,7 @@ N is the numerical prefix."
       :action 'gnus-widget-press-button
       :button-keymap gnus-mime-button-map
       :help-echo
       :action 'gnus-widget-press-button
       :button-keymap gnus-mime-button-map
       :help-echo
-     (lambda (widget/window &optional overlay pos)
+     (lambda (widget)
         ;; Needed to properly clear the message due to a bug in
         ;; wid-edit (XEmacs only).
         (if (boundp 'help-echo-owns-message)
         ;; Needed to properly clear the message due to a bug in
         ;; wid-edit (XEmacs only).
         (if (boundp 'help-echo-owns-message)
@@ -5491,14 +5611,7 @@ N is the numerical prefix."
         (format
         "%S: %s the MIME part; %S: more options"
         (aref gnus-mouse-2 0)
         (format
         "%S: %s the MIME part; %S: more options"
         (aref gnus-mouse-2 0)
-       ;; XEmacs will get a single widget arg; Emacs 21 will get
-       ;; window, overlay, position.
-       (if (mm-handle-displayed-p
-            (if overlay
-                (with-current-buffer (gnus-overlay-buffer overlay)
-                  (widget-get (widget-at (gnus-overlay-start overlay))
-                              :mime-handle))
-              (widget-get widget/window :mime-handle)))
+       (if (mm-handle-displayed-p (widget-get widget :mime-handle))
             "hide" "show")
         (aref gnus-down-mouse-3 0))))))
  
             "hide" "show")
         (aref gnus-down-mouse-3 0))))))
  
@@ -5677,7 +5790,8 @@ If displaying \"text/html\" is discouraged \(see
                    ((or (bobp) (eq (char-before (1- (point))) ?\n)) 0)
                    (t 1))))
           (when (or (not display)
                    ((or (bobp) (eq (char-before (1- (point))) ?\n)) 0)
                    (t 1))))
           (when (or (not display)
-                   (not (gnus-unbuttonized-mime-type-p type)))
+                   (not (gnus-unbuttonized-mime-type-p type))
+                   (eq id gnus-mime-buttonized-part-id))
             (gnus-insert-mime-button
              handle id (list (or display (and not-attachment text))))
             (gnus-article-insert-newline)
             (gnus-insert-mime-button
              handle id (list (or display (and not-attachment text))))
             (gnus-article-insert-newline)
@@ -5695,7 +5809,7 @@ If displaying \"text/html\" is discouraged \(see
                                        (set-buffer gnus-summary-buffer)
                                      (error))
                                    gnus-newsgroup-ignored-charsets)))
                                        (set-buffer gnus-summary-buffer)
                                      (error))
                                    gnus-newsgroup-ignored-charsets)))
-             (mm-display-part handle t))
+             (gnus-bind-safe-url-regexp (mm-display-part handle t)))
             (goto-char (point-max)))
            ((and text not-attachment)
             (when move
             (goto-char (point-max)))
            ((and text not-attachment)
             (when move
@@ -5831,7 +5945,7 @@ If displaying \"text/html\" is discouraged \(see
                   (mail-parse-ignored-charsets
                    (with-current-buffer gnus-summary-buffer
                      gnus-newsgroup-ignored-charsets)))
                   (mail-parse-ignored-charsets
                    (with-current-buffer gnus-summary-buffer
                      gnus-newsgroup-ignored-charsets)))
-             (mm-display-part preferred)
+             (gnus-bind-safe-url-regexp (mm-display-part preferred))
               ;; Do highlighting.
               (save-excursion
                 (save-restriction
               ;; Do highlighting.
               (save-excursion
                 (save-restriction
@@ -5993,39 +6107,51 @@ If given a numerical ARG, move forward ARG pages."
    (interactive "P")
    (setq arg (if arg (prefix-numeric-value arg) 0))
    (with-current-buffer gnus-article-buffer
    (interactive "P")
    (setq arg (if arg (prefix-numeric-value arg) 0))
    (with-current-buffer gnus-article-buffer
-    (goto-char (point-min))
      (widen)
      ;; Remove any old next/prev buttons.
      (when (gnus-visual-p 'page-marker)
        (let ((inhibit-read-only t))
         (gnus-remove-text-with-property 'gnus-prev)
         (gnus-remove-text-with-property 'gnus-next)))
      (widen)
      ;; Remove any old next/prev buttons.
      (when (gnus-visual-p 'page-marker)
        (let ((inhibit-read-only t))
         (gnus-remove-text-with-property 'gnus-prev)
         (gnus-remove-text-with-property 'gnus-next)))
-    (if
-       (cond ((< arg 0)
-              (re-search-backward page-delimiter nil 'move (1+ (abs arg))))
-             ((> arg 0)
-              (re-search-forward page-delimiter nil 'move arg)))
-       (goto-char (match-end 0))
-      (save-excursion
-       (goto-char (point-min))
-       (setq gnus-page-broken
-             (and (re-search-forward page-delimiter nil t) t))))
-    (when gnus-page-broken
-      (narrow-to-region
-       (point)
-       (if (re-search-forward page-delimiter nil 'move)
-          (match-beginning 0)
-        (point)))
-      (when (and (gnus-visual-p 'page-marker)
-                (> (point-min) (save-restriction (widen) (point-min))))
-       (save-excursion
-         (goto-char (point-min))
-         (gnus-insert-prev-page-button)))
-      (when (and (gnus-visual-p 'page-marker)
-                (< (point-max) (save-restriction (widen) (point-max))))
-       (save-excursion
-         (goto-char (point-max))
-         (gnus-insert-next-page-button))))))
+    (let (st nd pt)
+      (when (save-excursion
+             (cond ((< arg 0)
+                    (if (re-search-backward page-delimiter nil 'move (abs arg))
+                        (prog1
+                            (setq nd (match-beginning 0)
+                                  pt nd)
+                          (when (re-search-backward page-delimiter nil t)
+                            (setq st (match-end 0))))
+                      (when (re-search-forward page-delimiter nil t)
+                        (setq nd (match-beginning 0)
+                              pt (point-min)))))
+                   ((> arg 0)
+                    (if (re-search-forward page-delimiter nil 'move arg)
+                        (prog1
+                            (setq st (match-end 0)
+                                  pt st)
+                          (when (re-search-forward page-delimiter nil t)
+                            (setq nd (match-beginning 0))))
+                      (when (re-search-backward page-delimiter nil t)
+                        (setq st (match-end 0)
+                              pt (point-max)))))
+                   (t
+                    (when (re-search-backward page-delimiter nil t)
+                      (goto-char (setq st (match-end 0))))
+                    (when (re-search-forward page-delimiter nil t)
+                      (setq nd (match-beginning 0)))
+                    (or st nd))))
+       (setq gnus-page-broken t)
+       (when pt (goto-char pt))
+       (narrow-to-region (or st (point-min)) (or nd (point-max)))
+       (when (gnus-visual-p 'page-marker)
+         (save-excursion
+           (when nd
+             (goto-char nd)
+             (gnus-insert-next-page-button))
+           (when st
+             (goto-char st)
+             (gnus-insert-prev-page-button))))))))
  
  ;; Article mode commands
  
  
  ;; Article mode commands
  
@@ -6040,7 +6166,7 @@ If given a numerical ARG, move forward ARG pages."
  (defun gnus-article-goto-prev-page ()
    "Show the previous page of the article."
    (interactive)
  (defun gnus-article-goto-prev-page ()
    "Show the previous page of the article."
    (interactive)
-  (if (bobp)
+  (if (save-restriction (widen) (bobp)) ;; Real beginning-of-buffer?
        (gnus-article-read-summary-keys nil (gnus-character-to-event ?p))
      (gnus-article-prev-page nil)))
  
        (gnus-article-read-summary-keys nil (gnus-character-to-event ?p))
      (gnus-article-prev-page nil)))
  
@@ -6063,13 +6189,12 @@ If given a numerical ARG, move forward ARG pages."
  If end of article, return non-nil.  Otherwise return nil.
  Argument LINES specifies lines to be scrolled up."
    (interactive "p")
  If end of article, return non-nil.  Otherwise return nil.
  Argument LINES specifies lines to be scrolled up."
    (interactive "p")
-  (move-to-window-line -1)
+  (move-to-window-line (if (featurep 'xemacs) -1 (- -1 scroll-margin)))
    (if (and (not (and gnus-article-over-scroll
                      (> (count-lines (window-start) (point-max))
    (if (and (not (and gnus-article-over-scroll
                      (> (count-lines (window-start) (point-max))
-                       (+ (or lines (1- (window-height)))
-                          (or (and (boundp 'scroll-margin)
-                                   (symbol-value 'scroll-margin))
-                              0)))))
+                       (if (featurep 'xemacs)
+                           (or lines (1- (window-height)))
+                         (+ (or lines (1- (window-height))) scroll-margin)))))
            (save-excursion
              (end-of-line)
              (and (pos-visible-in-window-p)     ;Not continuation line.
            (save-excursion
              (end-of-line)
              (and (pos-visible-in-window-p)     ;Not continuation line.
@@ -6091,29 +6216,24 @@ Argument LINES specifies lines to be scrolled up."
      (gnus-article-next-page-1 lines)
      nil))
  
      (gnus-article-next-page-1 lines)
      nil))
  
-(defmacro gnus-article-beginning-of-window ()
+(defun gnus-article-beginning-of-window ()
    "Move point to the beginning of the window.
  In Emacs, the point is placed at the line number which `scroll-margin'
  specifies."
    (if (featurep 'xemacs)
    "Move point to the beginning of the window.
  In Emacs, the point is placed at the line number which `scroll-margin'
  specifies."
    (if (featurep 'xemacs)
-      '(move-to-window-line 0)
-    '(move-to-window-line
-      (min (max 0 scroll-margin)
-          (max 1 (- (window-height)
-                    (if mode-line-format 1 0)
-                    (if header-line-format 1 0)))))))
+      (move-to-window-line 0)
+    ;; There is an obscure bug in Emacs that makes it impossible to
+    ;; scroll past big pictures in the article buffer.  Try to fix
+    ;; this by adding a sanity check by counting the lines visible.
+    (when (> (count-lines (window-start) (window-end)) 30)
+      (move-to-window-line
+       (min (max 0 scroll-margin)
+           (max 1 (- (window-height)
+                     (if mode-line-format 1 0)
+                     (if header-line-format 1 0)
+                     2)))))))
  
  (defun gnus-article-next-page-1 (lines)
  
  (defun gnus-article-next-page-1 (lines)
-  (when (and (not (featurep 'xemacs))
-            (numberp lines)
-            (> lines 0)
-            (numberp (symbol-value 'scroll-margin))
-            (> (symbol-value 'scroll-margin) 0))
-    ;; Protect against the bug that Emacs 21.x hangs up when scrolling up for
-    ;; too many number of lines if `scroll-margin' is set as two or greater.
-    (setq lines (min lines
-                    (max 0 (- (count-lines (window-start) (point-max))
-                              (symbol-value 'scroll-margin))))))
    (condition-case ()
        (let ((scroll-in-place nil))
         (scroll-up lines))
    (condition-case ()
        (let ((scroll-in-place nil))
         (scroll-up lines))
@@ -6135,9 +6255,9 @@ Argument LINES specifies lines to be scrolled down."
         (goto-char (point-max))
         (recenter (if gnus-article-over-scroll
                       (if lines
         (goto-char (point-max))
         (recenter (if gnus-article-over-scroll
                       (if lines
-                         (max (+ lines (or (and (boundp 'scroll-margin)
-                                                (symbol-value 'scroll-margin))
-                                           0))
+                         (max (if (featurep 'xemacs)
+                                  lines
+                                (+ lines scroll-margin))
                                3)
                         (- (window-height) 2))
                     -1)))
                                3)
                         (- (window-height) 2))
                     -1)))
@@ -6192,28 +6312,7 @@ not have a face in `gnus-article-boring-faces'."
  (defun gnus-article-describe-briefly ()
    "Describe article mode commands briefly."
    (interactive)
  (defun gnus-article-describe-briefly ()
    "Describe article mode commands briefly."
    (interactive)
-  (gnus-message 6 (substitute-command-keys "\\<gnus-article-mode-map>\\[gnus-article-goto-next-page]:Next page  \\[gnus-article-goto-prev-page]:Prev page  \\[gnus-article-show-summary]:Show summary  \\[gnus-info-find-node]:Run Info  \\[gnus-article-describe-briefly]:This help")))
-
-(defun gnus-article-summary-command ()
-  "Execute the last keystroke in the summary buffer."
-  (interactive)
-  (let ((obuf (current-buffer))
-       (owin (current-window-configuration))
-       func)
-    (switch-to-buffer gnus-article-current-summary 'norecord)
-    (setq func (lookup-key (current-local-map) (this-command-keys)))
-    (call-interactively func)
-    (set-buffer obuf)
-    (set-window-configuration owin)
-    (set-window-point (get-buffer-window (current-buffer)) (point))))
-
-(defun gnus-article-summary-command-nosave ()
-  "Execute the last keystroke in the summary buffer."
-  (interactive)
-  (let (func)
-    (pop-to-buffer gnus-article-current-summary)
-    (setq func (lookup-key (current-local-map) (this-command-keys)))
-    (call-interactively func)))
+  (gnus-message 6 "%s" (substitute-command-keys "\\<gnus-article-mode-map>\\[gnus-article-goto-next-page]:Next page     \\[gnus-article-goto-prev-page]:Prev page  \\[gnus-article-show-summary]:Show summary  \\[gnus-info-find-node]:Run Info  \\[gnus-article-describe-briefly]:This help")))
  
  (defun gnus-article-check-buffer ()
    "Beep if not in an article buffer."
  
  (defun gnus-article-check-buffer ()
    "Beep if not in an article buffer."
@@ -6257,7 +6356,7 @@ not have a face in `gnus-article-boring-faces'."
           (pop-to-buffer gnus-article-current-summary)
           ;; We disable the pick minor mode commands.
           (let (gnus-pick-mode)
           (pop-to-buffer gnus-article-current-summary)
           ;; We disable the pick minor mode commands.
           (let (gnus-pick-mode)
-           (setq func (lookup-key (current-local-map) keys))))
+           (setq func (key-binding keys t))))
         (if (or (not func)
                 (numberp func))
             (ding)
         (if (or (not func)
                 (numberp func))
             (ding)
@@ -6282,9 +6381,9 @@ not have a face in `gnus-article-boring-faces'."
                  (gnus-configure-windows 'article)
                  (unless (setq win (get-buffer-window summary-buffer 'visible))
                    (let ((gnus-buffer-configuration
                  (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))))))
+                         '((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))
                      (gnus-configure-windows 'article))
                    (setq win (get-buffer-window summary-buffer 'visible)))
                  (gnus-select-frame-set-input-focus (window-frame win))
@@ -6292,7 +6391,7 @@ not have a face in `gnus-article-boring-faces'."
         (setq in-buffer (current-buffer))
         ;; We disable the pick minor mode commands.
         (if (and (setq func (let (gnus-pick-mode)
         (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)))
+                             (key-binding keys t)))
                  (functionp func)
                  (condition-case code
                      (progn
                  (functionp func)
                  (condition-case code
                      (progn
@@ -6324,6 +6423,7 @@ not have a face in `gnus-article-boring-faces'."
                                       (point))))
                 (when (and (not not-restore-window)
                            new-sum-point
                                       (point))))
                 (when (and (not not-restore-window)
                            new-sum-point
+                          (window-live-p win)
                            (with-current-buffer (window-buffer win)
                              (eq major-mode 'gnus-summary-mode)))
                   (set-window-point win new-sum-point)
                            (with-current-buffer (window-buffer win)
                              (eq major-mode 'gnus-summary-mode)))
                   (set-window-point win new-sum-point)
@@ -6385,6 +6485,11 @@ KEY is a string or a vector."
  ;;`gnus-agent-mode' in gnus-agent.el will define it.
  (defvar gnus-agent-summary-mode)
  (defvar gnus-draft-mode)
  ;;`gnus-agent-mode' in gnus-agent.el will define it.
  (defvar gnus-agent-summary-mode)
  (defvar gnus-draft-mode)
+;; Calling help-buffer will autoload help-mode.
+(defvar help-xref-stack-item)
+;; Emacs 22 doesn't load it in the batch mode.
+(eval-when-compile
+  (autoload 'help-buffer "help-mode"))
  
  (defun gnus-article-describe-bindings (&optional prefix)
    "Show a list of all defined keys, and their definitions.
  
  (defun gnus-article-describe-bindings (&optional prefix)
    "Show a list of all defined keys, and their definitions.
@@ -6395,10 +6500,17 @@ then we display only bindings that start with that prefix."
    (let ((keymap (copy-keymap gnus-article-mode-map))
         (map (copy-keymap gnus-article-send-map))
         (sumkeys (where-is-internal 'gnus-article-read-summary-keys))
    (let ((keymap (copy-keymap gnus-article-mode-map))
         (map (copy-keymap gnus-article-send-map))
         (sumkeys (where-is-internal 'gnus-article-read-summary-keys))
-       agent draft)
+       parent agent draft)
      (define-key keymap "S" map)
      (define-key map [t] nil)
      (with-current-buffer gnus-article-current-summary
      (define-key keymap "S" map)
      (define-key map [t] nil)
      (with-current-buffer gnus-article-current-summary
+      (set-keymap-parent
+       keymap
+       (if (setq parent (keymap-parent gnus-article-mode-map))
+          (prog1
+              (setq parent (copy-keymap parent))
+            (set-keymap-parent parent (current-local-map)))
+        (current-local-map)))
        (set-keymap-parent map (key-binding "S"))
        (let (key def gnus-pick-mode)
         (while sumkeys
        (set-keymap-parent map (key-binding "S"))
        (let (key def gnus-pick-mode)
         (while sumkeys
@@ -6428,9 +6540,7 @@ then we display only bindings that start with that prefix."
                     (with-current-buffer ,(current-buffer)
                       (gnus-article-describe-bindings prefix)))
                   ,prefix)))
                     (with-current-buffer ,(current-buffer)
                       (gnus-article-describe-bindings prefix)))
                   ,prefix)))
-      (with-current-buffer (if (fboundp 'help-buffer)
-                              (let (help-xref-following) (help-buffer))
-                            "*Help*") ;; Emacs 21
+      (with-current-buffer (let (help-xref-following) (help-buffer))
         (setq help-xref-stack-item item)))))
  
  (defun gnus-article-reply-with-original (&optional wide)
         (setq help-xref-stack-item item)))))
  
  (defun gnus-article-reply-with-original (&optional wide)
@@ -6575,7 +6685,13 @@ If given a prefix, show the hidden text instead."
                  (with-current-buffer gnus-original-article-buffer
                    (and (equal (car gnus-original-article) group)
                         (eq (cdr gnus-original-article) article))))
                  (with-current-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)
+            ;; `insert-buffer-substring' would incorrectly use the
+            ;; equivalent of string-make-multibyte which amount to decoding
+            ;; with locale-coding-system, causing failure of
+            ;; subsequent decoding.
+            (insert (mm-string-to-multibyte
+                     (with-current-buffer gnus-original-article-buffer
+                       (buffer-substring (point-min) (point-max)))))
             'article)
            ;; Check the backlog.
            ((and gnus-keep-backlog
             'article)
            ;; Check the backlog.
            ((and gnus-keep-backlog
@@ -6678,6 +6794,18 @@ If given a prefix, show the hidden text instead."
                             (point))
           (set-buffer buf))))))
  
                             (point))
           (set-buffer buf))))))
  
+(defun gnus-block-private-groups (group)
+  (if (gnus-news-group-p group)
+      ;; Block nothing in news groups.
+      nil
+    ;; Block everything anywhere else.
+    "."))
+
+(defun gnus-blocked-images ()
+  (if (functionp gnus-blocked-images)
+      (funcall gnus-blocked-images gnus-newsgroup-name)
+    gnus-blocked-images))
+
  ;;;
  ;;; Article editing
  ;;;
  ;;;
  ;;; Article editing
  ;;;
@@ -6821,9 +6949,7 @@ groups."
        (gnus-backlog-remove-article
         (car gnus-article-current) (cdr gnus-article-current)))
      ;; Flush original article as well.
        (gnus-backlog-remove-article
         (car gnus-article-current) (cdr gnus-article-current)))
      ;; Flush original article as well.
-    (when (get-buffer gnus-original-article-buffer)
-      (with-current-buffer gnus-original-article-buffer
-       (setq gnus-original-article nil)))
+    (gnus-flush-original-article-buffer)
      (when gnus-use-cache
        (gnus-cache-update-article
         (car gnus-article-current) (cdr gnus-article-current)))
      (when gnus-use-cache
        (gnus-cache-update-article
         (car gnus-article-current) (cdr gnus-article-current)))
@@ -6837,6 +6963,11 @@ groups."
      (set-window-point (get-buffer-window buf) (point)))
    (gnus-summary-show-article))
  
      (set-window-point (get-buffer-window buf) (point)))
    (gnus-summary-show-article))
  
+(defun gnus-flush-original-article-buffer ()
+  (when (get-buffer gnus-original-article-buffer)
+    (with-current-buffer gnus-original-article-buffer
+      (setq gnus-original-article nil))))
+
  (defun gnus-article-edit-exit ()
    "Exit the article editing without updating."
    (interactive)
  (defun gnus-article-edit-exit ()
    "Exit the article editing without updating."
    (interactive)
@@ -6887,7 +7018,8 @@ groups."
          (concat
           "\\(?:"
           ;; Match paired parentheses, e.g. in Wikipedia URLs:
          (concat
           "\\(?:"
           ;; Match paired parentheses, e.g. in Wikipedia URLs:
-         "[" chars punct "]+" "(" "[" chars punct "]+" "[" chars "]*)" "[" chars "]"
+         ;; http://thread.gmane.org/47B4E3B2.3050402@gmail.com
+         "[" chars punct "]+" "(" "[" chars punct "]+" "[" chars "]*)" "[" chars "]*"
           "\\|"
           "[" chars punct     "]+" "[" chars "]"
           "\\)"))
           "\\|"
           "[" chars punct     "]+" "[" chars "]"
           "\\)"))
@@ -6924,46 +7056,6 @@ man page."
                  (function :tag "Other"))
    :group 'gnus-article-buttons)
  
                  (function :tag "Other"))
    :group 'gnus-article-buttons)
  
-(defcustom gnus-ctan-url "http://tug.ctan.org/tex-archive/"
-  "Top directory of a CTAN \(Comprehensive TeX Archive Network\) archive.
-If the default site is too slow, try to find a CTAN mirror, see
-<URL:http://tug.ctan.org/tex-archive/CTAN.sites?action=/index.html>.  See also
-the variable `gnus-button-handle-ctan'."
-  :version "22.1"
-  :group 'gnus-article-buttons
-  :link '(custom-manual "(gnus)Group Parameters")
-  :type '(choice (const "http://www.tex.ac.uk/tex-archive/")
-                (const "http://tug.ctan.org/tex-archive/")
-                (const "http://www.dante.de/CTAN/")
-                (string :tag "Other")))
-
-(defcustom gnus-button-ctan-handler 'browse-url
-  "Function to use for displaying CTAN links.
-The function must take one argument, the string naming the URL."
-  :version "22.1"
-  :type '(choice (function-item :tag "Browse Url" browse-url)
-                (function :tag "Other"))
-  :group 'gnus-article-buttons)
-
-(defcustom gnus-button-handle-ctan-bogus-regexp "^/?tex-archive/\\|^/"
-  "Bogus strings removed from CTAN URLs."
-  :version "22.1"
-  :group 'gnus-article-buttons
-  :type '(choice (const "^/?tex-archive/\\|/")
-                (regexp :tag "Other")))
-
-(defcustom gnus-button-ctan-directory-regexp
-  (regexp-opt
-   (list "archive-tools" "biblio" "bibliography" "digests" "documentation"
-        "dviware" "fonts" "graphics" "help" "indexing" "info" "language"
-        "languages" "macros" "nonfree" "obsolete" "support" "systems"
-        "tds" "tools" "usergrps" "web") t)
-  "Regular expression for ctan directories.
-It should match all directories in the top level of `gnus-ctan-url'."
-  :version "22.1"
-  :group 'gnus-article-buttons
-  :type 'regexp)
-
  (defcustom gnus-button-mid-or-mail-regexp
    (concat "\\b\\(<?" gnus-button-valid-localpart-regexp "@"
           gnus-button-valid-fqdn-regexp
  (defcustom gnus-button-mid-or-mail-regexp
    (concat "\\b\\(<?" gnus-button-valid-localpart-regexp "@"
           gnus-button-valid-fqdn-regexp
@@ -7221,26 +7313,6 @@ Calls `describe-variable' or `describe-function'."
         (gnus-message 1 "Cannot locale library `%s'." url)
        (find-file-read-only file))))
  
         (gnus-message 1 "Cannot locale library `%s'." url)
        (find-file-read-only file))))
  
-(defun gnus-button-handle-ctan (url)
-  "Call `browse-url' when pushing a CTAN URL button."
-  (funcall
-   gnus-button-ctan-handler
-   (concat
-    gnus-ctan-url
-    (gnus-replace-in-string url gnus-button-handle-ctan-bogus-regexp ""))))
-
-(defcustom gnus-button-tex-level 5
-  "*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
-specific groups.  Setting it higher in TeX groups is probably a good idea.
-See Info node `(gnus)Group Parameters' and the variable `gnus-parameters' on
-how to set variables in specific groups."
-  :version "22.1"
-  :group 'gnus-article-buttons
-  :link '(custom-manual "(gnus)Group Parameters")
-  :type 'integer)
-
  (defcustom gnus-button-man-level 5
    "*Integer that says how many man-related buttons Gnus will show.
  The higher the number, the more buttons will appear and the more false
  (defcustom gnus-button-man-level 5
    "*Integer that says how many man-related buttons Gnus will show.
  The higher the number, the more buttons will appear and the more false
@@ -7307,21 +7379,11 @@ positives are possible."
       0 (>= gnus-button-message-level 0) gnus-url-mailto 1)
      ("\\bmailto:\\([^ \n\t]+\\)"
       0 (>= gnus-button-message-level 0) gnus-url-mailto 1)
       0 (>= gnus-button-message-level 0) gnus-url-mailto 1)
      ("\\bmailto:\\([^ \n\t]+\\)"
       0 (>= gnus-button-message-level 0) gnus-url-mailto 1)
-    ;; CTAN
-    ((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
-            "/[-_.a-z0-9/]+[-_./a-z0-9]+[/a-z0-9]\\)")
-     1 (>= gnus-button-tex-level 6) gnus-button-handle-ctan 1)
-    ((concat
-      "\\b\\("
-      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 (home-grown style) <info://foo/bar+baz>
+    ;; Info Konqueror style <info:/foo/bar baz>.
+    ;; Must come before " Gnus home-grown style".
+    ("\\binfo://?\\([^'\">\n\t]+\\)"
+     0 (>= gnus-button-emacs-level 1) gnus-button-handle-info-url 1)
+   ;; Info, Gnus home-grown style (deprecated) <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 ]+\\)"
       0 (>= gnus-button-emacs-level 1) gnus-button-handle-info-url 1)
      ;; Info GNOME style <info:foo#bar_baz>
@@ -7332,9 +7394,9 @@ positives are possible."
       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)
       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"
-     ;; Info links like `C-h i d m CC Mode RET'
-     0 (>= gnus-button-emacs-level 1) gnus-button-handle-info-keystrokes 2)
+    ("\\b\\(C-h\\|<?[Ff]1>?\\)[ \t\n]+i[ \t\n]+d?[ \t\n]?m[ \t\n]+[^ ]+ ?[^ ]+[ \t\n]+RET\\([ \t\n]+i[ \t\n]+[^ ]+ ?[^ ]+[ \t\n]+RET\\([ \t\n,]*\\)\\)?"
+     ;; Info links like `C-h i d m Gnus RET' or `C-h i d m Gnus RET i partial RET'
+     0 (>= gnus-button-emacs-level 1) gnus-button-handle-info-keystrokes 0)
      ;; This is custom
      ("M-x[ \t\n]\\(customize-[^ ]+\\)[ \t\n]RET[ \t\n]\\([^ ]+\\)[ \t\n]RET" 0
       (>= gnus-button-emacs-level 1) gnus-button-handle-custom 1 2)
      ;; This is custom
      ("M-x[ \t\n]\\(customize-[^ ]+\\)[ \t\n]RET[ \t\n]\\([^ ]+\\)[ \t\n]RET" 0
       (>= gnus-button-emacs-level 1) gnus-button-handle-custom 1 2)
@@ -7615,7 +7677,11 @@ specified by `gnus-button-alist'."
               (unless (and (eq (car entry) 'gnus-button-url-regexp)
                            (gnus-article-extend-url-button from start end))
                 (gnus-article-add-button start end
               (unless (and (eq (car entry) 'gnus-button-url-regexp)
                            (gnus-article-extend-url-button from start end))
                 (gnus-article-add-button start end
-                                        'gnus-button-push from)))))))))
+                                        'gnus-button-push from)
+               (gnus-put-text-property
+                start end
+                'gnus-string (buffer-substring-no-properties
+                              start end))))))))))
  
  (defun gnus-article-extend-url-button (beg start end)
    "Extend url button if url is folded into two or more lines.
  
  (defun gnus-article-extend-url-button (beg start end)
    "Extend url button if url is folded into two or more lines.
@@ -7707,7 +7773,7 @@ url is put as the `gnus-button-url' overlay property on the button."
  
  ;;; External functions:
  
  
  ;;; External functions:
  
-(defun gnus-article-add-button (from to fun &optional data)
+(defun gnus-article-add-button (from to fun &optional data text)
    "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 nil t)
    "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 nil t)
@@ -7719,8 +7785,21 @@ url is put as the `gnus-button-url' overlay property on the button."
           (list 'gnus-callback fun)
           (and data (list 'gnus-data data))))
    (widget-convert-button 'link from to :action 'gnus-widget-press-button
           (list 'gnus-callback fun)
           (and data (list 'gnus-data data))))
    (widget-convert-button 'link from to :action 'gnus-widget-press-button
+                        :help-echo (or text "Follow the link")
+                        :keymap gnus-url-button-map
                          :button-keymap gnus-widget-button-keymap))
  
                          :button-keymap gnus-widget-button-keymap))
  
+(defun gnus-article-copy-string ()
+  "Copy the string in the button to the kill ring."
+  (interactive)
+  (gnus-article-check-buffer)
+  (let ((data (get-text-property (point) 'gnus-string)))
+    (when data
+      (with-temp-buffer
+       (insert data)
+       (copy-region-as-kill (point-min) (point-max))
+       (message "Copied %s" data)))))
+
  ;;; Internal functions:
  
  (defun gnus-article-set-globals ()
  ;;; Internal functions:
  
  (defun gnus-article-set-globals ()
@@ -7834,7 +7913,8 @@ url is put as the `gnus-button-url' overlay property on the button."
      (unless file
        (error "Couldn't find library %s" library))
      (find-file file)
      (unless file
        (error "Couldn't find library %s" library))
      (find-file file)
-    (goto-line (string-to-number line))))
+    (goto-char (point-min))
+    (forward-line (1- (string-to-number line)))))
  
  (defun gnus-button-handle-man (url)
    "Fetch a man page."
  
  (defun gnus-button-handle-man (url)
    "Fetch a man page."
@@ -7880,13 +7960,40 @@ url is put as the `gnus-button-url' overlay property on the button."
  
  ;; (info) will autoload info.el
  (declare-function Info-menu "info" (menu-item &optional fork))
  
  ;; (info) will autoload info.el
  (declare-function Info-menu "info" (menu-item &optional fork))
+(declare-function Info-index-next "info" (num))
  
  (defun gnus-button-handle-info-keystrokes (url)
    "Call `info' when pushing the corresponding URL button."
  
  (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'.
-  (info)
-  (Info-directory)
-  (Info-menu url))
+  ;; For links like `C-h i d m gnus RET part RET , ,', `C-h i d m CC Mode RET'.
+  (let (node indx comma)
+    (if (string-match
+        (concat "\\b\\(C-h\\|<?[Ff]1>?\\)[ \t\n]+i[ \t\n]+d?[ \t\n]?m[ \t\n]+"
+                "\\([^ ]+ ?[^ ]+\\)[ \t\n]+RET"
+                "\\([ \t\n]+i[ \t\n]+[^ ]+ ?[^ ]+[ \t\n]+RET"
+                "\\(?:[ \t\n,]*\\)\\)?")
+        url)
+       (setq node (match-string 2 url)
+             indx (match-string 3 url))
+      (error "Can't parse %s" url))
+    (info)
+    (Info-directory)
+    (Info-menu node)
+    (when (> (length indx) 0)
+      (string-match (concat "[ \t\n]+i[ \t\n]+\\([^ ]+ ?[^ ]+\\)[ \t\n]+RET"
+                           "\\([ \t\n,]*\\)")
+                   indx)
+      (setq comma (match-string 2 indx))
+      (setq indx  (match-string 1 indx))
+      (Info-index indx)
+      (when comma
+       (dotimes (i (with-temp-buffer
+                     (insert comma)
+                     ;; Note: the XEmacs version of `how-many' takes
+                     ;; no optional argument.
+                     (goto-char (point-min))
+                     (how-many ",")))
+         (Info-index-next 1)))
+      nil)))
  
  ;; Called after pgg-snarf-keys-region, which autoloads pgg.el.
  (declare-function pgg-display-output-buffer "pgg" (start end status))
  
  ;; Called after pgg-snarf-keys-region, which autoloads pgg.el.
  (declare-function pgg-display-output-buffer "pgg" (start end status))
@@ -7991,9 +8098,6 @@ url is put as the `gnus-button-url' overlay property on the button."
  
  (defvar gnus-next-page-map
    (let ((map (make-sparse-keymap)))
  
  (defvar gnus-next-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-next-page)
      (define-key map "\r" 'gnus-button-next-page)
      map))
      (define-key map gnus-mouse-2 'gnus-button-next-page)
      (define-key map "\r" 'gnus-button-next-page)
      map))
@@ -8189,15 +8293,15 @@ For example:
    (interactive
     (list
      (or gnus-article-encrypt-protocol
    (interactive
     (list
      (or gnus-article-encrypt-protocol
-       (completing-read "Encrypt protocol: "
-                        gnus-article-encrypt-protocol-alist
-                        nil t))
+       (gnus-completing-read "Encrypt protocol"
+                              (mapcar 'car gnus-article-encrypt-protocol-alist)
+                              t))
      current-prefix-arg))
    ;; User might hit `K E' instead of `K e', so prompt once.
    (when (and gnus-article-encrypt-protocol
              gnus-novice-user)
      (unless (gnus-y-or-n-p "Really encrypt article(s)? ")
      current-prefix-arg))
    ;; User might hit `K E' instead of `K e', so prompt once.
    (when (and gnus-article-encrypt-protocol
              gnus-novice-user)
      (unless (gnus-y-or-n-p "Really encrypt article(s)? ")
-      (error "Encrypt aborted.")))
+      (error "Encrypt aborted")))
    (let ((func (cdr (assoc protocol gnus-article-encrypt-protocol-alist))))
      (unless func
        (error "Can't find the encrypt protocol %s" protocol))
    (let ((func (cdr (assoc protocol gnus-article-encrypt-protocol-alist))))
      (unless func
        (error "Can't find the encrypt protocol %s" protocol))
@@ -8253,9 +8357,7 @@ For example:
           (when gnus-keep-backlog
             (gnus-backlog-remove-article
              (car gnus-article-current) (cdr gnus-article-current)))
           (when gnus-keep-backlog
             (gnus-backlog-remove-article
              (car gnus-article-current) (cdr gnus-article-current)))
-          (when (get-buffer gnus-original-article-buffer)
-            (with-current-buffer gnus-original-article-buffer
-             (setq gnus-original-article nil)))
+         (gnus-flush-original-article-buffer)
           (when gnus-use-cache
             (gnus-cache-update-article
              (car gnus-article-current) (cdr gnus-article-current))))))))
           (when gnus-use-cache
             (gnus-cache-update-article
              (car gnus-article-current) (cdr gnus-article-current))))))))
@@ -8443,7 +8545,7 @@ For example:
       :action 'gnus-widget-press-button
       :button-keymap gnus-mime-security-button-map
       :help-echo
       :action 'gnus-widget-press-button
       :button-keymap gnus-mime-security-button-map
       :help-echo
-     (lambda (widget/window &optional overlay pos)
+     (lambda (widget)
         ;; Needed to properly clear the message due to a bug in
         ;; wid-edit (XEmacs only).
         (when (boundp 'help-echo-owns-message)
         ;; Needed to properly clear the message due to a bug in
         ;; wid-edit (XEmacs only).
         (when (boundp 'help-echo-owns-message)
@@ -8505,5 +8607,4 @@ For example:
  
  (run-hooks 'gnus-art-load-hook)
  
  
  (run-hooks 'gnus-art-load-hook)
  
-;; arch-tag: 2654516f-6279-48f9-a83b-05c1fa450c33
  ;;; gnus-art.el ends here
  ;;; gnus-art.el ends here