X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-ems.el;h=aed735fe2ce48ec058d60e7fdb119bcd0d773dcd;hb=d99c67b306eb05e58339a64a68652443c2be6e08;hp=153a02ba0ddaea0cdec242df7e9fa63a1edccf01;hpb=035950733d305fcbdb1625373503873bb71617b5;p=gnus diff --git a/lisp/gnus-ems.el b/lisp/gnus-ems.el index 153a02ba0..aed735fe2 100644 --- a/lisp/gnus-ems.el +++ b/lisp/gnus-ems.el @@ -1,6 +1,7 @@ ;;; gnus-ems.el --- functions for making 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, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -19,8 +20,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: @@ -37,21 +38,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")) (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." @@ -71,12 +68,6 @@ (truncate-string-to-width valstr ,max-width) valstr))) -(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) @@ -148,6 +139,18 @@ gnus-mouse-face-prop gnus-mouse-face) (insert " " gnus-tmp-subject-or-nil "\n"))))) +;; 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) @@ -159,16 +162,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")) @@ -229,14 +222,28 @@ 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)))))) (provide 'gnus-ems) +;;; arch-tag: e7360b45-14b5-4171-aa39-69a44aed3cdb ;;; gnus-ems.el ends here