mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-02-23 00:10:48 -08:00
Code Issues Projects Releases Wiki Activity

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

Browse source 
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.
This commit is contained in:
Miles Bader 2005-07-02 02:53:20 +00:00
parent c2baa2b65b
commit 7d0c69befb
2 changed files with 51 additions and 50 deletions
Download patch file Download diff file Expand all files Collapse all files

5
lisp/gnus/ChangeLog
View file

@ -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

96
lisp/gnus/gnus-art.el
View file

@ -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."