(gnus-smiley-display): Autoload.

(mouse-set-point, set-face-foreground, set-face-background)
(x-popup-menu): Don't clobber these.
(gnus-article-compface-xbm): New variable.
(gnus-article-display-xface): Move graphic test.  Use unibyte.
Obey gnus-article-compface-xbm.  Use pbm, not xbm.

diff --git a/lisp/gnus-ems.el b/lisp/gnus-ems.el
index 647c12c..36bf70b 100644 (file)
--- a/lisp/gnus-ems.el
+++ b/lisp/gnus-ems.el
@@ -49,6 +49,8 @@
   (autoload 'gnus-xmas-redefine "gnus-xmas")
   (autoload 'appt-select-lowest-window "appt"))
 
+(autoload 'gnus-smiley-display "smiley-ems") ; override XEmacs version
+
 ;;; Mule functions.
 
 (defun gnus-mule-max-width-function (el max-width)
@@ -65,16 +67,6 @@
     (defvar gnus-mouse-face-prop 'mouse-face
       "Property used for highlighting mouse regions.")))
 
-(eval-and-compile
-  (cond
-   ((not window-system)
-    (let ((funcs '(mouse-set-point set-face-foreground
-                                  set-face-background x-popup-menu)))
-      (while funcs
-       (unless (fboundp (car funcs))
-         (defalias (car funcs) 'ignore))
-       (setq funcs (cdr funcs)))))))
-
 (eval-and-compile
   (let ((case-fold-search t))
     (cond
@@ -205,58 +197,63 @@
 (defvar gnus-article-xface-ring-size 6
   "Length of the ring used for `gnus-article-xface-ring-internal'.")
 
+(defvar gnus-article-compface-xbm
+  (eq 0 (string-match "#define" (shell-command-to-string "uncompface -X")))
+  "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', `icontopbm' and `ppmtoxbm'.  On a GNU/Linux system these
+`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.
+`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.
 
-  (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)))))
-      (when (if (fboundp 'display-graphic-p)
-               (display-graphic-p))
+  (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
-         (let ((coding-system-for-read 'binary)
-               (coding-system-for-write 'binary))
-           (with-temp-buffer
-             (insert data)
-             (and (eq 0 (call-process-region (point-min) (point-max)
-                                             "uncompface"
-                                             'delete '(t nil)))
+         (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"))))
+                (unless gnus-article-compface-xbm
                   (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)))
-                  (eq 0 (call-process-region (point-min) (point-max)
-                                             "pbmtoxbm"
-                                             '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) 'xbm t
-                                                :ascent 'center
-                                                :foreground "black"
-                                                :background "white"))
-                    (setq image (create-image (buffer-string) 'xbm 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)))))
+                                             '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) 'pbm t
+                                              :ascent 'center
+                                              :foreground "black"
+                                              :background "white"))
+                  (setq image (create-image (buffer-string) '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))))))
 
 (provide 'gnus-ems)