;;; gnus-ems.el --- functions for making Gnus work under different Emacsen
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile
+ (require 'cl)
+ (require 'ring))
;;; Function aliases later to be redefined for XEmacs usage.
-(eval-and-compile
- (defvar gnus-xemacs (string-match "XEmacs" emacs-version)
- "Non-nil if running under XEmacs."))
-
(defvar gnus-mouse-2 [mouse-2])
(defvar gnus-down-mouse-3 [down-mouse-3])
(defvar gnus-down-mouse-2 [down-mouse-2])
(defvar gnus-widget-button-keymap nil)
(defvar gnus-mode-line-modified
- (if (or gnus-xemacs
+ (if (or (featurep 'xemacs)
(< emacs-major-version 20))
'("--**-" . "-----")
'("**" "--")))
(autoload 'gnus-xmas-redefine "gnus-xmas")
(autoload 'appt-select-lowest-window "appt"))
+(autoload 'smiley-region "smiley")
+
+(defun gnus-kill-all-overlays ()
+ "Delete all overlays in the current buffer."
+ (let* ((overlayss (overlay-lists))
+ (buffer-read-only nil)
+ (overlays (delq nil (nconc (car overlayss) (cdr overlayss)))))
+ (while overlays
+ (delete-overlay (pop overlays)))))
+
;;; Mule functions.
(defun gnus-mule-max-width-function (el max-width)
valstr)))
(eval-and-compile
- (if gnus-xemacs
+ (defalias 'gnus-char-width
+ (if (fboundp 'char-width)
+ 'char-width
+ (lambda (ch) 1)))) ;; A simple hack.
+
+(eval-and-compile
+ (if (featurep 'xemacs)
(gnus-xmas-define)
(defvar gnus-mouse-face-prop 'mouse-face
"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))
- (defalias (car funcs) 'gnus-dummy-func))
- (setq funcs (cdr funcs)))))))
-
-(eval-and-compile
- (let ((case-fold-search t))
- (cond
- ((string-match "windows-nt\\|os/2\\|emx\\|cygwin32"
- (symbol-name system-type))
- (setq nnheader-file-name-translation-alist
- (append nnheader-file-name-translation-alist
- (mapcar (lambda (c) (cons c ?_))
- '(?: ?* ?\" ?< ?> ??))
- '((?+ . ?-))))))))
-
(defvar gnus-tmp-unread)
(defvar gnus-tmp-replied)
(defvar gnus-tmp-score-char)
(defvar gnus-tmp-name)
(defvar gnus-tmp-closing-bracket)
(defvar gnus-tmp-subject-or-nil)
+(defvar gnus-check-before-posting)
(defun gnus-ems-redefine ()
(cond
- (gnus-xemacs
+ ((featurep 'xemacs)
(gnus-xmas-redefine))
((featurep 'mule)
;; 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. Howvere, this version of Gnus doesn't support
+ ;; quite different. However, this version of Gnus doesn't support
;; anything other than XEmacs 20+ and Emacs 20.3+.
;; Predicates to check are following:
(defvar gnus-summary-display-table nil
"Display table used in summary mode buffers.")
(defalias 'gnus-max-width-function 'gnus-mule-max-width-function)
- (defalias 'gnus-summary-set-display-table (lambda ()))
(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))
pixmap file height beg i)
(save-excursion
(switch-to-buffer (gnus-get-buffer-create gnus-group-buffer))
- (let ((buffer-read-only nil))
+ (let ((buffer-read-only nil)
+ width height)
(erase-buffer)
(when (and dir
- (file-exists-p (setq file (concat dir "x-splash"))))
- (with-temp-buffer
- (insert-file-contents file)
- (goto-char (point-min))
- (ignore-errors
- (setq pixmap (read (current-buffer))))))
+ (file-exists-p (setq file
+ (expand-file-name "x-splash" dir))))
+ (let ((coding-system-for-read 'raw-text)
+ default-enable-multibyte-characters)
+ (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))))))
-(defun gnus-article-display-xface (beg end)
- "Display an XFace header from between BEG and END in the current article.
-This requires support for XPM or XBM images in your Emacs and the
-external programs `uncompface', `icontopbm' and either `ppmtoxpm' (for
-XPM support) or `ppmtoxbm' (for XBM support). 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."
- (save-excursion
- (let ((cur (current-buffer))
- image type)
- (when (and (fboundp 'image-type-available-p)
- (cond ((image-type-available-p 'xpm) (setq type 'xpm))
- ((image-type-available-p 'xbm) (setq type 'xbm))))
- (with-temp-buffer
- (insert-buffer-substring cur beg end)
- (call-process-region (point-min) (point-max) "uncompface"
- 'delete '(t nil))
- (goto-char (point-min))
- (insert "/* Width=48, Height=48 */\n")
- (and (eq 0 (call-process-region (point-min) (point-max) "icontopbm"
- 'delete '(t nil)))
- (eq 0 (call-process-region (point-min) (point-max)
- (if (eq type 'xpm)
- "ppmtoxpm"
- "pbmtoxbm")
- 'delete '(t nil)))
- (setq image (create-image (buffer-string) type t))))
- (when image
- (goto-char (point-min))
- (re-search-forward "^From:" nil 'move)
- (insert-image image " "))))))
+;;; Image functions.
+
+(defun gnus-image-type-available-p (type)
+ (and (fboundp 'image-type-available-p)
+ (image-type-available-p type)))
+
+(defun gnus-create-image (file &optional type data-p &rest props)
+ (let ((face (plist-get props :face)))
+ (when face
+ (setq props (plist-put props :foreground (face-foreground face)))
+ (setq props (plist-put props :background (face-background face))))
+ (apply 'create-image file type data-p props)))
+
+(defun gnus-put-image (glyph &optional string)
+ (insert-image glyph (or string " "))
+ (unless string
+ (put-text-property (1- (point)) (point)
+ 'gnus-image-text-deletable t))
+ glyph)
+
+(defun gnus-remove-image (image)
+ (dolist (position (message-text-with-property 'display))
+ (when (equal (get-text-property position 'display) image)
+ (put-text-property position (1+ position) 'display nil)
+ (when (get-text-property position 'gnus-image-text-deletable)
+ (delete-region position (1+ position))))))
(provide 'gnus-ems)
-;; Local Variables:
-;; byte-compile-warnings: '(redefine callargs)
-;; End:
-
;;; gnus-ems.el ends here
projects / elisp / gnus.git- / blobdiff