2002-01-22 Lars Magne Ingebrigtsen <larsi@gnus.org>
[gnus] / lisp / gnus-art.el
index 8d312e3..b397412 100644 (file)
@@ -228,23 +228,18 @@ regexp.  If it matches, the text in question is not a signature."
 (defcustom gnus-article-x-face-command
   (if (featurep 'xemacs)
       (if (or (gnus-image-type-available-p 'xface)
-             (gnus-image-type-available-p 'xpm))
-         'gnus-xmas-article-display-xface
+             (gnus-image-type-available-p 'pbm))
+         'gnus-display-x-face-in-from
        "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | ee -")
-    (if (gnus-image-type-available-p 'xbm)
-       'gnus-article-display-xface
-      (if gnus-article-compface-xbm
-         "{ echo '/* Width=48, Height=48 */'; uncompface; } | display -"
-       "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | \
-display -")))
+    (if (gnus-image-type-available-p 'pbm)
+       'gnus-display-x-face-in-from
+      "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | \
+display -"))
   "*String or function to be executed to display an X-Face header.
 If it is a string, the command will be executed in a sub-shell
 asynchronously.         The compressed face will be piped to this command."
   :type `(choice string
-                (function-item
-                 ,(if (featurep 'xemacs)
-                      'gnus-xmas-article-display-xface
-                    'gnus-article-display-xface))
+                (function-item gnus-display-x-face-in-from)
                 function)
   :version "21.1"
   :group 'gnus-article-washing)
@@ -285,23 +280,23 @@ directly.")
 
 (defcustom gnus-emphasis-alist
   (let ((format
-        "\\(\\s-\\|^\\|[-\"]\\|\\s(\\)\\(%s\\(\\w+\\(\\s-+\\w+\\)*[.,]?\\)%s\\)\\(\\s-\\|[-,;:\"]\\s-\\|[?!.]+\\s-\\|\\s)\\)")
+        "\\(\\s-\\|^\\|\\=\\|[-\"]\\|\\s(\\)\\(%s\\(\\w+\\(\\s-+\\w+\\)*[.,]?\\)%s\\)\\(\\([-,.;:\"]\\|\\s)\\)+\\s-\\|[?!.]\\s-\\|\\s)\\|\\s-\\)")
        (types
-        '(("_" "_" underline)
+        '(("\\*" "\\*" bold)
+          ("_" "_" underline)
           ("/" "/" italic)
-          ("\\*" "\\*" bold)
           ("_/" "/_" underline-italic)
           ("_\\*" "\\*_" underline-bold)
           ("\\*/" "/\\*" bold-italic)
           ("_\\*/" "/\\*_" underline-bold-italic))))
-    `(("\\(\\s-\\|^\\)\\(_\\(\\(\\w\\|_[^_]\\)+\\)_\\)\\(\\s-\\|[?!.,;]\\)"
-       2 3 gnus-emphasis-underline)
-      ,@(mapcar
+    `(,@(mapcar
         (lambda (spec)
           (list
            (format format (car spec) (cadr spec))
            2 3 (intern (format "gnus-emphasis-%s" (nth 2 spec)))))
-        types)))
+        types)
+       ("\\(\\s-\\|^\\)\\(_\\(\\(\\w\\|_[^_]\\)+\\)_\\)\\(\\s-\\|[?!.,;]\\)"
+        2 3 gnus-emphasis-underline)))
   "*Alist that says how to fontify certain phrases.
 Each item looks like this:
 
@@ -709,6 +704,21 @@ be controlled by `gnus-treat-body-boundary'."
   :type '(choice (item :tag "None" :value nil)
                 string))
 
+(defcustom gnus-picon-databases '("/usr/lib/picon" "/usr/local/faces")
+  "*Defines the location of the faces database.
+For information on obtaining this database of pretty pictures, please
+see http://www.cs.indiana.edu/picons/ftp/index.html"
+  :type 'directory
+  :group 'gnus-picon)
+
+(defun gnus-picons-installed-p ()
+  "Say whether picons are installed on your machine."
+  (let ((installed nil))
+    (dolist (database gnus-picon-databases)
+      (when (file-exists-p database)
+       (setq installed t)))
+    installed))
+
 (defcustom gnus-article-mime-part-function nil
   "Function called with a MIME handle as the argument.
 This is meant for people who want to do something automatic based
@@ -1084,7 +1094,8 @@ See Info node `(gnus)Customizing Articles' and Info node
 (put 'gnus-treat-display-smileys 'highlight t)
 
 (defcustom gnus-treat-from-picon
-  (if (gnus-image-type-available-p 'xpm)
+  (if (and (gnus-image-type-available-p 'xpm)
+          (gnus-picons-installed-p))
       'head nil)
   "Display picons in the From header.
 Valid values are nil, t, `head', `last', an integer or a predicate.
@@ -1095,7 +1106,8 @@ See Info node `(gnus)Customizing Articles' and Info node
 (put 'gnus-treat-from-picon 'highlight t)
 
 (defcustom gnus-treat-mail-picon
-  (if (gnus-image-type-available-p 'xpm)
+  (if (and (gnus-image-type-available-p 'xpm)
+          (gnus-picons-installed-p))
       'head nil)
   "Display picons in To and Cc headers.
 Valid values are nil, t, `head', `last', an integer or a predicate.
@@ -1106,7 +1118,8 @@ See Info node `(gnus)Customizing Articles' and Info node
 (put 'gnus-treat-mail-picon 'highlight t)
 
 (defcustom gnus-treat-newsgroups-picon
-  (if (gnus-image-type-available-p 'xpm)
+  (if (and (gnus-image-type-available-p 'xpm)
+          (gnus-picons-installed-p))
       'head nil)
   "Display picons in the Newsgroups and Followup-To headers.
 Valid values are nil, t, `head', `last', an integer or a predicate.
@@ -1179,6 +1192,12 @@ It is a string, such as \"PGP\". If nil, ask user."
   :type 'string
   :group 'mime-security)
 
+(defcustom gnus-article-wash-function 'gnus-article-wash-html-with-w3
+  "Function used for converting HTML into text."
+  :type '(radio (function-item gnus-article-wash-html-with-w3)
+               (function-item gnus-article-wash-html-with-w3m))
+  :group 'gnus-article)
+
 ;;; Internal variables
 
 (defvar gnus-english-month-names
@@ -1207,6 +1226,7 @@ It is a string, such as \"PGP\". If nil, ask user."
     (gnus-treat-date-original gnus-article-date-original)
     (gnus-treat-date-user-defined gnus-article-date-user)
     (gnus-treat-date-iso8601 gnus-article-date-iso8601)
+    (gnus-treat-display-xface gnus-article-display-x-face)
     (gnus-treat-hide-headers gnus-article-maybe-hide-headers)
     (gnus-treat-hide-boring-headers gnus-article-hide-boring-headers)
     (gnus-treat-hide-signature gnus-article-hide-signature)
@@ -1236,7 +1256,6 @@ It is a string, such as \"PGP\". If nil, ask user."
     (gnus-treat-display-smileys gnus-treat-smiley)
     (gnus-treat-capitalize-sentences gnus-article-capitalize-sentences)
     (gnus-treat-emphasize gnus-article-emphasize)
-    (gnus-treat-display-xface gnus-article-display-x-face)
     (gnus-treat-body-boundary gnus-article-treat-body-boundary)
     (gnus-treat-play-sounds gnus-earcon-display)))
 
@@ -1672,8 +1691,8 @@ unfolded."
        (goto-char (point-max))))))
 
 (defun gnus-treat-smiley ()
-  "Display textual emoticons (\"smileys\") as small graphical icons."
-  (interactive "P")
+  "Toggle display of textual emoticons (\"smileys\") as small graphical icons."
+  (interactive)
   (gnus-with-article-buffer
     (if (memq 'smiley gnus-article-wash-types)
        (gnus-delete-images 'smiley)
@@ -1782,65 +1801,77 @@ unfolded."
 (defun article-display-x-face (&optional force)
   "Look for an X-Face header and display it if present."
   (interactive (list 'force))
-  (gnus-with-article-headers
-    ;; Delete the old process, if any.
-    (when (process-status "article-x-face")
-      (delete-process "article-x-face"))
-    (if (memq 'xface gnus-article-wash-types)
-       ;; We have already displayed X-Faces, so we remove them
-       ;; instead.
-       (gnus-delete-images 'xface)
-      ;; Display X-Faces.
-      (let (x-faces from face grey)
-       (save-excursion
-         (set-buffer gnus-original-article-buffer)
-         (save-restriction
-           (mail-narrow-to-head)
-           (while (gnus-article-goto-header "x-face\\(-[0-9]+\\)?")
-             (when (match-beginning 2)
-               (setq grey t))
-             (push (mail-header-field-value) x-faces))
-           (setq from (message-fetch-field "from"))))
-       (if grey
-           (let ((xpm (gnus-convert-gray-x-face-to-xpm x-faces))
-                 image)
-             (when xpm
-               (setq image (gnus-create-image xpm 'xpm t))
-               (goto-char (point-min))
-               (re-search-forward "^From:" nil 'move)
-               (gnus-add-wash-type 'xface)
-               (gnus-add-image 'xface image)
-               (gnus-put-image image)))
-         ;; 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))))
-         (while (and (setq face (pop x-faces))
-                     gnus-article-x-face-command
-                     (or force
-                         ;; Check whether this face is censored.
-                         (not gnus-article-x-face-too-ugly)
-                         (and gnus-article-x-face-too-ugly from
-                              (not (string-match gnus-article-x-face-too-ugly
-                                                 from)))))
-           ;; We display the face.
-           (if (symbolp gnus-article-x-face-command)
-               ;; The command is a lisp function, so we call it.
-               (if (gnus-functionp gnus-article-x-face-command)
-                   (funcall gnus-article-x-face-command face)
-                 (error "%s is not a function" gnus-article-x-face-command))
-             ;; The command is a string, so we interpret the command
-             ;; as a, well, command, and fork it off.
-             (let ((process-connection-type nil))
-               (process-kill-without-query
-                (start-process
-                 "article-x-face" nil shell-file-name shell-command-switch
-                 gnus-article-x-face-command))
-               (with-temp-buffer
-                 (insert face)
-                 (process-send-region "article-x-face"
-                                      (point-min) (point-max)))
-               (process-send-eof "article-x-face")))))))))
+  (let ((wash-face-p buffer-read-only))        ;; When type `W f'
+    (gnus-with-article-headers
+      ;; Delete the old process, if any.
+      (when (process-status "article-x-face")
+       (delete-process "article-x-face"))
+      (if (memq 'xface gnus-article-wash-types)
+         ;; We have already displayed X-Faces, so we remove them
+         ;; instead.
+         (gnus-delete-images 'xface)
+       ;; Display X-Faces.
+       (let (x-faces from face grey)
+         (save-excursion
+           (when (and wash-face-p
+                      (progn
+                        (goto-char (point-min))
+                        (not (re-search-forward 
+                              "^X-Face\\(-[0-9]+\\)?:[\t ]*" nil t)))
+                      (gnus-buffer-live-p gnus-original-article-buffer))
+             ;; If type `W f', use gnus-original-article-buffer,
+             ;; otherwise use the current buffer because displaying
+             ;; RFC822 parts calls this function too.
+             (set-buffer gnus-original-article-buffer))
+           (save-restriction
+             (mail-narrow-to-head)
+             (while (gnus-article-goto-header "x-face\\(-[0-9]+\\)?")
+               (when (match-beginning 2)
+                 (setq grey t))
+               (push (mail-header-field-value) x-faces))
+             (setq from (message-fetch-field "from"))))
+         (if grey
+             (let ((xpm (gnus-convert-gray-x-face-to-xpm x-faces))
+                   image)
+               (when xpm
+                 (setq image (gnus-create-image xpm 'xpm t))
+                 (gnus-article-goto-header "from")
+                 (when (bobp) 
+                   (insert "From: [no `from' set]\n")
+                   (forward-char -17))
+                 (gnus-add-wash-type 'xface)
+                 (gnus-add-image 'xface image)
+                 (gnus-put-image image)))
+           ;; 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))))
+           (while (and (setq face (pop x-faces))
+                       gnus-article-x-face-command
+                       (or force
+                           ;; Check whether this face is censored.
+                           (not gnus-article-x-face-too-ugly)
+                           (and gnus-article-x-face-too-ugly from
+                                (not (string-match gnus-article-x-face-too-ugly
+                                                   from)))))
+             ;; We display the face.
+             (if (symbolp gnus-article-x-face-command)
+                 ;; The command is a lisp function, so we call it.
+                 (if (gnus-functionp gnus-article-x-face-command)
+                     (funcall gnus-article-x-face-command face)
+                   (error "%s is not a function" gnus-article-x-face-command))
+               ;; The command is a string, so we interpret the command
+               ;; as a, well, command, and fork it off.
+               (let ((process-connection-type nil))
+                 (process-kill-without-query
+                  (start-process
+                   "article-x-face" nil shell-file-name shell-command-switch
+                   gnus-article-x-face-command))
+                 (with-temp-buffer
+                   (insert face)
+                   (process-send-region "article-x-face"
+                                        (point-min) (point-max)))
+                 (process-send-eof "article-x-face"))))))))))
 
 (defun article-decode-mime-words ()
   "Decode all MIME-encoded words in the article."
@@ -2038,15 +2069,24 @@ If READ-CHARSET, ask for a coding system."
       (save-window-excursion
        (save-restriction
          (narrow-to-region (point) (point-max))
-         (mm-setup-w3)
-         (let ((w3-strict-width (window-width))
-               (url-standalone-mode t)
-               (w3-honor-stylesheets nil)
-               (w3-delay-image-loads t))
-           (condition-case var
-               (w3-region (point-min) (point-max))
-             (error))))))))
-
+         (funcall gnus-article-wash-function))))))
+
+(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)
+       (w3-honor-stylesheets nil)
+       (w3-delay-image-loads t))
+    (condition-case var
+       (w3-region (point-min) (point-max))
+      (error))))
+
+(defun gnus-article-wash-html-with-w3m ()
+  "Wash the current buffer with w3m."
+  (shell-command-on-region
+   (point) (point-max) "w3m -T text/html" t t))
+  
 (defun article-hide-list-identifiers ()
   "Remove list identifies from the Subject header.
 The `gnus-list-identifiers' variable specifies what to do."
@@ -2631,12 +2671,12 @@ This format is defined by the `gnus-article-time-format' variable."
   (interactive (list t))
   (article-date-ut 'iso8601 highlight))
 
-(defun article-show-all ()
-  "Show all hidden text in the article buffer."
-  (interactive)
-  (save-excursion
-    (let ((buffer-read-only nil))
-      (gnus-article-unhide-text (point-min) (point-max)))))
+;; (defun article-show-all ()
+;;   "Show all hidden text in the article buffer."
+;;   (interactive)
+;;   (save-excursion
+;;     (let ((buffer-read-only nil))
+;;       (gnus-article-unhide-text (point-min) (point-max)))))
 
 (defun article-remove-leading-whitespace ()
   "Remove excessive whitespace from all headers."
@@ -3144,7 +3184,8 @@ If variable `gnus-use-long-file-name' is non-nil, it is
      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
 ;;;
 ;;; Gnus article mode
@@ -3909,8 +3950,11 @@ If no internal viewer is available, use an external viewer."
        (let ((window (selected-window))
              (mail-parse-charset gnus-newsgroup-charset)
              (mail-parse-ignored-charsets
-              (save-excursion (set-buffer gnus-summary-buffer)
-                              gnus-newsgroup-ignored-charsets)))
+              (if (gnus-buffer-live-p gnus-summary-buffer)
+                  (save-excursion
+                    (set-buffer gnus-summary-buffer)
+                    gnus-newsgroup-ignored-charsets)
+                nil)))
          (save-excursion
            (unwind-protect
                (let ((win (gnus-get-buffer-window (current-buffer) t))
@@ -3978,14 +4022,11 @@ If no internal viewer is available, use an external viewer."
     (setq b (point))
     (gnus-eval-format
      gnus-mime-button-line-format gnus-mime-button-line-format-alist
-     `(keymap ,gnus-mime-button-map
-             ,@(if (>= (string-to-number emacs-version) 21)
-                   nil
-                 (list 'local-map gnus-mime-button-map))
-             gnus-callback gnus-mm-display-part
-             gnus-part ,gnus-tmp-id
-             article-type annotation
-             gnus-data ,handle))
+     `(,@(gnus-local-map-property gnus-mime-button-map)
+        gnus-callback gnus-mm-display-part
+        gnus-part ,gnus-tmp-id
+        article-type annotation
+        gnus-data ,handle))
     (setq e (point))
     (widget-convert-button
      'link b e
@@ -4238,12 +4279,9 @@ If no internal viewer is available, use an external viewer."
                       ',gnus-article-mime-handle-alist))
               (gnus-mime-display-alternative
                ',ihandles ',not-pref ',begend ,id))
-            ,@(if (>= (string-to-number emacs-version) 21)
-                  nil ;; XEmacs doesn't care
-                (list 'local-map gnus-mime-button-map))
+            ,@(gnus-local-map-property gnus-mime-button-map)
             ,gnus-mouse-face-prop ,gnus-article-mouse-face
             face ,gnus-article-button-face
-            keymap ,gnus-mime-button-map
             gnus-part ,id
             gnus-data ,handle))
          (widget-convert-button 'link from (point)
@@ -4265,12 +4303,9 @@ If no internal viewer is available, use an external viewer."
                         ',gnus-article-mime-handle-alist))
                 (gnus-mime-display-alternative
                  ',ihandles ',handle ',begend ,id))
-              ,@(if (>= (string-to-number emacs-version) 21)
-                    nil ;; XEmacs doesn't care
-                  (list 'local-map gnus-mime-button-map))
+              ,@(gnus-local-map-property gnus-mime-button-map)
               ,gnus-mouse-face-prop ,gnus-article-mouse-face
               face ,gnus-article-button-face
-              keymap ,gnus-mime-button-map
               gnus-part ,id
               gnus-data ,handle))
            (widget-convert-button 'link from (point)
@@ -4356,7 +4391,7 @@ is the string to use when it is inactive.")
 
 (defun gnus-add-wash-type (type)
   "Add a washing of TYPE to the current status."
-  (push type gnus-article-wash-types))
+  (add-to-list 'gnus-article-wash-types type))
 
 (defun gnus-delete-wash-type (type)
   "Add a washing of TYPE to the current status."
@@ -4681,22 +4716,33 @@ Argument LINES specifies lines to be scrolled down."
 The text in the region will be yanked.  If the region isn't active,
 the entire article will be yanked."
   (interactive "P")
-  (let ((article (cdr gnus-article-current)))
-    (if (not mark-active)
+  (let ((article (cdr gnus-article-current)) cont)
+    (if (not (mark))
        (gnus-summary-reply (list (list article)) wide)
+      (setq cont (buffer-substring (point) (mark)))
+      ;; Deactivate active regions.
+      (when (and (boundp 'transient-mark-mode)
+                transient-mark-mode)
+       (setq mark-active nil))
       (gnus-summary-reply
-       (list (list article (buffer-substring (point) (mark)))) wide))))
+       (list (list article cont)) wide))))
 
 (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,
 the entire article will be yanked."
   (interactive)
-  (let ((article (cdr gnus-article-current)))
-    (if (not mark-active)
+  (let ((article (cdr gnus-article-current))
+       cont)
+    (if (not (gnus-region-active-p))
        (gnus-summary-followup (list (list article)))
+      (setq cont (buffer-substring (point) (mark)))
+      ;; Deactivate active regions.
+      (when (and (boundp 'transient-mark-mode)
+                transient-mark-mode)
+       (setq mark-active nil))
       (gnus-summary-followup
-       (list (list article (buffer-substring (point) (mark))))))))
+       (list (list article cont))))))
 
 (defun gnus-article-hide (&optional arg force)
   "Hide all the gruft in the current article.
@@ -4722,6 +4768,9 @@ If given a prefix, show the hidden text instead."
     (gnus-check-server (gnus-find-method-for-group gnus-newsgroup-name))
     (gnus-request-group gnus-newsgroup-name t)))
 
+(eval-when-compile
+  (autoload 'nneething-get-file-name "nneething"))
+
 (defun gnus-request-article-this-buffer (article group)
   "Get an article and insert it into this buffer."
   (let (do-update-line sparse-header)
@@ -4771,12 +4820,10 @@ If given a prefix, show the hidden text instead."
                               gnus-newsgroup-name)))
                  (when (and (eq (car method) 'nneething)
                             (vectorp header))
-                   (let ((dir (expand-file-name
-                               (mail-header-subject header)
-                               (file-name-as-directory
-                                (or (cadr (assq 'nneething-address method))
-                                    (nth 1 method))))))
-                     (when (file-directory-p dir)
+                   (let ((dir (nneething-get-file-name
+                               (mail-header-id header))))
+                     (when (and (stringp dir)
+                                (file-directory-p dir))
                        (setq article 'nneething)
                        (gnus-group-enter-directory dir))))))))
 
@@ -4815,6 +4862,11 @@ If given a prefix, show the hidden text instead."
                 (numberp article)
                 (gnus-cache-request-article article group))
            'article)
+          ;; Check the agent cache.
+          ((and gnus-agent gnus-agent-cache gnus-plugged 
+                (numberp article)
+                (gnus-agent-request-article article group))
+           'article)
           ;; Get the article and put into the article buffer.
           ((or (stringp article)
                (numberp article))
@@ -5061,7 +5113,7 @@ groups."
     ("\\binfo:\\(//\\)?\\([^'\">\n\t ]+\\)" 0 t
      gnus-button-handle-info 2)
     ;; This is how URLs _should_ be embedded in text...
-    ("<URL: *\\([^<>]*\\)>" 0 t gnus-button-embedded-url 1)
+    ("<URL: *\\([^<>]*\\)>" 1 t gnus-button-embedded-url 1)
     ;; Raw URLs.
     (,gnus-button-url-regexp 0 t browse-url 0))
   "*Alist of regexps matching buttons in article bodies.
@@ -5094,6 +5146,7 @@ variable it the real callback function."
     ("^X-[Uu][Rr][Ll]:" ,gnus-button-url-regexp 0 t browse-url 0)
     ("^Subject:" ,gnus-button-url-regexp 0 t browse-url 0)
     ("^[^:]+:" ,gnus-button-url-regexp 0 t browse-url 0)
+    ("^[^:]+:" "\\bmailto:\\([-a-zA-Z.@_+0-9%=?]+\\)" 0 t gnus-url-mailto 1)
     ("^[^:]+:" "\\(<\\(url: \\)?news:\\([^>\n ]*\\)>\\)" 1 t
      gnus-button-message-id 3))
   "*Alist of headers and regexps to match buttons in article heads.
@@ -5482,7 +5535,7 @@ specified by `gnus-button-alist'."
       (if (not (string-match "=" cur))
          nil                           ; Grace
        (setq key (gnus-url-unhex-string (substring cur 0 (match-beginning 0)))
-             val (gnus-url-unhex-string (substring cur (match-end 0) nil)))
+             val (gnus-url-unhex-string (substring cur (match-end 0) nil) t))
        (if downcase
            (setq key (downcase key)))
        (setq cur (assoc key retval))
@@ -5524,28 +5577,48 @@ specified by `gnus-button-alist'."
 (defvar gnus-next-page-line-format "%{%(Next page...%)%}\n")
 (defvar gnus-prev-page-line-format "%{%(Previous page...%)%}\n")
 
-(defvar gnus-prev-page-map nil)
-(unless gnus-prev-page-map
-  (setq gnus-prev-page-map (make-sparse-keymap))
-  (define-key gnus-prev-page-map gnus-mouse-2 'gnus-button-prev-page)
-  (define-key gnus-prev-page-map "\r" 'gnus-button-prev-page))
+(defvar gnus-prev-page-map
+  (let ((map (make-sparse-keymap)))
+    (unless (>= emacs-major-version 21)
+      ;; XEmacs doesn't care.
+      (set-keymap-parent map gnus-article-mode-map))
+    (define-key map gnus-mouse-2 'gnus-button-prev-page)
+    (define-key map "\r" 'gnus-button-prev-page)
+    map))
 
 (defun gnus-insert-prev-page-button ()
-  (let ((buffer-read-only nil))
+  (let ((b (point))
+       (buffer-read-only nil))
     (gnus-eval-format
      gnus-prev-page-line-format nil
-     `(gnus-prev t local-map ,gnus-prev-page-map
-                gnus-callback gnus-article-button-prev-page
-                article-type annotation))))
-
-(defvar gnus-next-page-map nil)
-(unless gnus-next-page-map
-  (setq gnus-next-page-map (make-keymap))
-  (suppress-keymap gnus-prev-page-map)
-  (define-key gnus-next-page-map gnus-mouse-2 'gnus-button-next-page)
-  (define-key gnus-next-page-map "\r" 'gnus-button-next-page))
-
-(defun gnus-button-next-page ()
+     `(,@(gnus-local-map-property gnus-prev-page-map)
+        gnus-prev t 
+        gnus-callback gnus-article-button-prev-page
+        article-type annotation))
+    (widget-convert-button
+     'link b (point)
+     :action 'gnus-button-prev-page
+     :button-keymap gnus-prev-page-map)))
+
+(defvar gnus-prev-page-map
+  (let ((map (make-sparse-keymap)))
+    (unless (>= emacs-major-version 21)
+      ;; XEmacs doesn't care.
+      (set-keymap-parent map gnus-article-mode-map))
+    (define-key map gnus-mouse-2 'gnus-button-prev-page)
+    (define-key map "\r" 'gnus-button-prev-page)
+    map))
+
+(defvar gnus-next-page-map
+  (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))
+
+(defun gnus-button-next-page (&optional args more-args)
   "Go to the next page."
   (interactive)
   (let ((win (selected-window)))
@@ -5553,7 +5626,7 @@ specified by `gnus-button-alist'."
     (gnus-article-next-page)
     (select-window win)))
 
-(defun gnus-button-prev-page ()
+(defun gnus-button-prev-page (&optional args more-args)
   "Go to the prev page."
   (interactive)
   (let ((win (selected-window)))
@@ -5562,12 +5635,17 @@ specified by `gnus-button-alist'."
     (select-window win)))
 
 (defun gnus-insert-next-page-button ()
-  (let ((buffer-read-only nil))
+  (let ((b (point))
+       (buffer-read-only nil))
     (gnus-eval-format gnus-next-page-line-format nil
-                     `(gnus-next
-                       t local-map ,gnus-next-page-map
-                       gnus-callback gnus-article-button-next-page
-                       article-type annotation))))
+                     `(,@(gnus-local-map-property gnus-next-page-map)
+                         gnus-next t 
+                         gnus-callback gnus-article-button-next-page
+                         article-type annotation))
+    (widget-convert-button
+     'link b (point)
+     :action 'gnus-button-next-page
+     :button-keymap gnus-next-page-map)))
 
 (defun gnus-article-button-next-page (arg)
   "Go to the next page."
@@ -5896,14 +5974,11 @@ For example:
     (gnus-eval-format
      gnus-mime-security-button-line-format
      gnus-mime-security-button-line-format-alist
-     `(keymap ,gnus-mime-security-button-map
-             ,@(if (>= (string-to-number emacs-version) 21)
-                   nil ;; XEmacs doesn't care
-                 (list 'local-map gnus-mime-security-button-map))
-             gnus-callback gnus-mime-security-press-button
-             gnus-line-format ,gnus-mime-security-button-line-format
-             article-type annotation
-             gnus-data ,handle))
+     `(,@(gnus-local-map-property gnus-mime-security-button-map)
+        gnus-callback gnus-mime-security-press-button
+        gnus-line-format ,gnus-mime-security-button-line-format
+        article-type annotation
+        gnus-data ,handle))
     (setq e (point))
     (widget-convert-button
      'link b e