X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-ems.el;h=1ab143fcb6524451e0fee5aaba88d45363a50c26;hb=5835aa3205a79608e81c5534e73826f3d6823c03;hp=d2dde415f8aff851c18e8b88c739ab9a30116267;hpb=04ba5250e9e47ebe40860a0902d4ef6405ca143f;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-ems.el b/lisp/gnus-ems.el index d2dde41..1ab143f 100644 --- a/lisp/gnus-ems.el +++ b/lisp/gnus-ems.el @@ -1,6 +1,7 @@ ;;; 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 ;; Tatsuya Ichikawa @@ -20,8 +21,8 @@ ;; 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: @@ -38,25 +39,17 @@ (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." @@ -69,12 +62,6 @@ ;;; 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 @@ -102,16 +89,13 @@ ((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 @@ -162,6 +146,18 @@ (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) @@ -173,16 +169,6 @@ "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")) @@ -243,13 +229,26 @@ 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."