+(defvar gnus-article-xface-ring-internal nil
+ "Cache for face data.")
+
+;; Worth customizing?
+(defvar gnus-article-xface-ring-size 6
+ "Length of the ring used for `gnus-article-xface-ring-internal'.")
+
+(defvar gnus-article-compface-xbm
+ (condition-case ()
+ (eq 0 (string-match "#define"
+ (shell-command-to-string "uncompface -X")))
+ (error nil))
+ "Non-nil means the compface program supports the -X option.
+That produces XBM output.")
+
+(defun gnus-article-display-xface (beg end &optional buffer)
+ "Display an XFace header from between BEG and END in BUFFER.
+Requires support for images in your Emacs and the external programs
+`uncompface', and `icontopbm'. On a GNU/Linux system these
+might be in packages with names like `compface' or `faces-xface' and
+`netpbm' or `libgr-progs', for instance. See also
+`gnus-article-compface-xbm'.
+
+This function is for Emacs 21+. See `gnus-xmas-article-display-xface'
+for XEmacs."
+ ;; It might be worth converting uncompface's output in Lisp.
+
+ (when (if (fboundp 'display-graphic-p)
+ (display-graphic-p))
+ (unless gnus-article-xface-ring-internal ; Only load ring when needed.
+ (setq gnus-article-xface-ring-internal
+ (make-ring gnus-article-xface-ring-size)))
+ (save-excursion
+ (let* ((cur (current-buffer))
+ (data (if buffer
+ (with-current-buffer buffer
+ (buffer-substring beg end))
+ (buffer-substring beg end)))
+ (image (cdr-safe (assoc data (ring-elements
+ gnus-article-xface-ring-internal))))
+ default-enable-multibyte-characters)
+ (unless image
+ (with-temp-buffer
+ (insert data)
+ (and (eq 0 (apply #'call-process-region (point-min) (point-max)
+ "uncompface"
+ 'delete '(t nil) nil
+ (if gnus-article-compface-xbm
+ '("-X"))))
+ (if gnus-article-compface-xbm
+ t
+ (goto-char (point-min))
+ (progn (insert "/* Width=48, Height=48 */\n") t)
+ (eq 0 (call-process-region (point-min) (point-max)
+ "icontopbm"
+ 'delete '(t nil))))
+ ;; Miles Bader says that faces don't look right as
+ ;; light on dark.
+ (if (eq 'dark (cdr-safe (assq 'background-mode
+ (frame-parameters))))
+ (setq image (create-image (buffer-string)
+ (if gnus-article-compface-xbm
+ 'xbm
+ 'pbm)
+ t
+ :ascent 'center
+ :foreground "black"
+ :background "white"))
+ (setq image (create-image (buffer-string)
+ (if gnus-article-compface-xbm
+ 'xbm
+ 'pbm)
+ t
+ :ascent 'center)))))
+ (ring-insert gnus-article-xface-ring-internal (cons data image)))
+ (when image
+ (goto-char (point-min))
+ (re-search-forward "^From:" nil 'move)
+ (insert-image image))))))