Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-464

Merge from gnus--rel--5.10

Patches applied:

 * gnus--rel--5.10  (patch 87)

   - Update from CVS

2005-07-01  Katsumi Yamaoka  <yamaoka@jpl.org>

   * lisp/gnus/gnus-art.el (article-display-face): Improve the efficiency.
   (article-display-x-face): Ditto; remove grey x-face stuff.

2 files changed, 51 insertions, 50 deletions

diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index f11cff564c3..05eb4a0c1f0 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,8 @@
+2005-07-01  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+        * gnus-art.el (article-display-face): Improve the efficiency.
+        (article-display-x-face): Ditto; remove grey x-face stuff.
+
 2005-06-30  Katsumi Yamaoka  <yamaoka@jpl.org>
 
         * gnus-art.el (article-display-face): Correct the position in
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index d8ca1877997..ba2c3ff9618 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -2123,28 +2123,26 @@ unfolded."
       ;; read-only.
       (if (and wash-face-p (memq 'face gnus-article-wash-types))
           (gnus-delete-images 'face)
-        (let ((from (gnus-article-goto-header "from"))
-              face faces)
-          (save-excursion
+        (let (face faces from)
+          (save-current-buffer
             (when (and wash-face-p
-                       (progn
-                         (goto-char (point-min))
-                         (not (re-search-forward "^Face:[\t ]*" nil t)))
-                       (gnus-buffer-live-p gnus-original-article-buffer))
+                       (gnus-buffer-live-p gnus-original-article-buffer)
+                       (not (re-search-forward "^Face:[\t ]*" nil t)))
               (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 faces
-            (unless from
-              (insert "From:")
-              (setq from (point))
-              (insert "[no `from' set]\n"))
-            (dolist (face faces)
-              (let ((png (gnus-convert-face-to-png face))
-                    image)
-                (when png
+            (goto-char (point-min))
+            (let ((from (gnus-article-goto-header "from"))
+                  png image)
+              (unless from
+                (insert "From:")
+                (setq from (point))
+                (insert "[no `from' set]\n"))
+              (while faces
+                (when (setq png (gnus-convert-face-to-png (pop faces)))
                   (setq image (gnus-create-image png 'png t))
                   (goto-char from)
                   (gnus-add-wash-type 'face)
@@ -2166,13 +2164,10 @@ unfolded."
           (gnus-delete-images 'xface)
         ;; Display X-Faces.
         (let (x-faces from face)
-          (save-excursion
+          (save-current-buffer
             (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))
+                       (gnus-buffer-live-p gnus-original-article-buffer)
+                       (not (re-search-forward "^X-Face:[\t ]*" nil t)))
               ;; If type `W f', use gnus-original-article-buffer,
               ;; otherwise use the current buffer because displaying
               ;; RFC822 parts calls this function too.
@@ -2186,35 +2181,36 @@ unfolded."
           ;; 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.
-            (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)))))))))
+          (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))))))))))
 
 (defun article-decode-mime-words ()
   "Decode all MIME-encoded words in the article."