projects / gnus / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
* gnus-art.el (gnus-narrow-to-page): Position point properly.
[gnus] / lisp / gnus-art.el
diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el
index 488840e..e6f2592 100644 (file)
--- a/lisp/gnus-art.el
+++ b/lisp/gnus-art.el
@@ -1,7 +1,7 @@
 ;;; gnus-art.el --- article mode commands for Gnus
 
 ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
 ;;; gnus-art.el --- article mode commands for Gnus
 
 ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;;   2005, 2006, 2007 Free Software Foundation, Inc.
+;;   2005, 2006, 2007, 2008 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news
@@ -27,10 +27,13 @@
 
 ;;; Code:
 
 
 ;;; Code:
 
+;; For Emacs < 22.2.
+(eval-and-compile
+  (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
 (eval-when-compile
 (eval-when-compile
-  (require 'cl)
-  (defvar tool-bar-map)
-  (defvar w3m-minor-mode-map))
+  (require 'cl))
+(defvar tool-bar-map)
+(defvar w3m-minor-mode-map)
 
 (require 'gnus)
 ;; Avoid the "Recursive load suspected" error in Emacs 21.1.
 
 (require 'gnus)
 ;; Avoid the "Recursive load suspected" error in Emacs 21.1.
@@ -715,7 +718,7 @@ The following additional specs are available:
 (defcustom gnus-copy-article-ignored-headers nil
   "List of headers to be removed when copying an article.
 Each element is a regular expression."
 (defcustom gnus-copy-article-ignored-headers nil
   "List of headers to be removed when copying an article.
 Each element is a regular expression."
-  :version "23.0" ;; No Gnus
+  :version "23.1" ;; No Gnus
   :type '(repeat regexp)
   :group 'gnus-article-various)
 
   :type '(repeat regexp)
   :group 'gnus-article-various)
 
@@ -882,7 +885,7 @@ See the manual for the valid properties for various image types.
 Currently, `pbm' is used for X-Face images and `png' is used for Face
 images in Emacs.  Only the `:face' property is effective on the `xface'
 image type in XEmacs if it is built with the libcompface library."
 Currently, `pbm' is used for X-Face images and `png' is used for Face
 images in Emacs.  Only the `:face' property is effective on the `xface'
 image type in XEmacs if it is built with the libcompface library."
-  :version "23.0" ;; No Gnus
+  :version "23.1" ;; No Gnus
   :group 'gnus-article-headers
   :type '(repeat (cons :format "%v" (symbol :tag "Image type") plist)))
 
   :group 'gnus-article-headers
   :type '(repeat (cons :format "%v" (symbol :tag "Image type") plist)))
 
@@ -1054,7 +1057,7 @@ used."
 When 0, point will be placed on the same part as before.  When
 positive (negative), move point forward (backwards) this many
 parts.  When nil, redisplay article."
 When 0, point will be placed on the same part as before.  When
 positive (negative), move point forward (backwards) this many
 parts.  When nil, redisplay article."
-  :version "23.0" ;; No Gnus
+  :version "23.1" ;; No Gnus
   :group 'gnus-article-mime
   :type '(choice (const nil :tag "Redisplay article.")
                 (const 1 :tag "Next part.")
   :group 'gnus-article-mime
   :type '(choice (const nil :tag "Redisplay article.")
                 (const 1 :tag "Next part.")
@@ -1116,10 +1119,7 @@ predicate.  See Info node `(gnus)Customizing Articles'."
   :type gnus-article-treat-head-custom)
 (put 'gnus-treat-buttonize-head 'highlight t)
 
   :type gnus-article-treat-head-custom)
 (put 'gnus-treat-buttonize-head 'highlight t)
 
-(defcustom gnus-treat-emphasize
-  (and (or window-system
-          (featurep 'xemacs))
-       50000)
+(defcustom gnus-treat-emphasize 50000
   "Emphasize text.
 Valid values are nil, t, `head', `first', `last', an integer or a
 predicate.  See Info node `(gnus)Customizing Articles'."
   "Emphasize text.
 Valid values are nil, t, `head', `first', `last', an integer or a
 predicate.  See Info node `(gnus)Customizing Articles'."
@@ -1362,7 +1362,7 @@ If it is a regexp, only long headers matching this regexp are unfolded.
 If it is t, all long headers are unfolded.
 
 This variable has no effect if `gnus-treat-unfold-headers' is nil."
 If it is t, all long headers are unfolded.
 
 This variable has no effect if `gnus-treat-unfold-headers' is nil."
-  :version "23.0" ;; No Gnus
+  :version "23.1" ;; No Gnus
   :group 'gnus-article-treat
   :type '(choice (const nil)
                 (const :tag "all" t)
   :group 'gnus-article-treat
   :type '(choice (const nil)
                 (const :tag "all" t)
@@ -1518,11 +1518,12 @@ node `(gnus)Picons' for details."
 (put 'gnus-treat-newsgroups-picon 'highlight t)
 
 (defcustom gnus-treat-body-boundary
 (put 'gnus-treat-newsgroups-picon 'highlight t)
 
 (defcustom gnus-treat-body-boundary
-  (if (and (eq window-system 'x)
-          (or gnus-treat-newsgroups-picon
-              gnus-treat-mail-picon
-              gnus-treat-from-picon))
-      'head nil)
+  (if (or gnus-treat-newsgroups-picon
+         gnus-treat-mail-picon
+         gnus-treat-from-picon)
+      ;; If there's much decoration, the user might prefer a boundery.
+      'head
+    nil)
   "Draw a boundary at the end of the headers.
 Valid values are nil and `head'.
 See Info node `(gnus)Customizing Articles' for details."
   "Draw a boundary at the end of the headers.
 Valid values are nil and `head'.
 See Info node `(gnus)Customizing Articles' for details."
@@ -1713,8 +1714,7 @@ Initialized from `text-mode-syntax-table.")
 ;;; Macros for dealing with the article buffer.
 
 (defmacro gnus-with-article-headers (&rest forms)
 ;;; Macros for dealing with the article buffer.
 
 (defmacro gnus-with-article-headers (&rest forms)
-  `(save-excursion
-     (set-buffer gnus-article-buffer)
+  `(with-current-buffer gnus-article-buffer
      (save-restriction
        (let ((inhibit-read-only t)
             (inhibit-point-motion-hooks t)
      (save-restriction
        (let ((inhibit-read-only t)
             (inhibit-point-motion-hooks t)
@@ -1726,8 +1726,7 @@ Initialized from `text-mode-syntax-table.")
 (put 'gnus-with-article-headers 'edebug-form-spec '(body))
 
 (defmacro gnus-with-article-buffer (&rest forms)
 (put 'gnus-with-article-headers 'edebug-form-spec '(body))
 
 (defmacro gnus-with-article-buffer (&rest forms)
-  `(save-excursion
-     (set-buffer gnus-article-buffer)
+  `(with-current-buffer gnus-article-buffer
      (let ((inhibit-read-only t))
        ,@forms)))
 
      (let ((inhibit-read-only t))
        ,@forms)))
 
@@ -2224,11 +2223,11 @@ unfolded."
        (mail-header-fold-field)
        (goto-char (point-max))))))
 
        (mail-header-fold-field)
        (goto-char (point-max))))))
 
-(defcustom gnus-article-truncate-lines default-truncate-lines
+(defcustom gnus-article-truncate-lines (default-value 'truncate-lines)
   "Value of `truncate-lines' in Gnus Article buffer.
 Valid values are nil, t, `head', `first', `last', an integer or a
 predicate.  See Info node `(gnus)Customizing Articles'."
   "Value of `truncate-lines' in Gnus Article buffer.
 Valid values are nil, t, `head', `first', `last', an integer or a
 predicate.  See Info node `(gnus)Customizing Articles'."
-  :version "23.0" ;; No Gnus
+  :version "23.1" ;; No Gnus
   :group 'gnus-article
   ;; :link '(custom-manual "(gnus)Customizing Articles")
   :type 'boolean)
   :group 'gnus-article
   ;; :link '(custom-manual "(gnus)Customizing Articles")
   :type 'boolean)
@@ -2334,12 +2333,11 @@ long lines iff arg is positive."
         (forward-line 1)
         (point))))))
 
         (forward-line 1)
         (point))))))
 
-(eval-when-compile
-  (defvar gnus-face-properties-alist))
+(defvar gnus-face-properties-alist)
 
 
-(defun article-display-face ()
+(defun article-display-face (&optional force)
   "Display any Face headers in the header."
   "Display any Face headers in the header."
-  (interactive)
+  (interactive (list 'force))
   (let ((wash-face-p buffer-read-only))
     (gnus-with-article-headers
       ;; When displaying parts, this function can be called several times on
   (let ((wash-face-p buffer-read-only))
     (gnus-with-article-headers
       ;; When displaying parts, this function can be called several times on
@@ -2349,7 +2347,8 @@ long lines iff arg is positive."
       ;; read-only.
       (if (and wash-face-p (memq 'face gnus-article-wash-types))
          (gnus-delete-images 'face)
       ;; read-only.
       (if (and wash-face-p (memq 'face gnus-article-wash-types))
          (gnus-delete-images 'face)
-       (let (face faces from)
+       (let ((from (message-fetch-field "from"))
+             face faces)
          (save-current-buffer
            (when (and wash-face-p
                       (gnus-buffer-live-p gnus-original-article-buffer)
          (save-current-buffer
            (when (and wash-face-p
                       (gnus-buffer-live-p gnus-original-article-buffer)
@@ -2357,16 +2356,22 @@ long lines iff arg is positive."
              (set-buffer gnus-original-article-buffer))
            (save-restriction
              (mail-narrow-to-head)
              (set-buffer gnus-original-article-buffer))
            (save-restriction
              (mail-narrow-to-head)
-             (while (gnus-article-goto-header "Face")
-               (push (mail-header-field-value) faces))))
+             (when (or force
+                       ;; Check whether this face is censored.
+                       (not (and gnus-article-x-face-too-ugly
+                                 (or from
+                                     (setq from (message-fetch-field "from")))
+                                 (string-match gnus-article-x-face-too-ugly
+                                               from))))
+               (while (gnus-article-goto-header "Face")
+                 (push (mail-header-field-value) faces)))))
          (when faces
            (goto-char (point-min))
          (when faces
            (goto-char (point-min))
-           (let ((from (gnus-article-goto-header "from"))
-                 png image)
-             (unless from
+           (let (png image)
+             (unless (setq from (gnus-article-goto-header "from"))
                (insert "From:")
                (setq from (point))
                (insert "From:")
                (setq from (point))
-               (insert "[no `from' set]\n"))
+               (insert " [no `from' set]\n"))
              (while faces
                (when (setq png (gnus-convert-face-to-png (pop faces)))
                  (setq image
              (while faces
                (when (setq png (gnus-convert-face-to-png (pop faces)))
                  (setq image
@@ -2391,7 +2396,8 @@ long lines iff arg is positive."
          ;; instead.
          (gnus-delete-images 'xface)
        ;; Display X-Faces.
          ;; instead.
          (gnus-delete-images 'xface)
        ;; Display X-Faces.
-       (let (x-faces from face)
+       (let ((from (message-fetch-field "from"))
+             x-faces face)
          (save-current-buffer
            (when (and wash-face-p
                       (gnus-buffer-live-p gnus-original-article-buffer)
          (save-current-buffer
            (when (and wash-face-p
                       (gnus-buffer-live-p gnus-original-article-buffer)
@@ -2402,43 +2408,41 @@ long lines iff arg is positive."
              (set-buffer gnus-original-article-buffer))
            (save-restriction
              (mail-narrow-to-head)
              (set-buffer gnus-original-article-buffer))
            (save-restriction
              (mail-narrow-to-head)
-             (while (gnus-article-goto-header "X-Face")
-               (push (mail-header-field-value) x-faces))
-             (setq from (message-fetch-field "from"))))
-         ;; Sending multiple EOFs to xv doesn't work, so we only do a
-         ;; single external face.
-         (when (stringp gnus-article-x-face-command)
-           (setq x-faces (list (car x-faces))))
-         (when (and x-faces
-                    gnus-article-x-face-command
-                    (or force
-                        ;; Check whether this face is censored.
-                        (not gnus-article-x-face-too-ugly)
-                        (and from
-                             (not (string-match gnus-article-x-face-too-ugly
-                                                from)))))
-           (while (setq face (pop x-faces))
-             ;; We display the face.
-             (cond ((stringp gnus-article-x-face-command)
-                    ;; The command is a string, so we interpret the command
-                    ;; as a, well, command, and fork it off.
-                    (let ((process-connection-type nil))
-                      (gnus-set-process-query-on-exit-flag
-                       (start-process
-                        "article-x-face" nil shell-file-name
-                        shell-command-switch gnus-article-x-face-command)
-                       nil)
-                      (with-temp-buffer
-                        (insert face)
-                        (process-send-region "article-x-face"
-                                             (point-min) (point-max)))
-                      (process-send-eof "article-x-face")))
-                   ((functionp gnus-article-x-face-command)
-                    ;; The command is a lisp function, so we call it.
-                    (funcall gnus-article-x-face-command face))
-                   (t
-                    (error "%s is not a function"
-                           gnus-article-x-face-command))))))))))
+             (and gnus-article-x-face-command
+                  (or force
+                      ;; Check whether this face is censored.
+                      (not (and gnus-article-x-face-too-ugly
+                                (or from
+                                    (setq from (message-fetch-field "from")))
+                                (string-match gnus-article-x-face-too-ugly
+                                              from))))
+                  (while (gnus-article-goto-header "X-Face")
+                    (push (mail-header-field-value) x-faces)))))
+         (when x-faces
+           ;; We display the face.
+           (cond ((functionp gnus-article-x-face-command)
+                  ;; The command is a lisp function, so we call it.
+                  (mapc gnus-article-x-face-command x-faces))
+                 ((stringp gnus-article-x-face-command)
+                  ;; The command is a string, so we interpret the command
+                  ;; as a, well, command, and fork it off.
+                  (let ((process-connection-type nil))
+                    (gnus-set-process-query-on-exit-flag
+                     (start-process
+                      "article-x-face" nil shell-file-name
+                      shell-command-switch gnus-article-x-face-command)
+                     nil)
+                    ;; Sending multiple EOFs to xv doesn't work,
+                    ;; so we only do a single external face.
+                    (with-temp-buffer
+                      (insert (car x-faces))
+                      (process-send-region "article-x-face"
+                                           (point-min) (point-max)))
+                    (process-send-eof "article-x-face")))
+                 (t
+                  (error "`%s' set to `%s' is not a function"
+                         gnus-article-x-face-command
+                         'gnus-article-x-face-command)))))))))
 
 (defun article-decode-mime-words ()
   "Decode all MIME-encoded words in the article."
 
 (defun article-decode-mime-words ()
   "Decode all MIME-encoded words in the article."
@@ -2702,6 +2706,9 @@ charset defined in `gnus-summary-show-article-charset-alist' is used."
             (t
              (apply (car func) (cdr func))))))))))
 
             (t
              (apply (car func) (cdr func))))))))))
 
+;; External.
+(declare-function w3-region "ext:w3-display" (st nd))
+
 (defun gnus-article-wash-html-with-w3 ()
   "Wash the current buffer with w3."
   (mm-setup-w3)
 (defun gnus-article-wash-html-with-w3 ()
   "Wash the current buffer with w3."
   (mm-setup-w3)
@@ -2713,6 +2720,9 @@ charset defined in `gnus-summary-show-article-charset-alist' is used."
        (w3-region (point-min) (point-max))
       (error))))
 
        (w3-region (point-min) (point-max))
       (error))))
 
+;; External.
+(declare-function w3m-region "ext:w3m" (start end &optional url charset))
+
 (defun gnus-article-wash-html-with-w3m ()
   "Wash the current buffer with emacs-w3m."
   (mm-setup-w3m)
 (defun gnus-article-wash-html-with-w3m ()
   "Wash the current buffer with emacs-w3m."
   (mm-setup-w3m)
@@ -2728,7 +2738,7 @@ charset defined in `gnus-summary-show-article-charset-alist' is used."
           ;; Put the mark meaning this part was rendered by emacs-w3m.
           'mm-inline-text-html-with-w3m t))))
 
           ;; Put the mark meaning this part was rendered by emacs-w3m.
           'mm-inline-text-html-with-w3m t))))
 
-(eval-when-compile (defvar charset)) ;; Bound by `article-wash-html'.
+(defvar charset) ;; Bound by `article-wash-html'.
 
 (defun gnus-article-wash-html-with-w3m-standalone ()
   "Wash the current buffer with w3m."
 
 (defun gnus-article-wash-html-with-w3m-standalone ()
   "Wash the current buffer with w3m."
@@ -2756,7 +2766,7 @@ exit from the summary buffer.  If it is the symbol `file', query
 on each file, if it is `ask' ask once when exiting from the
 summary buffer."
   :group 'gnus-article
 on each file, if it is `ask' ask once when exiting from the
 summary buffer."
   :group 'gnus-article
-  :version "23.0" ;; No Gnus
+  :version "23.1" ;; No Gnus
   :type '(choice (const :tag "Don't delete" nil)
                 (const :tag "Don't ask" t)
                 (const :tag "Ask" ask)
   :type '(choice (const :tag "Don't delete" nil)
                 (const :tag "Don't ask" t)
                 (const :tag "Ask" ask)
@@ -2770,9 +2780,9 @@ summary buffer."
             (or how
                 (setq how gnus-article-browse-delete-temp)))
     (when (and (eq how 'ask)
             (or how
                 (setq how gnus-article-browse-delete-temp)))
     (when (and (eq how 'ask)
-              (y-or-n-p (format
-                         "Delete all %s temporary HTML file(s)? "
-                         (length gnus-article-browse-html-temp-list)))
+              (gnus-y-or-n-p (format
+                              "Delete all %s temporary HTML file(s)? "
+                              (length gnus-article-browse-html-temp-list)))
               (setq how t)))
     (dolist (file gnus-article-browse-html-temp-list)
       (when (and (file-exists-p file)
               (setq how t)))
     (dolist (file gnus-article-browse-html-temp-list)
       (when (and (file-exists-p file)
@@ -2786,62 +2796,222 @@ summary buffer."
     (setq gnus-article-browse-html-temp-list nil))
   gnus-article-browse-html-temp-list)
 
     (setq gnus-article-browse-html-temp-list nil))
   gnus-article-browse-html-temp-list)
 
-(defun gnus-article-browse-html-parts (list)
+(defun gnus-article-browse-html-parts (list &optional header)
   "View all \"text/html\" parts from LIST.
   "View all \"text/html\" parts from LIST.
-Recurse into multiparts."
+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'.
   ;; Internal function used by `gnus-article-browse-html-article'.
-  (let ((showed))
+  (let (type file charset 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:
-      (when (listp handle)
-       (cond ((and (bufferp (car handle))
-                   (string-match "text/html" (car (mm-handle-type handle))))
-              (let ((tmp-file (mm-make-temp-file
-                               ;; Do we need to care for 8.3 filenames?
-                               "mm-" nil ".html")))
-                (mm-save-part-to-file handle tmp-file)
-                (add-to-list 'gnus-article-browse-html-temp-list tmp-file)
-                (add-hook 'gnus-summary-prepare-exit-hook
-                          'gnus-article-browse-delete-temp-files)
-                (add-hook 'gnus-exit-gnus-hook
-                          (lambda  ()
-                            (gnus-article-browse-delete-temp-files t)))
-                ;; FIXME: Warn if there's an <img> tag?
-                (browse-url-of-file tmp-file)
-                (setq showed t)))
-             ;; If multipart, recurse
-             ((and (stringp (car handle))
-                   (string-match "^multipart/" (car handle))
-                   (setq showed
-                         (or showed
-                             (gnus-article-browse-html-parts handle))))))))
+      (cond ((not (listp handle)))
+           ((or (equal (car (setq type (mm-handle-type handle))) "text/html")
+                (and (equal (car type) "message/external-body")
+                     (or header
+                         (setq file (or (mail-content-type-get type 'name)
+                                        (mail-content-type-get
+                                         (mm-handle-disposition handle)
+                                         'filename))))
+                     (or (mm-handle-cache handle)
+                         (condition-case code
+                             (progn (mm-extern-cache-contents handle) t)
+                           (error
+                            (gnus-message 3 "%s" (error-message-string code))
+                            (when (>= gnus-verbose 3) (sit-for 2))
+                            nil)))
+                     (progn
+                       (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 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)
+                (with-temp-buffer
+                  (mm-enable-multibyte)
+                  (setq case-fold-search t)
+                  (insert header "\n")
+                  (setq title (message-fetch-field "subject"))
+                  (goto-char (point-min))
+                  (while (re-search-forward "\\(<\\)\\|\\(>\\)\\|&" nil t)
+                    (replace-match (cond ((match-beginning 1) "&lt;")
+                                         ((match-beginning 2) "&gt;")
+                                         (t "&amp;"))))
+                  (goto-char (point-min))
+                  (insert "<pre>\n")
+                  (goto-char (point-max))
+                  (insert "</pre>\n<hr>\n")
+                  ;; We have to examine charset one by one since
+                  ;; charset specified in parts might be different.
+                  (if (eq charset 'gnus-decoded)
+                      (setq charset 'utf-8
+                            eheader (mm-encode-coding-string (buffer-string)
+                                                             charset)
+                            title (when title
+                                    (mm-encode-coding-string title charset))
+                            body (mm-encode-coding-string (mm-get-part handle)
+                                                          charset))
+                    (setq hcharset (mm-find-mime-charset-region (point-min)
+                                                                (point-max)))
+                    (cond ((= (length hcharset) 1)
+                           (setq hcharset (car hcharset)
+                                 coding (mm-charset-to-coding-system
+                                         hcharset)))
+                          ((> (length hcharset) 1)
+                           (setq hcharset 'utf-8
+                                 coding hcharset)))
+                    (if coding
+                        (if charset
+                            (progn
+                              (setq body
+                                    (mm-charset-to-coding-system charset))
+                              (if (eq coding body)
+                                  (setq eheader (mm-encode-coding-string
+                                                 (buffer-string) coding)
+                                        title (when title
+                                                (mm-encode-coding-string
+                                                 title coding))
+                                        body (mm-get-part handle))
+                                (setq charset 'utf-8
+                                      eheader (mm-encode-coding-string
+                                               (buffer-string) charset)
+                                      title (when title
+                                              (mm-encode-coding-string
+                                               title charset))
+                                      body (mm-encode-coding-string
+                                            (mm-decode-coding-string
+                                             (mm-get-part handle) body)
+                                            charset))))
+                          (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)))
+                      (setq eheader (mm-string-as-unibyte (buffer-string))
+                            body (mm-get-part handle))))
+                  (erase-buffer)
+                  (mm-disable-multibyte)
+                  (insert body)
+                  (when charset
+                    (mm-add-meta-html-tag handle charset))
+                  (when title
+                    (goto-char (point-min))
+                    (unless (search-forward "<title>" nil t)
+                      (re-search-forward "<head>\\s-*" nil t)
+                      (insert "<title>" title "</title>\n")))
+                  (goto-char (point-min))
+                  (or (re-search-forward
+                       "<body\\(?:\\s-+[^>]+\\|\\s-*\\)>\\s-*" nil t)
+                      (re-search-forward
+                       "</head\\(?:\\s-+[^>]+\\|\\s-*\\)>\\s-*" nil t))
+                  (insert eheader)
+                  (mm-write-region (point-min) (point-max)
+                                   tmp-file nil nil nil 'binary t))))
+             (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)))
+                (if (or (mm-add-meta-html-tag handle charset)
+                        (not file))
+                    (mm-write-region (point-min) (point-max)
+                                     tmp-file nil nil nil 'binary t)
+                  (setq tmp-file nil))))
+             (tmp-file
+              (mm-save-part-to-file handle tmp-file)))
+            (when tmp-file
+              (add-to-list 'gnus-article-browse-html-temp-list tmp-file))
+            (add-hook 'gnus-summary-prepare-exit-hook
+                      'gnus-article-browse-delete-temp-files)
+            (add-hook 'gnus-exit-gnus-hook
+                      (lambda  ()
+                        (gnus-article-browse-delete-temp-files t)))
+            ;; FIXME: Warn if there's an <img> tag?
+            (browse-url-of-file (or tmp-file (expand-file-name file)))
+            (setq showed t))
+           ;; If multipart, recurse
+           ((equal (mm-handle-media-supertype handle) "multipart")
+            (when (gnus-article-browse-html-parts handle header)
+              (setq showed t)))
+           ((equal (mm-handle-media-type handle) "message/rfc822")
+            (mm-with-multibyte-buffer
+              (mm-insert-part handle)
+              (setq handle (mm-dissect-buffer t t))
+              (when (and (bufferp (car handle))
+                         (stringp (car (mm-handle-type handle))))
+                (setq handle (list handle)))
+              (when header
+                (article-decode-encoded-words)
+                (let ((gnus-visible-headers
+                       (or (get 'gnus-visible-headers 'standard-value)
+                           gnus-visible-headers)))
+                  (article-hide-headers))
+                (goto-char (point-min))
+                (search-forward "\n\n" nil 'move)
+                (skip-chars-backward "\t\n ")
+                (setq header (buffer-substring (point-min) (point)))))
+            (when (prog1
+                      (gnus-article-browse-html-parts handle header)
+                    (mm-destroy-parts handle))
+              (setq showed t)))))
     showed))
 
 ;; FIXME: Documentation in texi/gnus.texi missing.
     showed))
 
 ;; FIXME: Documentation in texi/gnus.texi missing.
-(defun gnus-article-browse-html-article ()
+(defun gnus-article-browse-html-article (&optional arg)
   "View \"text/html\" parts of the current article with a WWW browser.
   "View \"text/html\" parts of the current article with a WWW browser.
+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
 
 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."
+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."
   ;; Cf. `mm-w3m-safe-url-regexp'
   ;; Cf. `mm-w3m-safe-url-regexp'
-  (interactive)
-  (save-window-excursion
-    ;; Open raw article and select the buffer
-    (gnus-summary-show-article t)
-    (gnus-summary-select-article-buffer)
-    (let ((parts (mm-dissect-buffer t t)))
+  (interactive "P")
+  (if arg
+      (gnus-summary-show-article)
+    (let ((gnus-visible-headers (or (get 'gnus-visible-headers 'standard-value)
+                                   gnus-visible-headers)))
+      (gnus-summary-show-article)))
+  (with-current-buffer gnus-article-buffer
+    (let ((header (unless arg
+                   (save-restriction
+                     (widen)
+                     (buffer-substring-no-properties
+                      (goto-char (point-min))
+                      (if (search-forward "\n\n" nil t)
+                          (match-beginning 0)
+                        (goto-char (point-max))
+                        (skip-chars-backward "\t\n ")
+                        (point))))))
+         parts)
+      (set-buffer gnus-original-article-buffer)
+      (setq parts (mm-dissect-buffer t t))
       ;; If singlepart, enforce a list.
       (when (and (bufferp (car parts))
                 (stringp (car (mm-handle-type parts))))
        (setq parts (list parts)))
       ;; Process the list
       ;; If singlepart, enforce a list.
       (when (and (bufferp (car parts))
                 (stringp (car (mm-handle-type parts))))
        (setq parts (list parts)))
       ;; Process the list
-      (unless (gnus-article-browse-html-parts parts)
+      (unless (gnus-article-browse-html-parts parts header)
        (gnus-error 3 "Mail doesn't contain a \"text/html\" part!"))
        (gnus-error 3 "Mail doesn't contain a \"text/html\" part!"))
-      (gnus-summary-show-article))))
+      (mm-destroy-parts parts)
+      (unless arg
+       (gnus-summary-show-article)))))
 
 (defun article-hide-list-identifiers ()
   "Remove list identifies from the Subject header.
 
 (defun article-hide-list-identifiers ()
   "Remove list identifies from the Subject header.
@@ -3531,9 +3701,8 @@ This format is defined by the `gnus-article-time-format' variable."
                                 gnus-newsgroup-name 'highlight-words t)))
             gnus-emphasis-alist)))))
 
                                 gnus-newsgroup-name 'highlight-words t)))
             gnus-emphasis-alist)))))
 
-(eval-when-compile
-  (defvar gnus-summary-article-menu)
-  (defvar gnus-summary-post-menu))
+(defvar gnus-summary-article-menu)
+(defvar gnus-summary-post-menu)
 
 ;;; Saving functions.
 
 
 ;;; Saving functions.
 
@@ -3547,8 +3716,7 @@ This format is defined by the `gnus-article-time-format' variable."
           (or (symbol-value (get gnus-default-article-saver :headers))
               gnus-saved-headers gnus-visible-headers))
          (gnus-article-buffer save-buffer))
           (or (symbol-value (get gnus-default-article-saver :headers))
               gnus-saved-headers gnus-visible-headers))
          (gnus-article-buffer save-buffer))
-      (save-excursion
-       (set-buffer save-buffer)
+      (with-current-buffer save-buffer
        (article-hide-headers 1 t))))
   (save-window-excursion
     (if (not gnus-default-article-saver)
        (article-hide-headers 1 t))))
   (save-window-excursion
     (if (not gnus-default-article-saver)
@@ -3873,6 +4041,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is
 
 (defun article-verify-x-pgp-sig ()
   "Verify X-PGP-Sig."
 
 (defun article-verify-x-pgp-sig ()
   "Verify X-PGP-Sig."
+  ;; <ftp://ftp.isc.org/pub/pgpcontrol/FORMAT>
   (interactive)
   (if (gnus-buffer-live-p gnus-original-article-buffer)
       (let ((sig (with-current-buffer gnus-original-article-buffer
   (interactive)
   (if (gnus-buffer-live-p gnus-original-article-buffer)
       (let ((sig (with-current-buffer gnus-original-article-buffer
@@ -3952,7 +4121,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is
       (canlock-verify gnus-original-article-buffer)))
 
 (eval-and-compile
       (canlock-verify gnus-original-article-buffer)))
 
 (eval-and-compile
-  (mapcar
+  (mapc
    (lambda (func)
      (let (afunc gfunc)
        (if (consp func)
    (lambda (func)
      (let (afunc gfunc)
        (if (consp func)
@@ -3965,8 +4134,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is
           `(lambda (&optional interactive &rest args)
              ,(documentation afunc t)
              (interactive (list t))
           `(lambda (&optional interactive &rest args)
              ,(documentation afunc t)
              (interactive (list t))
-             (save-excursion
-               (set-buffer gnus-article-buffer)
+             (with-current-buffer gnus-article-buffer
                (if interactive
                    (call-interactively ',afunc)
                  (apply ',afunc args))))))))
                (if interactive
                    (call-interactively ',afunc)
                  (apply ',afunc args))))))))
@@ -4013,7 +4181,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is
      article-emphasize
      article-treat-dumbquotes
      article-normalize-headers
      article-emphasize
      article-treat-dumbquotes
      article-normalize-headers
-;;     (article-show-all . gnus-article-show-all-headers)
+     ;;(article-show-all . gnus-article-show-all-headers)
      )))
 \f
 ;;;
      )))
 \f
 ;;;
@@ -4043,6 +4211,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is
   "F" gnus-article-followup-with-original
   "\C-hk" gnus-article-describe-key
   "\C-hc" gnus-article-describe-key-briefly
   "F" gnus-article-followup-with-original
   "\C-hk" gnus-article-describe-key
   "\C-hc" gnus-article-describe-key-briefly
+  "\C-hb" gnus-article-describe-bindings
 
   "\C-d" gnus-article-read-summary-keys
   "\M-*" gnus-article-read-summary-keys
 
   "\C-d" gnus-article-read-summary-keys
   "\M-*" gnus-article-read-summary-keys
@@ -4053,6 +4222,13 @@ If variable `gnus-use-long-file-name' is non-nil, it is
 (substitute-key-definition
  'undefined 'gnus-article-read-summary-keys gnus-article-mode-map)
 
 (substitute-key-definition
  'undefined 'gnus-article-read-summary-keys gnus-article-mode-map)
 
+(gnus-define-keys (gnus-article-send-map "S" gnus-article-mode-map)
+  "W" gnus-article-wide-reply-with-original)
+(if (featurep 'xemacs)
+    (set-keymap-default-binding gnus-article-send-map
+                               'gnus-article-read-summary-send-keys)
+  (define-key gnus-article-send-map [t] 'gnus-article-read-summary-send-keys))
+
 (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))
@@ -4165,8 +4341,7 @@ Internal variable.")
        (gnus-set-global-variables)))
     (gnus-article-setup-highlight-words)
     ;; Init original article buffer.
        (gnus-set-global-variables)))
     (gnus-article-setup-highlight-words)
     ;; Init original article buffer.
-    (save-excursion
-      (set-buffer (gnus-get-buffer-create gnus-original-article-buffer))
+    (with-current-buffer (gnus-get-buffer-create gnus-original-article-buffer)
       (mm-enable-multibyte)
       (setq major-mode 'gnus-original-article-mode)
       (make-local-variable 'gnus-original-article))
       (mm-enable-multibyte)
       (setq major-mode 'gnus-original-article-mode)
       (make-local-variable 'gnus-original-article))
@@ -4181,8 +4356,7 @@ Internal variable.")
                         nil)
                     (error "Action aborted"))
                 t)))
                         nil)
                     (error "Action aborted"))
                 t)))
-       (save-excursion
-         (set-buffer name)
+       (with-current-buffer name
          (set (make-local-variable 'gnus-article-edit-mode) nil)
          (when gnus-article-mime-handles
            (mm-destroy-parts gnus-article-mime-handles)
          (set (make-local-variable 'gnus-article-edit-mode) nil)
          (when gnus-article-mime-handles
            (mm-destroy-parts gnus-article-mime-handles)
@@ -4196,8 +4370,7 @@ Internal variable.")
          (unless (eq major-mode 'gnus-article-mode)
            (gnus-article-mode))
          (current-buffer))
          (unless (eq major-mode 'gnus-article-mode)
            (gnus-article-mode))
          (current-buffer))
-      (save-excursion
-       (set-buffer (gnus-get-buffer-create name))
+      (with-current-buffer (gnus-get-buffer-create name)
        (gnus-article-mode)
        (make-local-variable 'gnus-summary-buffer)
        (setq gnus-summary-buffer
        (gnus-article-mode)
        (make-local-variable 'gnus-summary-buffer)
        (setq gnus-summary-buffer
@@ -4212,8 +4385,7 @@ Internal variable.")
     (when article-window
       (set-window-start
        article-window
     (when article-window
       (set-window-start
        article-window
-       (save-excursion
-        (set-buffer gnus-article-buffer)
+       (with-current-buffer gnus-article-buffer
         (goto-char (point-min))
         (if (not line)
             (point-min)
         (goto-char (point-min))
         (if (not line)
             (point-min)
@@ -4267,8 +4439,7 @@ If ALL-HEADERS is non-nil, no headers are hidden."
          (if (or (eq result 'pseudo)
                  (eq result 'nneething))
              (progn
          (if (or (eq result 'pseudo)
                  (eq result 'nneething))
              (progn
-               (save-excursion
-                 (set-buffer summary-buffer)
+               (with-current-buffer summary-buffer
                  (push article gnus-newsgroup-history)
                  (setq gnus-last-article gnus-current-article
                        gnus-current-article 0
                  (push article gnus-newsgroup-history)
                  (setq gnus-last-article gnus-current-article
                        gnus-current-article 0
@@ -4288,8 +4459,7 @@ If ALL-HEADERS is non-nil, no headers are hidden."
                       (not (eq article gnus-current-article)))
              ;; Seems like a new article has been selected.
              ;; `gnus-current-article' must be an article number.
                       (not (eq article gnus-current-article)))
              ;; Seems like a new article has been selected.
              ;; `gnus-current-article' must be an article number.
-             (save-excursion
-               (set-buffer summary-buffer)
+             (with-current-buffer summary-buffer
                (push article gnus-newsgroup-history)
                (setq gnus-last-article gnus-current-article
                      gnus-current-article article
                (push article gnus-newsgroup-history)
                (setq gnus-last-article gnus-current-article
                      gnus-current-article article
@@ -4681,8 +4851,9 @@ Deleting parts may malfunction or destroy the article; continue? "))
           (handles gnus-article-mime-handles)
           (none "(none)")
           (description
           (handles gnus-article-mime-handles)
           (none "(none)")
           (description
-           (mail-decode-encoded-word-string (or (mm-handle-description data)
-                                                none)))
+           (let ((desc (mm-handle-description data)))
+             (when desc
+               (mail-decode-encoded-word-string desc))))
           (filename
            (or (mail-content-type-get (mm-handle-disposition data) 'filename)
                none))
           (filename
            (or (mail-content-type-get (mm-handle-disposition data) 'filename)
                none))
@@ -4700,7 +4871,8 @@ Deleting parts may malfunction or destroy the article; continue? "))
            "| Type:           " type "\n"
            "| Filename:       " filename "\n"
            "| Size (encoded): " bsize " Byte\n"
            "| Type:           " type "\n"
            "| Filename:       " filename "\n"
            "| Size (encoded): " bsize " Byte\n"
-           "| Description:    " description "\n"
+           (when description
+             (concat    "| Description:    " description "\n"))
            "`----\n"))
          (setcdr data
                  (cdr (mm-make-handle
            "`----\n"))
          (setcdr data
                  (cdr (mm-make-handle
@@ -5273,9 +5445,7 @@ N is the numerical prefix."
             (mail-content-type-get (mm-handle-type handle) 'url)
             ""))
        (gnus-tmp-type (mm-handle-media-type handle))
             (mail-content-type-get (mm-handle-type handle) 'url)
             ""))
        (gnus-tmp-type (mm-handle-media-type handle))
-       (gnus-tmp-description
-        (mail-decode-encoded-word-string (or (mm-handle-description handle)
-                                             "")))
+       (gnus-tmp-description (or (mm-handle-description handle) ""))
        (gnus-tmp-dots
         (if (if displayed (car displayed)
               (mm-handle-displayed-p handle))
        (gnus-tmp-dots
         (if (if displayed (car displayed)
               (mm-handle-displayed-p handle))
@@ -5822,41 +5992,52 @@ the coding cookie."
 If given a numerical ARG, move forward ARG pages."
   (interactive "P")
   (setq arg (if arg (prefix-numeric-value arg) 0))
 If given a numerical ARG, move forward ARG pages."
   (interactive "P")
   (setq arg (if arg (prefix-numeric-value arg) 0))
-  (save-excursion
-    (set-buffer gnus-article-buffer)
-    (goto-char (point-min))
+  (with-current-buffer gnus-article-buffer
     (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
 
@@ -5871,7 +6052,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)))
 
@@ -5895,10 +6076,16 @@ 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)
 Argument LINES specifies lines to be scrolled up."
   (interactive "p")
   (move-to-window-line -1)
-  (if (save-excursion
-       (end-of-line)
-       (and (pos-visible-in-window-p)  ;Not continuation line.
-            (>= (1+ (point)) (point-max)))) ;Allow for trailing newline.
+  (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)))))
+          (save-excursion
+            (end-of-line)
+            (and (pos-visible-in-window-p)     ;Not continuation line.
+                 (>= (1+ (point)) (point-max))))) ;Allow for trailing newline.
       ;; Nothing in this page.
       (if (or (not gnus-page-broken)
              (save-excursion
       ;; Nothing in this page.
       (if (or (not gnus-page-broken)
              (save-excursion
@@ -5958,7 +6145,14 @@ Argument LINES specifies lines to be scrolled down."
       (progn
        (gnus-narrow-to-page -1)        ;Go to previous page.
        (goto-char (point-max))
       (progn
        (gnus-narrow-to-page -1)        ;Go to previous page.
        (goto-char (point-max))
-       (recenter -1))
+       (recenter (if gnus-article-over-scroll
+                     (if lines
+                         (max (+ lines (or (and (boundp 'scroll-margin)
+                                                (symbol-value 'scroll-margin))
+                                           0))
+                              3)
+                       (- (window-height) 2))
+                   -1)))
     (prog1
        (condition-case ()
            (let ((scroll-in-place nil))
     (prog1
        (condition-case ()
            (let ((scroll-in-place nil))
@@ -6047,26 +6241,26 @@ not have a face in `gnus-article-boring-faces'."
           "Zc" "ZC" "ZE" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP"
           "=" "^" "\M-^" "|"))
        (nosave-but-article
           "Zc" "ZC" "ZE" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP"
           "=" "^" "\M-^" "|"))
        (nosave-but-article
-        '("A\r"))
+        '("A " "A<" "A>" "AM" "AP" "AR" "AT" "A\C-?" "A\M-\r" "A\r" "Ab" "Ae"
+          "An" "Ap" [?A (meta return)] [?A delete]))
        (nosave-in-article
        (nosave-in-article
-        '("\C-d"))
+        '("AS" "\C-d"))
        (up-to-top
         '("n" "Gn" "p" "Gp"))
        keys new-sum-point)
        (up-to-top
         '("n" "Gn" "p" "Gp"))
        keys new-sum-point)
-    (save-excursion
-      (set-buffer gnus-article-current-summary)
+    (with-current-buffer gnus-article-current-summary
       (let (gnus-pick-mode)
       (let (gnus-pick-mode)
-       (push (or key last-command-event) unread-command-events)
-       (setq keys (if (featurep 'xemacs)
-                      (events-to-keys (read-key-sequence nil))
-                    (read-key-sequence nil)))))
+       (setq unread-command-events (nconc unread-command-events
+                                          (list (or key last-command-event)))
+             keys (if (featurep 'xemacs)
+                      (events-to-keys (read-key-sequence nil t))
+                    (read-key-sequence nil t)))))
 
     (message "")
 
     (cond
      ((eq (aref keys (1- (length keys))) ?\C-h)
 
     (message "")
 
     (cond
      ((eq (aref keys (1- (length keys))) ?\C-h)
-      (with-current-buffer gnus-article-current-summary
-       (describe-bindings (substring keys 0 -1))))
+      (gnus-article-describe-bindings (substring keys 0 -1)))
      ((or (member keys nosaves)
          (member keys nosave-but-article)
          (member keys nosave-in-article))
      ((or (member keys nosaves)
          (member keys nosave-but-article)
          (member keys nosave-in-article))
@@ -6152,53 +6346,110 @@ not have a face in `gnus-article-boring-faces'."
              (signal (car err) (cdr err))
            (ding))))))))
 
              (signal (car err) (cdr err))
            (ding))))))))
 
+(defun gnus-article-read-summary-send-keys ()
+  (interactive)
+  (let ((unread-command-events (list (gnus-character-to-event ?S))))
+    (gnus-article-read-summary-keys)))
+
 (defun gnus-article-describe-key (key)
 (defun gnus-article-describe-key (key)
-  "Display documentation of the function invoked by KEY.  KEY is a string."
-  (interactive "kDescribe key: ")
+  "Display documentation of the function invoked by KEY.
+KEY is a string or a vector."
+  (interactive (list (let ((cursor-in-echo-area t)) ;; better for XEmacs.
+                      (read-key-sequence "Describe key: "))))
   (gnus-article-check-buffer)
   (gnus-article-check-buffer)
-  (if (eq (key-binding key) 'gnus-article-read-summary-keys)
-      (save-excursion
-       (set-buffer gnus-article-current-summary)
-       (let (gnus-pick-mode)
-         (if (featurep 'xemacs)
-             (progn
-               (push (elt key 0) unread-command-events)
-               (setq key (events-to-keys
-                          (read-key-sequence "Describe key: "))))
-           (setq unread-command-events
-                 (mapcar
-                  (lambda (x) (if (>= x 128) (list 'meta (- x 128)) x))
-                  (string-to-list key)))
-           (setq key (read-key-sequence "Describe key: "))))
-       (describe-key key))
+  (if (memq (key-binding key t) '(gnus-article-read-summary-keys
+                                 gnus-article-read-summary-send-keys))
+      (with-current-buffer gnus-article-current-summary
+       (setq unread-command-events
+             (if (featurep 'xemacs)
+                 (append key nil)
+               (mapcar (lambda (x) (if (and (integerp x) (>= x 128))
+                                       (list 'meta (- x 128))
+                                     x))
+                       key)))
+       (let ((cursor-in-echo-area t)
+             gnus-pick-mode)
+         (describe-key (read-key-sequence nil t))))
     (describe-key key)))
 
 (defun gnus-article-describe-key-briefly (key &optional insert)
     (describe-key key)))
 
 (defun gnus-article-describe-key-briefly (key &optional insert)
-  "Display documentation of the function invoked by KEY.  KEY is a string."
-  (interactive "kDescribe key: \nP")
+  "Display documentation of the function invoked by KEY.
+KEY is a string or a vector."
+  (interactive (list (let ((cursor-in-echo-area t)) ;; better for XEmacs.
+                      (read-key-sequence "Describe key: "))
+                    current-prefix-arg))
   (gnus-article-check-buffer)
   (gnus-article-check-buffer)
-  (if (eq (key-binding key) 'gnus-article-read-summary-keys)
-      (save-excursion
-       (set-buffer gnus-article-current-summary)
-       (let (gnus-pick-mode)
-         (if (featurep 'xemacs)
-             (progn
-               (push (elt key 0) unread-command-events)
-               (setq key (events-to-keys
-                          (read-key-sequence "Describe key: "))))
-           (setq unread-command-events
-                 (mapcar
-                  (lambda (x) (if (>= x 128) (list 'meta (- x 128)) x))
-                  (string-to-list key)))
-           (setq key (read-key-sequence "Describe key: "))))
-       (describe-key-briefly key insert))
+  (if (memq (key-binding key t) '(gnus-article-read-summary-keys
+                                 gnus-article-read-summary-send-keys))
+      (with-current-buffer gnus-article-current-summary
+       (setq unread-command-events
+             (if (featurep 'xemacs)
+                 (append key nil)
+               (mapcar (lambda (x) (if (and (integerp x) (>= x 128))
+                                       (list 'meta (- x 128))
+                                     x))
+                       key)))
+       (let ((cursor-in-echo-area t)
+             gnus-pick-mode)
+         (describe-key-briefly (read-key-sequence nil t) insert)))
     (describe-key-briefly key insert)))
 
     (describe-key-briefly key insert)))
 
+;;`gnus-agent-mode' in gnus-agent.el will define it.
+(defvar gnus-agent-summary-mode)
+(defvar gnus-draft-mode)
+
+(defun gnus-article-describe-bindings (&optional prefix)
+  "Show a list of all defined keys, and their definitions.
+The optional argument PREFIX, if non-nil, should be a key sequence;
+then we display only bindings that start with that prefix."
+  (interactive)
+  (gnus-article-check-buffer)
+  (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)
+    (define-key keymap "S" map)
+    (define-key map [t] nil)
+    (with-current-buffer gnus-article-current-summary
+      (set-keymap-parent map (key-binding "S"))
+      (let (key def gnus-pick-mode)
+       (while sumkeys
+         (setq key (pop sumkeys))
+         (cond ((and (vectorp key) (= (length key) 1)
+                     (consp (setq def (aref key 0)))
+                     (numberp (car def)) (numberp (cdr def)))
+                (when (< (max (car def) (cdr def)) 128)
+                  (setq sumkeys
+                        (append (mapcar
+                                 #'vector
+                                 (nreverse (gnus-uncompress-range def)))
+                                sumkeys))))
+               ((setq def (key-binding key))
+                (unless (eq def 'undefined)
+                  (define-key keymap key def))))))
+      (when (boundp 'gnus-agent-summary-mode)
+       (setq agent gnus-agent-summary-mode))
+      (when (boundp 'gnus-draft-mode)
+       (setq draft gnus-draft-mode)))
+    (with-temp-buffer
+      (use-local-map keymap)
+      (set (make-local-variable 'gnus-agent-summary-mode) agent)
+      (set (make-local-variable 'gnus-draft-mode) draft)
+      (describe-bindings prefix))
+    (let ((item `((lambda (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
+       (setq help-xref-stack-item item)))))
+
 (defun gnus-article-reply-with-original (&optional wide)
   "Start composing a reply mail to the current message.
 The text in the region will be yanked.  If the region isn't active,
 the entire article will be yanked."
 (defun gnus-article-reply-with-original (&optional wide)
   "Start composing a reply mail to the current message.
 The text in the region will be yanked.  If the region isn't active,
 the entire article will be yanked."
-  (interactive "P")
+  (interactive)
   (let ((article (cdr gnus-article-current))
        contents)
     (if (not (gnus-region-active-p))
   (let ((article (cdr gnus-article-current))
        contents)
     (if (not (gnus-region-active-p))
@@ -6213,6 +6464,13 @@ the entire article will be yanked."
        (gnus-summary-reply
         (list (list article contents)) wide)))))
 
        (gnus-summary-reply
         (list (list article contents)) wide)))))
 
+(defun gnus-article-wide-reply-with-original ()
+  "Start composing a wide reply mail to the current message.
+The text in the region will be yanked.  If the region isn't active,
+the entire article will be yanked."
+  (interactive)
+  (gnus-article-reply-with-original t))
+
 (defun gnus-article-followup-with-original ()
   "Compose a followup to the current article.
 The text in the region will be yanked.  If the region isn't active,
 (defun gnus-article-followup-with-original ()
   "Compose a followup to the current article.
 The text in the region will be yanked.  If the region isn't active,
@@ -6283,8 +6541,7 @@ If given a prefix, show the hidden text instead."
                     gnus-summary-buffer
                     (get-buffer gnus-summary-buffer)
                     (gnus-buffer-exists-p gnus-summary-buffer))
                     gnus-summary-buffer
                     (get-buffer gnus-summary-buffer)
                     (gnus-buffer-exists-p gnus-summary-buffer))
-           (save-excursion
-             (set-buffer gnus-summary-buffer)
+           (with-current-buffer gnus-summary-buffer
              (let ((header (gnus-summary-article-header article)))
                (when (< article 0)
                  (cond
              (let ((header (gnus-summary-article-header article)))
                (when (< article 0)
                  (cond
@@ -6576,9 +6833,8 @@ 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.
-    (save-excursion
-      (when (get-buffer gnus-original-article-buffer)
-       (set-buffer gnus-original-article-buffer)
+    (when (get-buffer gnus-original-article-buffer)
+      (with-current-buffer gnus-original-article-buffer
        (setq gnus-original-article nil)))
     (when gnus-use-cache
       (gnus-cache-update-article
        (setq gnus-original-article nil)))
     (when gnus-use-cache
       (gnus-cache-update-article
@@ -6779,6 +7035,7 @@ must return `mid', `mail', `invalid' or `ask'."
     (-20.0 . "\\.fsf@")        ;; Gnus
     (-20.0 . "^slrn")
     (-20.0 . "^Pine")
     (-20.0 . "\\.fsf@")        ;; Gnus
     (-20.0 . "^slrn")
     (-20.0 . "^Pine")
+    (-20.0 . "^alpine\\.")
     (-20.0 . "_-_") ;; Subject change in thread
     ;;
     (-20.0 . "\\.ln@") ;; leafnode
     (-20.0 . "_-_") ;; Subject change in thread
     ;;
     (-20.0 . "\\.ln@") ;; leafnode
@@ -7182,6 +7439,7 @@ variable it the real callback function."
                       (repeat :tag "Par"
                               :inline t
                               (integer :tag "Regexp group")))))
                       (repeat :tag "Par"
                               :inline t
                               (integer :tag "Regexp group")))))
+(put 'gnus-button-alist 'risky-local-variable t)
 
 (defcustom gnus-header-button-alist
   '(("^\\(References\\|Message-I[Dd]\\|^In-Reply-To\\):" "<[^<>]+>"
 
 (defcustom gnus-header-button-alist
   '(("^\\(References\\|Message-I[Dd]\\|^In-Reply-To\\):" "<[^<>]+>"
@@ -7221,6 +7479,7 @@ HEADER is a regexp to match a header.  For a fuller explanation, see
                       (repeat :tag "Par"
                               :inline t
                               (integer :tag "Regexp group")))))
                       (repeat :tag "Par"
                               :inline t
                               (integer :tag "Regexp group")))))
+(put 'gnus-header-button-alist 'risky-local-variable t)
 
 ;;; Commands:
 
 
 ;;; Commands:
 
@@ -7312,7 +7571,7 @@ It does this by highlighting everything after
       (save-restriction
        (when (and gnus-signature-face
                   (gnus-article-narrow-to-signature))
       (save-restriction
        (when (and gnus-signature-face
                   (gnus-article-narrow-to-signature))
-         (gnus-overlay-put (gnus-make-overlay (point-min) (point-max))
+         (gnus-overlay-put (gnus-make-overlay (point-min) (point-max) nil t)
                            'face gnus-signature-face)
          (widen)
          (gnus-article-search-signature)
                            'face gnus-signature-face)
          (widen)
          (gnus-article-search-signature)
@@ -7567,8 +7826,7 @@ url is put as the `gnus-button-url' overlay property on the button."
       (gnus-parse-news-url url)
     (cond
      (message-id
       (gnus-parse-news-url url)
     (cond
      (message-id
-      (save-excursion
-       (set-buffer gnus-summary-buffer)
+      (with-current-buffer gnus-summary-buffer
        (if server
            (let ((gnus-refer-article-method
                   (nconc (list (list 'nntp server))
        (if server
            (let ((gnus-refer-article-method
                   (nconc (list (list 'nntp server))
@@ -7632,6 +7890,9 @@ url is put as the `gnus-button-url' overlay property on the button."
   "Fetch KDE style info URL."
   (gnus-info-find-node (gnus-url-unhex-string url)))
 
   "Fetch KDE style info URL."
   (gnus-info-find-node (gnus-url-unhex-string url)))
 
+;; (info) will autoload info.el
+(declare-function Info-menu "info" (menu-item &optional fork))
+
 (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'.
 (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'.
@@ -7639,6 +7900,9 @@ url is put as the `gnus-button-url' overlay property on the button."
   (Info-directory)
   (Info-menu url))
 
   (Info-directory)
   (Info-menu url))
 
+;; Called after pgg-snarf-keys-region, which autoloads pgg.el.
+(declare-function pgg-display-output-buffer "pgg" (start end status))
+
 (defun gnus-button-openpgp (url)
   "Retrieve and add an OpenPGP key given URL from an OpenPGP header."
   (with-temp-buffer
 (defun gnus-button-openpgp (url)
   "Retrieve and add an OpenPGP key given URL from an OpenPGP header."
   (with-temp-buffer
@@ -7760,7 +8024,7 @@ url is put as the `gnus-button-url' overlay property on the button."
                (1- (point))
              (point)))
     (when gnus-article-button-face
                (1- (point))
              (point)))
     (when gnus-article-button-face
-      (gnus-overlay-put (gnus-make-overlay b e)
+      (gnus-overlay-put (gnus-make-overlay b e nil t)
                         'face gnus-article-button-face))
     (widget-convert-button
      'link b e
                         'face gnus-article-button-face))
     (widget-convert-button
      'link b e
@@ -7796,7 +8060,7 @@ url is put as the `gnus-button-url' overlay property on the button."
                (1- (point))
              (point)))
     (when gnus-article-button-face
                (1- (point))
              (point)))
     (when gnus-article-button-face
-      (gnus-overlay-put (gnus-make-overlay b e)
+      (gnus-overlay-put (gnus-make-overlay b e nil t)
                         'face gnus-article-button-face))
     (widget-convert-button
      'link b e
                         'face gnus-article-button-face))
     (widget-convert-button
      'link b e
@@ -7842,14 +8106,13 @@ For example:
               (eq gnus-newsgroup-name
                   (car gnus-decode-header-methods-cache)))
     (setq gnus-decode-header-methods-cache (list gnus-newsgroup-name))
               (eq gnus-newsgroup-name
                   (car gnus-decode-header-methods-cache)))
     (setq gnus-decode-header-methods-cache (list gnus-newsgroup-name))
-    (mapcar (lambda (x)
-             (if (symbolp x)
-                 (nconc gnus-decode-header-methods-cache (list x))
-               (if (and gnus-newsgroup-name
-                        (string-match (car x) gnus-newsgroup-name))
-                   (nconc gnus-decode-header-methods-cache
-                          (list (cdr x))))))
-         gnus-decode-header-methods))
+    (dolist (x gnus-decode-header-methods)
+      (if (symbolp x)
+         (nconc gnus-decode-header-methods-cache (list x))
+       (if (and gnus-newsgroup-name
+                (string-match (car x) gnus-newsgroup-name))
+           (nconc gnus-decode-header-methods-cache
+                  (list (cdr x)))))))
   (let ((xlist gnus-decode-header-methods-cache))
     (pop xlist)
     (save-restriction
   (let ((xlist gnus-decode-header-methods-cache))
     (pop xlist)
     (save-restriction
@@ -7890,12 +8153,11 @@ For example:
          (funcall (cadr elem)))))))
 
 ;; Dynamic variables.
          (funcall (cadr elem)))))))
 
 ;; Dynamic variables.
-(eval-when-compile
-  (defvar part-number)
-  (defvar total-parts)
-  (defvar type)
-  (defvar condition)
-  (defvar length))
+(defvar part-number)
+(defvar total-parts)
+(defvar type)
+(defvar condition)
+(defvar length)
 
 (defun gnus-treat-predicate (val)
   (cond
 
 (defun gnus-treat-predicate (val)
   (cond
@@ -7943,6 +8205,11 @@ For example:
                         gnus-article-encrypt-protocol-alist
                         nil t))
     current-prefix-arg))
                         gnus-article-encrypt-protocol-alist
                         nil 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)? ")
+      (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))
@@ -7952,8 +8219,7 @@ For example:
        (error "Can't encrypt the article in group %s"
               gnus-newsgroup-name))
     (gnus-summary-iterate n
        (error "Can't encrypt the article in group %s"
               gnus-newsgroup-name))
     (gnus-summary-iterate n
-      (save-excursion
-       (set-buffer gnus-summary-buffer)
+      (with-current-buffer gnus-summary-buffer
        (let ((mail-parse-charset gnus-newsgroup-charset)
              (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets)
              (summary-buffer gnus-summary-buffer)
        (let ((mail-parse-charset gnus-newsgroup-charset)
              (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets)
              (summary-buffer gnus-summary-buffer)
@@ -7999,9 +8265,8 @@ 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)))
-         (save-excursion
-           (when (get-buffer gnus-original-article-buffer)
-             (set-buffer gnus-original-article-buffer)
+          (when (get-buffer gnus-original-article-buffer)
+            (with-current-buffer gnus-original-article-buffer
              (setq gnus-original-article nil)))
          (when gnus-use-cache
            (gnus-cache-update-article
              (setq gnus-original-article nil)))
          (when gnus-use-cache
            (gnus-cache-update-article
@@ -8252,5 +8517,5 @@ For example:
 
 (run-hooks 'gnus-art-load-hook)
 
 
 (run-hooks 'gnus-art-load-hook)
 
-;;; arch-tag: 2654516f-6279-48f9-a83b-05c1fa450c33
+;; arch-tag: 2654516f-6279-48f9-a83b-05c1fa450c33
 ;;; gnus-art.el ends here
 ;;; gnus-art.el ends here
Steve's SXEmacs-friendly Gnus repo