;;; gnus-ems.el --- functions for making Semi-gnus work under different Emacsen
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
-;; Free Software Foundation, Inc.
+
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
+;; 2004, 2005 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Tatsuya Ichikawa <t-ichi@niagara.shiojiri.ne.jp>
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
(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"))
-(if (or (featurep 'xemacs)
- (>= emacs-major-version 21))
- (autoload 'smiley-region "smiley")
- (autoload 'smiley-region "smiley-mule"))
-
-;; Fixme: shouldn't require message
-(autoload 'message-text-with-property "message")
+(autoload 'smiley-region "smiley")
(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
((featurep 'mule)
;; Mule and new Emacs definitions
- ;; [Note] Now there are three kinds of mule implementations,
- ;; original MULE, XEmacs/mule and Emacs 20+ including
- ;; MULE features. Unfortunately these APIs are different. In
- ;; particular, Emacs (including original Mule) and XEmacs are
- ;; quite different. However, this version of Gnus doesn't support
- ;; anything other than XEmacs 20+ and Emacs 20.3+.
+ ;; [Note] Now there are two kinds of mule implementations,
+ ;; XEmacs/mule and Emacs 20+ including Mule features.
+ ;; Unfortunately these APIs are different. In particular, Emacs
+ ;; and XEmacs are quite different. However, this version of Gnus
+ ;; doesn't support anything other than XEmacs 21+ and Emacs 21+.
- ;; Predicates to check are following:
- ;; (boundp 'MULE) is t only if Mule (original; anything older than
- ;; Mule 2.3) is running.
+ ;; Predicate to check is the following:
;; (featurep 'mule) is t when other mule variants are running.
;; It is possible to detect XEmacs/mule by (featurep 'mule) and
(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."
projects / elisp / gnus.git- / blobdiff