Synch to No Gnus 200411142100.
[elisp/gnus.git-] / lisp / gnus-art.el
index 5cb93b1..0d063c3 100644 (file)
@@ -228,6 +228,7 @@ By default, if you set this t, then Gnus will display citations and
 signatures, but will never scroll down to show you a page consisting
 only of boring text.  Boring text is controlled by
 `gnus-article-boring-faces'."
+  :version "21.4"
   :type 'boolean
   :group 'gnus-article-hiding)
 
@@ -352,27 +353,56 @@ advertisements.  For example:
                   (symbol :tag "Item in `gnus-article-banner-alist'" none)
                   regexp
                   (const :tag "None" nil))))
+  :version "21.4"
   :group 'gnus-article-washing)
 
+(defmacro gnus-emphasis-custom-with-format (&rest body)
+  `(let ((format "\
+\\(\\s-\\|^\\|\\=\\|[-\"]\\|\\s(\\)\\(%s\\(\\w+\\(\\s-+\\w+\\)*[.,]?\\)%s\\)\
+\\(\\([-,.;:!?\"]\\|\\s)\\)+\\s-\\|[?!.]\\s-\\|\\s)\\|\\s-\\)"))
+     ,@body))
+
+(defun gnus-emphasis-custom-value-to-external (value)
+  (gnus-emphasis-custom-with-format
+   (if (consp (car value))
+       (list (format format (car (car value)) (cdr (car value)))
+            2
+            (if (nth 1 value) 2 3)
+            (nth 2 value))
+     value)))
+
+(defun gnus-emphasis-custom-value-to-internal (value)
+  (gnus-emphasis-custom-with-format
+   (let ((regexp (concat "\\`"
+                        (format (regexp-quote format)
+                                "\\([^()]+\\)" "\\([^()]+\\)")
+                        "\\'"))
+        pattern)
+     (if (string-match regexp (setq pattern (car value)))
+        (list (cons (match-string 1 pattern) (match-string 2 pattern))
+              (= (nth 2 value) 2)
+              (nth 3 value))
+       value))))
+
 (defcustom gnus-emphasis-alist
-  (let ((format
-        "\\(\\s-\\|^\\|\\=\\|[-\"]\\|\\s(\\)\\(%s\\(\\w+\\(\\s-+\\w+\\)*[.,]?\\)%s\\)\\(\\([-,.;:!?\"]\\|\\s)\\)+\\s-\\|[?!.]\\s-\\|\\s)\\|\\s-\\)")
-       (types
-        '(("\\*" "\\*" bold)
+  (let ((types
+        '(("\\*" "\\*" bold nil 2)
           ("_" "_" underline)
           ("/" "/" italic)
           ("_/" "/_" underline-italic)
           ("_\\*" "\\*_" underline-bold)
           ("\\*/" "/\\*" bold-italic)
           ("_\\*/" "/\\*_" underline-bold-italic))))
-    `(,@(mapcar
-        (lambda (spec)
-          (list
-           (format format (car spec) (car (cdr spec)))
-           2 3 (intern (format "gnus-emphasis-%s" (nth 2 spec)))))
-        types)
-       ("\\(\\s-\\|^\\)\\(_\\(\\(\\w\\|_[^_]\\)+\\)_\\)\\(\\s-\\|[?!.,;]\\)"
-        2 3 gnus-emphasis-underline)))
+    (nconc
+     (gnus-emphasis-custom-with-format
+      (mapcar (lambda (spec)
+               (list (format format (car spec) (cadr spec))
+                     (or (nth 3 spec) 2)
+                     (or (nth 4 spec) 3)
+                     (intern (format "gnus-emphasis-%s" (nth 2 spec)))))
+             types))
+     '(("\\(\\s-\\|^\\)\\(_\\(\\(\\w\\|_[^_]\\)+\\)_\\)\\(\\s-\\|[?!.,;]\\)"
+       2 3 gnus-emphasis-underline))))
   "*Alist that says how to fontify certain phrases.
 Each item looks like this:
 
@@ -383,11 +413,43 @@ is a number that says what regular expression grouping used to find
 the entire emphasized word.  The third is a number that says what
 regexp grouping should be displayed and highlighted.  The fourth
 is the face used for highlighting."
-  :type '(repeat (list :value ("" 0 0 default)
-                      regexp
-                      (integer :tag "Match group")
-                      (integer :tag "Emphasize group")
-                      face))
+  :type
+  '(repeat
+    (menu-choice
+     :format "%[Customizing Style%]\n%v"
+     :indent 2
+     (group :tag "Default"
+           :value ("" 0 0 default)
+           :value-create
+           (lambda (widget)
+             (let ((value (widget-get
+                           (cadr (widget-get (widget-get widget :parent)
+                                             :args))
+                           :value)))
+               (if (not (eq (nth 2 value) 'default))
+                   (widget-put
+                    widget
+                    :value
+                    (gnus-emphasis-custom-value-to-external value))))
+             (widget-group-value-create widget))
+           (regexp :format "%t: %v\n" :size 1)
+           (integer :format "Match group: %v\n" :size 0)
+           (integer  :format "Emphasize group: %v\n" :size 0)
+           face)
+     (group :tag "Simple"
+           :value (("_" . "_") nil default)
+           (cons :format "%v"
+                 (regexp :format "Start regexp: %v\n" :size 0)
+                 (regexp :format "End regexp: %v\n" :size 0))
+           (boolean :format "Show start and end patterns: %[%v%]\n"
+                    :on " On " :off " Off ")
+           face)))
+  :get (lambda (symbol)
+        (mapcar 'gnus-emphasis-custom-value-to-internal
+                (default-value symbol)))
+  :set (lambda (symbol value)
+        (set-default symbol (mapcar 'gnus-emphasis-custom-value-to-external
+                                    value)))
   :group 'gnus-article-emphasis)
 
 (defcustom gnus-emphasize-whitespace-regexp "^[ \t]+\\|[ \t]*\n"
@@ -609,6 +671,13 @@ The following additional specs are available:
   :type 'hook
   :group 'gnus-article-various)
 
+(defcustom gnus-copy-article-ignored-headers nil
+  "List of headers to be removed when copying an article.
+Each element is a regular expression."
+  :version "22.0" ;; No Gnus
+  :type '(repeat regexp)
+  :group 'gnus-article-various)
+
 (make-obsolete-variable 'gnus-article-hide-pgp-hook
                        "This variable is obsolete in Gnus 5.10.")
 
@@ -791,7 +860,7 @@ If set, this variable overrides `gnus-unbuttonized-mime-types'.
 To see e.g. security buttons you could set this to
 `(\"multipart/signed\")'.
 This variable is only used when `gnus-inhibit-mime-unbuttonizing' is nil."
-  :version "21.1"
+  :version "21.4"
   :group 'gnus-article-mime
   :type '(repeat regexp))
 
@@ -800,7 +869,7 @@ This variable is only used when `gnus-inhibit-mime-unbuttonizing' is nil."
 When nil (the default value), then some MIME parts do not get buttons,
 as described by the variables `gnus-buttonized-mime-types' and
 `gnus-unbuttonized-mime-types'."
-  :version "21.3"
+  :version "21.4"
   :group 'gnus-article-mime
   :type 'boolean)
 
@@ -808,6 +877,7 @@ as described by the variables `gnus-buttonized-mime-types' and
   "String used to delimit header and body.
 This variable is used by `gnus-article-treat-body-boundary' which can
 be controlled by `gnus-treat-body-boundary'."
+  :version "21.4"
   :group 'gnus-article-various
   :type '(choice (item :tag "None" :value nil)
                 string))
@@ -817,6 +887,7 @@ be controlled by `gnus-treat-body-boundary'."
   "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"
+  :version "21.4"
   :type '(repeat directory)
   :link '(url-link :tag "download"
                   "http://www.cs.indiana.edu/picons/ftp/index.html")
@@ -957,6 +1028,7 @@ See Info node `(gnus)Customizing Articles' for details."
   "Remove carriage returns.
 Valid values are nil, t, `head', `last', an integer or a predicate.
 See Info node `(gnus)Customizing Articles' for details."
+  :version "21.4"
   :group 'gnus-article-treat
   :link '(custom-manual "(gnus)Customizing Articles")
   :type gnus-article-treat-custom)
@@ -965,6 +1037,7 @@ See Info node `(gnus)Customizing Articles' for details."
   "Remove newlines from within URLs.
 Valid values are nil, t, `head', `last', an integer or a predicate.
 See Info node `(gnus)Customizing Articles' for details."
+  :version "21.4"
   :group 'gnus-article-treat
   :link '(custom-manual "(gnus)Customizing Articles")
   :type gnus-article-treat-custom)
@@ -973,6 +1046,7 @@ See Info node `(gnus)Customizing Articles' for details."
   "Remove leading whitespace in headers.
 Valid values are nil, t, `head', `last', an integer or a predicate.
 See Info node `(gnus)Customizing Articles' for details."
+  :version "21.4"
   :group 'gnus-article-treat
   :link '(custom-manual "(gnus)Customizing Articles")
   :type gnus-article-treat-custom)
@@ -1092,6 +1166,7 @@ See Info node `(gnus)Customizing Articles' for details."
   "Display the Date in a format that can be read aloud in English.
 Valid values are nil, t, `head', `last', an integer or a predicate.
 See Info node `(gnus)Customizing Articles' for details."
+  :version "21.4"
   :group 'gnus-article-treat
   :link '(custom-manual "(gnus)Customizing Articles")
   :type gnus-article-treat-head-custom)
@@ -1167,6 +1242,7 @@ See Info node `(gnus)Customizing Articles' for details."
   "Unfold folded header lines.
 Valid values are nil, t, `head', `last', an integer or a predicate.
 See Info node `(gnus)Customizing Articles' for details."
+  :version "21.4"
   :group 'gnus-article-treat
   :link '(custom-manual "(gnus)Customizing Articles")
   :type gnus-article-treat-custom)
@@ -1175,6 +1251,7 @@ See Info node `(gnus)Customizing Articles' for details."
   "Fold headers.
 Valid values are nil, t, `head', `last', an integer or a predicate.
 See Info node `(gnus)Customizing Articles' for details."
+  :version "21.4"
   :group 'gnus-article-treat
   :link '(custom-manual "(gnus)Customizing Articles")
   :type gnus-article-treat-custom)
@@ -1183,6 +1260,7 @@ See Info node `(gnus)Customizing Articles' for details."
   "Fold the Newsgroups and Followup-To headers.
 Valid values are nil, t, `head', `last', an integer or a predicate.
 See Info node `(gnus)Customizing Articles' for details."
+  :version "21.4"
   :group 'gnus-article-treat
   :link '(custom-manual "(gnus)Customizing Articles")
   :type gnus-article-treat-custom)
@@ -1284,7 +1362,7 @@ Valid values are nil, t, `head', `last', an integer or a predicate.
 See Info node `(gnus)Customizing Articles' and Info node
 `(gnus)X-Face' for details."
   :group 'gnus-article-treat
-  :version "21.1"
+  :version "21.4"
   :link '(custom-manual "(gnus)Customizing Articles")
   :link '(custom-manual "(gnus)X-Face")
   :type gnus-article-treat-head-custom)
@@ -1320,6 +1398,7 @@ See Info node `(gnus)Customizing Articles' and Info node
 Valid values are nil, t, `head', `last', an integer or a predicate.
 See Info node `(gnus)Customizing Articles' and Info node
 `(gnus)Picons' for details."
+  :version "21.4"
   :group 'gnus-article-treat
   :group 'gnus-picon
   :link '(custom-manual "(gnus)Customizing Articles")
@@ -1335,6 +1414,7 @@ See Info node `(gnus)Customizing Articles' and Info node
 Valid values are nil, t, `head', `last', an integer or a predicate.
 See Info node `(gnus)Customizing Articles' and Info node
 `(gnus)Picons' for details."
+  :version "21.4"
   :group 'gnus-article-treat
   :group 'gnus-picon
   :link '(custom-manual "(gnus)Customizing Articles")
@@ -1350,6 +1430,7 @@ See Info node `(gnus)Customizing Articles' and Info node
 Valid values are nil, t, `head', `last', an integer or a predicate.
 See Info node `(gnus)Customizing Articles' and Info node
 `(gnus)Picons' for details."
+  :version "21.4"
   :group 'gnus-article-treat
   :group 'gnus-picon
   :link '(custom-manual "(gnus)Customizing Articles")
@@ -1358,14 +1439,15 @@ See Info node `(gnus)Customizing Articles' and Info node
 (put 'gnus-treat-newsgroups-picon 'highlight t)
 
 (defcustom gnus-treat-body-boundary
-  (if (or gnus-treat-newsgroups-picon
-         gnus-treat-mail-picon
-         gnus-treat-from-picon)
+  (if (and (eq window-system 'x)
+          (or gnus-treat-newsgroups-picon
+              gnus-treat-mail-picon
+              gnus-treat-from-picon))
       '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."
-  :version "21.1"
+  :version "21.4"
   :group 'gnus-article-treat
   :link '(custom-manual "(gnus)Customizing Articles")
   :type gnus-article-treat-head-custom)
@@ -1383,6 +1465,7 @@ See Info node `(gnus)Customizing Articles' for details."
   "Format as HTML.
 Valid values are nil, t, `head', `last', an integer or a predicate.
 See Info node `(gnus)Customizing Articles' for details."
+  :version "21.4"
   :group 'gnus-article-treat
   :link '(custom-manual "(gnus)Customizing Articles")
   :type gnus-article-treat-custom)
@@ -1428,6 +1511,7 @@ See Info node `(gnus)Customizing Articles' for details."
 To automatically treat X-PGP-Sig, set it to head.
 Valid values are nil, t, `head', `last', an integer or a predicate.
 See Info node `(gnus)Customizing Articles' for details."
+  :version "21.4"
   :group 'gnus-article-treat
   :group 'mime-security
   :type gnus-article-treat-custom)
@@ -1449,6 +1533,7 @@ See Info node `(gnus)Customizing Articles' for details."
 (defcustom gnus-article-encrypt-protocol "PGP"
   "The protocol used for encrypt articles.
 It is a string, such as \"PGP\". If nil, ask user."
+  :version "21.4"
   :type 'string
   :group 'mime-security)
 
@@ -1460,11 +1545,13 @@ It is a string, such as \"PGP\". If nil, ask user."
                              (executable-find idna-program))
   "Whether IDNA decoding of headers is used when viewing messages.
 This requires GNU Libidn, and by default only enabled if it is found."
+  :version "21.4"
   :group 'gnus-article-headers
   :type 'boolean)
 
 (defcustom gnus-article-over-scroll nil
   "If non-nil, allow scrolling the article buffer even when there no more text."
+  :version "21.4"
   :group 'gnus-article
   :type 'boolean)
 
@@ -1762,12 +1849,9 @@ always hide."
     (save-excursion
       (save-restriction
        (let ((inhibit-read-only t)
-             (list gnus-boring-article-headers)
-             (inhibit-point-motion-hooks t)
-             elem)
+             (inhibit-point-motion-hooks t))
          (article-narrow-to-head)
-         (while list
-           (setq elem (pop list))
+         (dolist (elem gnus-boring-article-headers)
            (goto-char (point-min))
            (cond
             ;; Hide empty headers.
@@ -1975,9 +2059,8 @@ characters to translate to."
 MAP is an alist where the elements are on the form (\"from\" \"to\")."
   (save-excursion
     (when (article-goto-body)
-      (let ((inhibit-read-only t)
-           elem)
-       (while (setq elem (pop map))
+      (let ((inhibit-read-only t))
+       (dolist (elem map)
          (save-excursion
            (while (search-forward (car elem) nil t)
              (replace-match (cadr elem)))))))))
@@ -2201,7 +2284,7 @@ unfolded."
              (mail-narrow-to-head)
              (while (gnus-article-goto-header "Face")
                (setq faces (nconc faces (list (mail-header-field-value)))))))
-         (while (setq face (pop faces))
+         (dolist (face faces)
            (let ((png (gnus-convert-face-to-png face))
                  image)
              (when png
@@ -2489,7 +2572,7 @@ If READ-CHARSET, ask for a coding system."
     (let ((inhibit-read-only t))
       (goto-char (point-min))
       (while (re-search-forward
-             "^\\(\\(https?\\|ftp\\)://\\S-+\\) *\n\\(\\S-+\\)" nil t)
+             "\\(\\(https?\\|ftp\\)://\\S-+\\) *\n\\(\\S-+\\)" nil t)
        (replace-match "\\1\\3" t)))
     (when (interactive-p)
       (gnus-treat-article nil))))
@@ -4730,8 +4813,8 @@ N is the numerical prefix."
 
 (defun gnus-article-mime-match-handle-first (condition)
   (if condition
-      (let ((alist gnus-article-mime-handle-alist) ihandle n)
-       (while (setq ihandle (pop alist))
+      (let (n)
+       (dolist (ihandle gnus-article-mime-handle-alist)
          (if (and (cond
                    ((functionp condition)
                     (funcall condition (cdr ihandle)))
@@ -4898,11 +4981,15 @@ N is the numerical prefix."
          ;; We have to do this since selecting the window
          ;; may change the point.  So we set the window point.
          (set-window-point window point)))
-      (let* ((handles (or ihandles
-                         (mm-dissect-buffer nil gnus-article-loose-mime)
-                         (and gnus-article-emulate-mime
-                              (mm-uu-dissect))))
-            (inhibit-read-only t) handle name type b e display)
+      (let ((handles ihandles)
+           (inhibit-read-only t)
+           handle name type b e display)
+       (cond (handles)
+             ((setq handles (mm-dissect-buffer nil gnus-article-loose-mime))
+              (when gnus-article-emulate-mime
+                (mm-uu-dissect-text-parts handles)))
+             (gnus-article-emulate-mime
+              (setq handles (mm-uu-dissect))))
        (when (and (not ihandles)
                   (not gnus-displaying-mime))
          ;; Top-level call; we clean up.
@@ -4948,6 +5035,7 @@ If t, it overrides nil values of
 
 (defcustom gnus-mime-display-multipart-alternative-as-mixed nil
   "Display \"multipart/alternative\" parts as  \"multipart/mixed\"."
+  :version "21.4"
   :group 'gnus-article-mime
   :type 'boolean)
 
@@ -4957,6 +5045,7 @@ If t, it overrides nil values of
 If displaying \"text/html\" is discouraged \(see
 `mm-discouraged-alternatives'\) images or other material inside a
 \"multipart/related\" part might be overlooked when this variable is nil."
+  :version "21.4"
   :group 'gnus-article-mime
   :type 'boolean)
 
@@ -5061,7 +5150,7 @@ If displaying \"text/html\" is discouraged \(see
              (forward-line -1)
              (setq beg (point)))
            (gnus-article-insert-newline)
-           (mm-insert-inline handle (mm-get-part handle))
+           (mm-display-inline handle)
            (goto-char (point-max))))
          ;; Do highlighting.
          (save-excursion
@@ -5971,7 +6060,10 @@ groups."
   "Start editing the contents of the current article buffer."
   (let ((winconf (current-window-configuration)))
     (set-buffer gnus-article-buffer)
-    (gnus-article-edit-mode)
+    (let ((message-auto-save-directory
+          ;; Don't associate the article buffer with a draft file.
+          nil))
+      (gnus-article-edit-mode))
     (funcall start-func)
     (set-buffer-modified-p nil)
     (gnus-configure-windows 'edit-article)
@@ -6180,6 +6272,7 @@ after replacing with the original article."
 (defcustom gnus-button-valid-fqdn-regexp
   message-valid-fqdn-regexp
   "Regular expression that matches a valid FQDN."
+  :version "21.4"
   :group 'gnus-article-buttons
   :type 'regexp)
 
@@ -6187,6 +6280,7 @@ after replacing with the original article."
   "Function to use for displaying man pages.
 The function must take at least one argument with a string naming the
 man page."
+  :version "21.4"
   :type '(choice (function-item :tag "Man" manual-entry)
                 (function-item :tag "Woman" woman)
                 (function :tag "Other"))
@@ -6197,6 +6291,7 @@ man page."
 If the default site is too slow, try to find a CTAN mirror, see
 <URL:http://tug.ctan.org/tex-archive/CTAN.sites?action=/index.html>.  See also
 the variable `gnus-button-handle-ctan'."
+  :version "21.4"
   :group 'gnus-article-buttons
   :link '(custom-manual "(gnus)Group Parameters")
   :type '(choice (const "http://www.tex.ac.uk/tex-archive/")
@@ -6207,12 +6302,14 @@ the variable `gnus-button-handle-ctan'."
 (defcustom gnus-button-ctan-handler 'browse-url
   "Function to use for displaying CTAN links.
 The function must take one argument, the string naming the URL."
+  :version "21.4"
   :type '(choice (function-item :tag "Browse Url" browse-url)
                 (function :tag "Other"))
   :group 'gnus-article-buttons)
 
 (defcustom gnus-button-handle-ctan-bogus-regexp "^/?tex-archive/\\|^/"
   "Bogus strings removed from CTAN URLs."
+  :version "21.4"
   :group 'gnus-article-buttons
   :type '(choice (const "^/?tex-archive/\\|/")
                 (regexp :tag "Other")))
@@ -6226,6 +6323,7 @@ The function must take one argument, the string naming the URL."
    "\\)")
   "Regular expression for ctan directories.
 It should match all directories in the top level of `gnus-ctan-url'."
+  :version "21.4"
   :group 'gnus-article-buttons
   :type 'regexp)
 
@@ -6235,6 +6333,7 @@ It should match all directories in the top level of `gnus-ctan-url'."
          gnus-button-valid-fqdn-regexp
          ">?\\)\\b")
   "Regular expression that matches a message ID or a mail address."
+  :version "21.4"
   :group 'gnus-article-buttons
   :type 'regexp)
 
@@ -6246,6 +6345,7 @@ message ID or a mail address, respectively.  If this variable is set to the
 symbol `ask', always query the user what do do.  If it is a function, this
 function will be called with the string as it's only argument.  The function
 must return `mid', `mail', `invalid' or `ask'."
+  :version "21.4"
   :group 'gnus-article-buttons
   :type '(choice (function-item :tag "Heuristic function"
                                gnus-button-mid-or-mail-heuristic)
@@ -6309,6 +6409,7 @@ must return `mid', `mail', `invalid' or `ask'."
 
 A negative RATE indicates a message IDs, whereas a positive indicates a mail
 address.  The REGEXP is processed with `case-fold-search' set to nil."
+  :version "21.4"
   :group 'gnus-article-buttons
   :type '(repeat (cons (number :tag "Rate")
                       (regexp :tag "Regexp"))))
@@ -6493,6 +6594,7 @@ positives are possible.  Note that you can set this variable local to
 specific groups.  Setting it higher in TeX groups is probably a good idea.
 See Info node `(gnus)Group Parameters' and the variable `gnus-parameters' on
 how to set variables in specific groups."
+  :version "21.4"
   :group 'gnus-article-buttons
   :link '(custom-manual "(gnus)Group Parameters")
   :type 'integer)
@@ -6504,6 +6606,7 @@ positives are possible.  Note that you can set this variable local to
 specific groups.  Setting it higher in Unix groups is probably a good idea.
 See Info node `(gnus)Group Parameters' and the variable `gnus-parameters' on
 how to set variables in specific groups."
+  :version "21.4"
   :group 'gnus-article-buttons
   :link '(custom-manual "(gnus)Group Parameters")
   :type 'integer)
@@ -6515,6 +6618,7 @@ positives are possible.  Note that you can set this variable local to
 specific groups.  Setting it higher in Emacs or Gnus related groups is
 probably a good idea.  See Info node `(gnus)Group Parameters' and the variable
 `gnus-parameters' on how to set variables in specific groups."
+  :version "21.4"
   :group 'gnus-article-buttons
   :link '(custom-manual "(gnus)Group Parameters")
   :type 'integer)
@@ -6524,6 +6628,7 @@ probably a good idea.  See Info node `(gnus)Group Parameters' and the variable
 The higher the number, the more buttons will appear and the more false
 positives are possible."
   ;; mail addresses, MIDs, URLs for news, ...
+  :version "21.4"
   :group 'gnus-article-buttons
   :type 'integer)
 
@@ -6532,6 +6637,7 @@ positives are possible."
 The higher the number, the more buttons will appear and the more false
 positives are possible."
   ;; stuff handled by `browse-url' or `gnus-button-embedded-url'
+  :version "21.4"
   :group 'gnus-article-buttons
   :type 'integer)
 
@@ -6798,9 +6904,8 @@ do the highlighting.  See the documentation for those functions."
   "Highlight article headers as specified by `gnus-header-face-alist'."
   (interactive)
   (gnus-with-article-headers
-    (let ((alist gnus-header-face-alist)
-         entry regexp header-face field-face from hpoints fpoints)
-      (while (setq entry (pop alist))
+    (let (regexp header-face field-face from hpoints fpoints)
+      (dolist (entry gnus-header-face-alist)
        (goto-char (point-min))
        (setq regexp (concat "^\\("
                             (if (string-equal "" (nth 0 entry))
@@ -6905,11 +7010,9 @@ specified by `gnus-button-alist'."
   "Add buttons to the head of the article."
   (interactive)
   (gnus-with-article-headers
-    (let ((alist gnus-header-button-alist)
-         entry beg end)
-      (while alist
+    (let (beg end)
+      (dolist (entry gnus-header-button-alist)
        ;; Each alist entry.
-       (setq entry (pop alist))
        (goto-char (point-min))
        (while (re-search-forward (car entry) nil t)
          ;; Each header matching the entry.