;;; gnus-ems.el --- functions for making Semi-gnus work under different Emacsen
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
(defvar gnus-down-mouse-2 [down-mouse-2])
(defvar gnus-widget-button-keymap nil)
(defvar gnus-mode-line-modified
- (if (or (featurep 'xemacs)
- (< emacs-major-version 20))
+ (if (featurep 'xemacs)
'("--**-" . "-----")
'("**" "--")))
(eval-and-compile
(autoload 'gnus-xmas-define "gnus-xmas")
(autoload 'gnus-xmas-redefine "gnus-xmas")
- (autoload 'appt-select-lowest-window "appt")
(autoload 'gnus-get-buffer-create "gnus")
(autoload 'nnheader-find-etc-directory "nnheader"))
(autoload 'smiley-region "smiley")
-;; Fixme: shouldn't require message
-(autoload 'message-text-with-property "message")
(defun gnus-kill-all-overlays ()
"Delete all overlays in the current buffer."
;;; Mule functions.
(eval-and-compile
- (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
(gnus-truncate-string val (string-width val) ,cut))))))
))
+;; Clone of `appt-select-lowest-window' in appt.el.
+(defun gnus-select-lowest-window ()
+"Select the lowest window on the frame."
+ (let ((lowest-window (selected-window))
+ (bottom-edge (nth 3 (window-edges))))
+ (walk-windows (lambda (w)
+ (let ((next-bottom-edge (nth 3 (window-edges w))))
+ (when (< bottom-edge next-bottom-edge)
+ (setq bottom-edge next-bottom-edge
+ lowest-window w)))))
+ (select-window lowest-window)))
+
(defun gnus-region-active-p ()
"Say whether the region is active."
(and (boundp 'transient-mark-mode)
"Non-nil means the mark and region are currently active in this buffer."
mark-active) ; aliased to region-exists-p in XEmacs.
-(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"))
glyph))
(defun gnus-remove-image (image &optional category)
- (dolist (position (message-text-with-property 'display))
- (when (and (equal (get-text-property position 'display) image)
- (equal (get-text-property position 'gnus-image-category)
+ "Remove the image matching IMAGE and CATEGORY found first."
+ (let ((start (point-min))
+ val end)
+ (while (and (not end)
+ (or (setq val (get-text-property start 'display))
+ (and (setq start
+ (next-single-property-change start 'display))
+ (setq val (get-text-property start 'display)))))
+ (setq end (or (next-single-property-change start 'display)
+ (point-max)))
+ (if (and (equal val image)
+ (equal (get-text-property start 'gnus-image-category)
category))
- (put-text-property position (1+ position) 'display nil)
- (when (get-text-property position 'gnus-image-text-deletable)
- (delete-region position (1+ position))))))
+ (progn
+ (put-text-property start end 'display nil)
+ (when (get-text-property start 'gnus-image-text-deletable)
+ (delete-region start end)))
+ (unless (= end (point-max))
+ (setq start end
+ end nil))))))
(defun-maybe assoc-ignore-case (key alist)
"Like `assoc', but assumes KEY is a string and ignores case when comparing."