Function: article-display-face

article-display-face is an interactive and byte-compiled function defined in gnus-art.el.gz.

Signature

(article-display-face &optional FORCE)

Documentation

Display any Face headers in the header.

Key Bindings

Source Code

;; Defined in /usr/src/emacs/lisp/gnus/gnus-art.el.gz
(defun article-display-face (&optional force)
  "Display any Face headers in the header."
  (interactive (list 'force) gnus-article-mode gnus-summary-mode)
  (let ((wash-face-p buffer-read-only))
    (gnus-with-article-headers
      ;; When displaying parts, this function can be called several times on
      ;; the same article, without any intended toggle semantic (as typing `W
      ;; 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 (message-fetch-field "from"))
	      faces)
	  (save-current-buffer
	    (when (and wash-face-p
		       (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)
	      (when (or force
			;; Check whether this face is censored.
			(not (and gnus-article-x-face-too-ugly
				  (or from
				      (setq from (message-fetch-field "from")))
				  (string-match gnus-article-x-face-too-ugly
						from))))
		(while (gnus-article-goto-header "Face")
		  (push (mail-header-field-value) faces)))))
	  (when faces
	    (goto-char (point-min))
	    (let (png image)
	      (unless (setq from (gnus-article-goto-header "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
			(apply #'gnus-create-image png 'png t
			       (cdr (assq 'png gnus-face-properties-alist))))
		  (goto-char from)
		  (when image
		    (gnus-add-wash-type 'face)
		    (gnus-add-image 'face image)
		    (gnus-put-image image nil 'face)))))))))))