changeset 63906:6e92df884ee6

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.
author Miles Bader <miles@gnu.org>
date Sat, 02 Jul 2005 02:53:20 +0000
parents 15a0b97b4797
children 2e6177253f28
files lisp/gnus/ChangeLog lisp/gnus/gnus-art.el
diffstat 2 files changed, 51 insertions(+), 50 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/gnus/ChangeLog	Fri Jul 01 21:28:08 2005 +0000
+++ b/lisp/gnus/ChangeLog	Sat Jul 02 02:53:20 2005 +0000
@@ -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
--- a/lisp/gnus/gnus-art.el	Fri Jul 01 21:28:08 2005 +0000
+++ b/lisp/gnus/gnus-art.el	Sat Jul 02 02:53:20 2005 +0000
@@ -2123,28 +2123,26 @@
       ;; 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 @@
 	  (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 @@
 	  ;; 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."