X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-ems.el;h=1ab143fcb6524451e0fee5aaba88d45363a50c26;hb=5835aa3205a79608e81c5534e73826f3d6823c03;hp=1493bbdcd5e3f5c6266a0d05a90f622d35a93192;hpb=189ff271b8ba2ac09f5b6174289bc96a51b3a76c;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-ems.el b/lisp/gnus-ems.el index 1493bbd..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, 2004 -;; 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: @@ -45,13 +46,10 @@ (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." @@ -148,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) @@ -219,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."