emacs: lisp/gnus/gnus-art.el comparison

comparison lisp/gnus/gnus-art.el @ 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	cf8b4d09b958
children	18a818a2ee7c

comparison

equal deleted inserted replaced

-:15a0b97b4797
+:6e92df884ee6
 ;; D d' would have). So face deletion must occur only when we come from
 ;; an interactive command, that is when the *Article* buffer is
 ;; read-only.
 (if (and wash-face-p (memq 'face gnus-article-wash-types))
 	  (gnus-delete-images 'face)
-	(let ((from (gnus-article-goto-header "from"))
+	(let (face faces from)
-	      face faces)
+	  (save-current-buffer
-	  (save-excursion
 	    (when (and wash-face-p
-		       (progn
+		       (gnus-buffer-live-p gnus-original-article-buffer)
-			 (goto-char (point-min))
+		       (not (re-search-forward "^Face:[\t ]*" nil t)))
-			 (not (re-search-forward "^Face:[\t ]*" nil t)))
-		       (gnus-buffer-live-p gnus-original-article-buffer))
 	      (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
+	    (goto-char (point-min))
-	      (insert "From:")
+	    (let ((from (gnus-article-goto-header "from"))
-	      (setq from (point))
+		  png image)
-	      (insert "[no `from' set]\n"))
+	      (unless from
-	    (dolist (face faces)
+		(insert "From:")
-	      (let ((png (gnus-convert-face-to-png face))
+		(setq from (point))
-		    image)
+		(insert "[no `from' set]\n"))
-		(when png
+	      (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)
 		  (gnus-add-image 'face image)
 		  (gnus-put-image image nil 'face))))))))))
 	  ;; We have already displayed X-Faces, so we remove them
 	  ;; instead.
 	  (gnus-delete-images 'xface)
 	;; Display X-Faces.
 	(let (x-faces from face)
-	  (save-excursion
+	  (save-current-buffer
 	    (when (and wash-face-p
-		       (progn
+		       (gnus-buffer-live-p gnus-original-article-buffer)
-			 (goto-char (point-min))
+		       (not (re-search-forward "^X-Face:[\t ]*" nil t)))
-			 (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
 	      (setq from (message-fetch-field "from"))))
 	  ;; 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))
+	  (when (and x-faces
-		      gnus-article-x-face-command
+		     gnus-article-x-face-command
-		      (or force
+		     (or force
-			  ;; Check whether this face is censored.
+			 ;; Check whether this face is censored.
-			  (not gnus-article-x-face-too-ugly)
+			 (not gnus-article-x-face-too-ugly)
-			  (and gnus-article-x-face-too-ugly from
+			 (and from
-			       (not (string-match gnus-article-x-face-too-ugly
+			      (not (string-match gnus-article-x-face-too-ugly
-						  from)))))
+						 from)))))
-	    ;; We display the face.
+	    (while (setq face (pop x-faces))
-	    (cond ((stringp gnus-article-x-face-command)
+	      ;; We display the face.
-		   ;; The command is a string, so we interpret the command
+	      (cond ((stringp gnus-article-x-face-command)
-		   ;; as a, well, command, and fork it off.
+		     ;; The command is a string, so we interpret the command
-		   (let ((process-connection-type nil))
+		     ;; as a, well, command, and fork it off.
-		     (gnus-set-process-query-on-exit-flag
+		     (let ((process-connection-type nil))
-		      (start-process
+		       (gnus-set-process-query-on-exit-flag
-		       "article-x-face" nil shell-file-name
+			(start-process
-		       shell-command-switch gnus-article-x-face-command)
+			 "article-x-face" nil shell-file-name
-		      nil)
+			 shell-command-switch gnus-article-x-face-command)
-		     (with-temp-buffer
+			nil)
-		       (insert face)
+		       (with-temp-buffer
-		       (process-send-region "article-x-face"
+			 (insert face)
-					    (point-min) (point-max)))
+			 (process-send-region "article-x-face"
-		     (process-send-eof "article-x-face")))
+					      (point-min) (point-max)))
-		  ((functionp gnus-article-x-face-command)
+		       (process-send-eof "article-x-face")))
-		   ;; The command is a lisp function, so we call it.
+		    ((functionp gnus-article-x-face-command)
-		   (funcall gnus-article-x-face-command face))
+		     ;; The command is a lisp function, so we call it.
-		  (t
+		     (funcall gnus-article-x-face-command face))
-		   (error "%s is not a function"
+		    (t
-			  gnus-article-x-face-command)))))))))
+		     (error "%s is not a function"
+			    gnus-article-x-face-command))))))))))
 (defun article-decode-mime-words ()
 "Decode all MIME-encoded words in the article."
 (interactive)
 (save-excursion

Mercurial > emacs

comparison lisp/gnus/gnus-art.el @ 63906:6e92df884ee6