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.

diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index f11cff5..05eb4a0 100644 (file)
--- 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 d8ca187..ba2c3ff 100644 (file)
--- 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."