;;; gnus-ems.el --- functions for making Gnus work under different Emacsen
-;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000
+;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
;;; Function aliases later to be redefined for XEmacs usage.
-(defvar gnus-xemacs (string-match "XEmacs\\|Lucid" emacs-version)
- "Non-nil if running under XEmacs.")
+(eval-and-compile
+ (defvar gnus-xemacs (featurep 'xemacs)
+ "Non-nil if running under XEmacs."))
(defvar gnus-mouse-2 [mouse-2])
(defvar gnus-down-mouse-3 [down-mouse-3])
valstr)))
(eval-and-compile
- (if (string-match "XEmacs\\|Lucid" emacs-version)
- nil
-
+ (if gnus-xemacs
+ (gnus-xmas-define)
(defvar gnus-mouse-face-prop 'mouse-face
- "Property used for highlighting mouse regions."))
-
- (cond
- ((string-match "XEmacs\\|Lucid" emacs-version)
- (gnus-xmas-define))
-
- ((boundp 'MULE)
- (provide 'gnusutil))))
+ "Property used for highlighting mouse regions.")))
(eval-and-compile
(cond
((not window-system)
- (defun gnus-dummy-func (&rest args))
(let ((funcs '(mouse-set-point set-face-foreground
set-face-background x-popup-menu)))
(while funcs
(unless (fboundp (car funcs))
- (fset (car funcs) 'gnus-dummy-func))
+ (defalias (car funcs) 'ignore))
(setq funcs (cdr funcs)))))))
(eval-and-compile
(defun gnus-ems-redefine ()
(cond
- ((string-match "XEmacs\\|Lucid" emacs-version)
+ (gnus-xemacs
(gnus-xmas-redefine))
((featurep 'mule)
;; Mule and new Emacs definitions
;; [Note] Now there are three kinds of mule implementations,
- ;; original MULE, XEmacs/mule and beta version of Emacs including
- ;; some mule features. Unfortunately these API are different. In
+ ;; original MULE, XEmacs/mule and Emacs 20+ including
+ ;; MULE features. Unfortunately these API are different. In
;; particular, Emacs (including original MULE) and XEmacs are
- ;; quite different.
+ ;; quite different. Howvere, this version of Gnus doesn't support
+ ;; anything other than XEmacs 20+ and Emacs 20.3+.
+
;; Predicates to check are following:
;; (boundp 'MULE) is t only if MULE (original; anything older than
;; Mule 2.3) is running.
;; (featurep 'mule) is t when every mule variants are running.
- ;; These implementations may be able to share between original
- ;; MULE and beta version of new Emacs. In addition, it is able to
- ;; detect XEmacs/mule by (featurep 'mule) and to check variable
- ;; `emacs-version'. In this case, implementation for XEmacs/mule
- ;; may be able to share between XEmacs and XEmacs/mule.
+ ;; It is possible to detect XEmacs/mule by (featurep 'mule) and
+ ;; checking `emacs-version'. In this case, the implementation for
+ ;; XEmacs/mule may be shareable between XEmacs and XEmacs/mule.
(defvar gnus-summary-display-table nil
"Display table used in summary mode buffers.")
- (fset 'gnus-max-width-function 'gnus-mule-max-width-function)
- (fset 'gnus-summary-set-display-table (lambda ()))
+ (defalias 'gnus-max-width-function 'gnus-mule-max-width-function)
(when (boundp 'gnus-check-before-posting)
(setq gnus-check-before-posting
(boundp 'mark-active)
mark-active))
-(defun gnus-add-minor-mode (mode name map)
- (if (fboundp 'add-minor-mode)
- (add-minor-mode mode name map)
+(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))
(let ((buffer-read-only nil))
(erase-buffer)
(when (and dir
- (file-exists-p (setq file (concat dir "x-splash"))))
+ (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
- (unless (facep 'gnus-splash)
- (make-face 'gnus-splash))
+ (make-face 'gnus-splash)
(setq height (/ (car pixmap) (frame-char-height))
width (/ (cadr pixmap) (frame-char-width)))
(set-face-foreground 'gnus-splash "Brown")
(insert-char ?\n (* (/ (window-height) 2 height) height))
(setq i height)
(while (> i 0)
- (insert-char ? (* (/ (window-width) 2 width) width))
+ (insert-char ?\ (* (/ (window-width) 2 width) width))
(setq beg (point))
- (insert-char ? width)
+ (insert-char ?\ width)
(set-text-properties beg (point) '(face gnus-splash))
- (insert "\n")
+ (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'.")
+
+(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
+might be in packages with names like `compface' or `faces-xface' and
+`netpbm' or `libgr-progs', for instance.
+
+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))
+ (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)))
+ (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)))))
+
(provide 'gnus-ems)
;; Local Variables:
projects / gnus / blobdiff