-(if (fboundp 'add-minor-mode)
- (defalias 'gnus-add-minor-mode 'add-minor-mode)
- (defun gnus-add-minor-mode (mode name map &rest rest)
- (set (make-local-variable mode) t)
- (unless (assq mode minor-mode-alist)
- (push `(,mode ,name) minor-mode-alist))
- (unless (assq mode minor-mode-map-alist)
- (push (cons mode map)
- minor-mode-map-alist))))
-
-(defun gnus-x-splash ()
- "Show a splash screen using a pixmap in the current buffer."
- (let ((dir (nnheader-find-etc-directory "gnus"))
- pixmap file height beg i)
- (save-excursion
- (switch-to-buffer (gnus-get-buffer-create gnus-group-buffer))
- (let ((buffer-read-only nil)
- width height)
- (erase-buffer)
- (when (and dir
- (file-exists-p (setq file
- (expand-file-name "x-splash" dir))))
- (with-temp-buffer
- (insert-file-contents file)
- (goto-char (point-min))
- (ignore-errors
- (setq pixmap (read (current-buffer))))))
- (when pixmap
- (make-face 'gnus-splash)
- (setq height (/ (car pixmap) (frame-char-height))
- width (/ (cadr pixmap) (frame-char-width)))
- (set-face-foreground 'gnus-splash "Brown")
- (set-face-stipple 'gnus-splash pixmap)
- (insert-char ?\n (* (/ (window-height) 2 height) height))
- (setq i height)
- (while (> i 0)
- (insert-char ?\ (* (/ (window-width) 2 width) width))
- (setq beg (point))
- (insert-char ?\ width)
- (set-text-properties beg (point) '(face gnus-splash))
- (insert ?\n)
- (decf i))
- (goto-char (point-min))
- (sit-for 0))))))
-
-(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 (data)
- "Display the XFace header FACE in the current 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))
- (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)
- (while (get-text-property (point) 'display)
- (goto-char (next-single-property-change (point) 'display)))
- (gnus-add-wash-type 'xface)
- (gnus-add-image 'xface image)
- (insert-image image))))))