+(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)
+ "Display an XFace header from between BEG and END in the current article.
+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 (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))))))
+
+(defun-maybe assoc-ignore-case (key alist)
+ "Like `assoc', but assumes KEY is a string and ignores case when comparing."
+ (setq key (downcase key))
+ (let (element)
+ (while (and alist (not element))
+ (if (equal key (downcase (car (car alist))))
+ (setq element (car alist)))
+ (setq alist (cdr alist)))
+ element))
+
+\f
+;;; Language support staffs.
+
+(defvar-maybe current-language-environment "English"
+ "The language environment.")
+
+(defvar-maybe language-info-alist nil
+ "Alist of language environment definitions.")
+
+(defun-maybe get-language-info (lang-env key)
+ "Return information listed under KEY for language environment LANG-ENV."
+ (if (symbolp lang-env)
+ (setq lang-env (symbol-name lang-env)))
+ (let ((lang-slot (assoc-ignore-case lang-env language-info-alist)))
+ (if lang-slot
+ (cdr (assq key (cdr lang-slot))))))
+
+(defun-maybe set-language-info (lang-env key info)
+ "Modify part of the definition of language environment LANG-ENV."
+ (if (symbolp lang-env)
+ (setq lang-env (symbol-name lang-env)))
+ (let (lang-slot key-slot)
+ (setq lang-slot (assoc lang-env language-info-alist))
+ (if (null lang-slot) ; If no slot for the language, add it.
+ (setq lang-slot (list lang-env)
+ language-info-alist (cons lang-slot language-info-alist)))
+ (setq key-slot (assq key lang-slot))
+ (if (null key-slot) ; If no slot for the key, add it.
+ (progn
+ (setq key-slot (list key))
+ (setcdr lang-slot (cons key-slot (cdr lang-slot)))))
+ (setcdr key-slot info)))