Function: mh-face-display-function

mh-face-display-function is a byte-compiled function defined in mh-xface.el.gz.

Signature

(mh-face-display-function)

Documentation

Display a Face, X-Face, or X-Image-URL header field.

If more than one of these are present, then the first one found in this order is used.

Source Code

;; Defined in /usr/src/emacs/lisp/mh-e/mh-xface.el.gz
(defun mh-face-display-function ()
  "Display a Face, X-Face, or X-Image-URL header field.
If more than one of these are present, then the first one found
in this order is used."
  (save-restriction
    (goto-char (point-min))
    (re-search-forward "\n\n" (point-max) t)
    (narrow-to-region (point-min) (point))
    (let* ((case-fold-search t)
           (face (message-fetch-field "face" t))
           (x-face (message-fetch-field "x-face" t))
           (url (message-fetch-field "x-image-url" t))
           raw type)
      (cond (face (setq raw (mh-face-to-png face)
                        type 'png))
            (x-face (setq raw (mh-uncompface x-face)
                          type 'pbm))
            (url (setq type 'url))
            (t (cl-multiple-value-setq (type raw)
                 (cl-values-list (mh-picon-get-image)))))
      (when type
        (goto-char (point-min))
        (when (re-search-forward "^from:" (point-max) t)
          ;; GNU Emacs
          (mh-do-in-gnu-emacs
            (if (eq type 'url)
                (mh-x-image-url-display url)
              (mh-funcall-if-exists
               insert-image (create-image
                             raw type t
                             :foreground
                             (mh-face-foreground 'mh-show-xface nil t)
                             :background
                             (mh-face-background 'mh-show-xface nil t))
               " ")))
          ;; XEmacs
          (mh-do-in-xemacs
            (cond
             ((eq type 'url)
              (mh-x-image-url-display url))
             ((eq type 'png)
              (when (featurep 'png)
                (set-extent-begin-glyph
                 (make-extent (point) (point))
                 (make-glyph (vector 'png ':data (mh-face-to-png face))))))
             ;; Try internal xface support if available...
             ((and (eq type 'pbm) (featurep 'xface))
              (set-glyph-face
               (set-extent-begin-glyph
                (make-extent (point) (point))
                (make-glyph (vector 'xface ':data (concat "X-Face: " x-face))))
               'mh-show-xface))
             ;; Otherwise try external support with x-face...
             ((and (eq type 'pbm)
                   (fboundp 'x-face-xmas-wl-display-x-face)
                   (fboundp 'executable-find) (executable-find "uncompface"))
              (mh-funcall-if-exists x-face-xmas-wl-display-x-face))
             ;; Picon display
             ((and raw (member type '(xpm xbm gif)))
              (when (featurep type)
                (set-extent-begin-glyph
                 (make-extent (point) (point))
                 (make-glyph (vector type ':data raw))))))
            (when raw (insert " "))))))))