X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-xmas.el;h=37037c2224c45f65a1bdb3cbaeec45d31b16e657;hb=4cacb5f23eb830e6950dba987063f413977708d7;hp=6fff59e0808e219d631987c797bce2dc76520b48;hpb=04ba5250e9e47ebe40860a0902d4ef6405ca143f;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-xmas.el b/lisp/gnus-xmas.el index 6fff59e..37037c2 100644 --- a/lisp/gnus-xmas.el +++ b/lisp/gnus-xmas.el @@ -1,6 +1,6 @@ ;;; gnus-xmas.el --- Gnus functions for XEmacs -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2005 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -21,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: @@ -40,6 +40,7 @@ (defvar menu-bar-mode (featurep 'menubar)) (require 'messagexmas) (require 'wid-edit) +(require 'timer-funcs) (defgroup gnus-xmas nil "XEmacsoid support for Gnus" @@ -104,27 +105,13 @@ Possibly the `etc' directory has not been installed."))) (defvar standard-display-table) (defvar gnus-tree-minimize-window) -(defun gnus-xmas-set-text-properties (start end props &optional buffer) - "You should NEVER use this function. It is ideologically blasphemous. -It is provided only to ease porting of broken FSF Emacs programs." - (if (stringp buffer) - nil - (map-extents (lambda (extent ignored) - (remove-text-properties - start end - (list (extent-property extent 'text-prop) nil) - buffer) - nil) - buffer start end nil nil 'text-prop) - (gnus-add-text-properties start end props buffer))) - (defun gnus-xmas-highlight-selected-summary () ;; Highlight selected article in summary buffer (when gnus-summary-selected-face (when gnus-newsgroup-selected-overlay (delete-extent gnus-newsgroup-selected-overlay)) (setq gnus-newsgroup-selected-overlay - (make-extent (gnus-point-at-bol) (gnus-point-at-eol))) + (make-extent (point-at-bol) (point-at-eol))) (set-extent-face gnus-newsgroup-selected-overlay gnus-summary-selected-face))) @@ -257,7 +244,7 @@ call it with the value of the `gnus-data' text property." (select-window selected)))))) ;; Select the lowest window on the frame. -(defun gnus-xmas-appt-select-lowest-window () +(defun gnus-xmas-select-lowest-window () (let* ((lowest-window (selected-window)) (bottom-edge (car (cdr (cdr (cdr (window-pixel-edges)))))) (last-window (previous-window)) @@ -345,10 +332,6 @@ call it with the value of the `gnus-data' text property." (gnus-xmas-menu-add browse gnus-browse-menu)) -(defun gnus-xmas-grouplens-menu-add () - (gnus-xmas-menu-add grouplens - gnus-grouplens-menu)) - (defun gnus-xmas-read-event-char (&optional prompt) "Get the next event." (when prompt @@ -401,10 +384,6 @@ call it with the value of the `gnus-data' text property." (defalias 'gnus-window-edges 'window-pixel-edges) (defalias 'gnus-assq-delete-all 'gnus-xmas-assq-delete-all) - (if (and (<= emacs-major-version 19) - (< emacs-minor-version 14)) - (defalias 'gnus-set-text-properties 'gnus-xmas-set-text-properties)) - (unless (boundp 'standard-display-table) (setq standard-display-table nil)) @@ -422,7 +401,10 @@ call it with the value of the `gnus-data' text property." 'x-color-values (lambda (color) (color-instance-rgb-components - (make-color-instance color)))))) + (make-color-instance color))))) + + (unless (fboundp 'char-width) + (defalias 'char-width (lambda (ch) 1)))) (defun gnus-xmas-redefine () "Redefine lots of Gnus functions for XEmacs." @@ -435,8 +417,8 @@ call it with the value of the `gnus-data' text property." (defalias 'gnus-read-event-char 'gnus-xmas-read-event-char) (defalias 'gnus-group-startup-message 'gnus-xmas-group-startup-message) (defalias 'gnus-tree-minimize 'gnus-xmas-tree-minimize) - (defalias 'gnus-appt-select-lowest-window - 'gnus-xmas-appt-select-lowest-window) + (defalias 'gnus-select-lowest-window + 'gnus-xmas-select-lowest-window) (defalias 'gnus-mail-strip-quoted-names 'gnus-xmas-mail-strip-quoted-names) (defalias 'gnus-character-to-event 'character-to-event) (defalias 'gnus-mode-line-buffer-identification @@ -451,18 +433,12 @@ call it with the value of the `gnus-data' text property." (defalias 'gnus-create-image 'gnus-xmas-create-image) (defalias 'gnus-remove-image 'gnus-xmas-remove-image) - (when (or (< emacs-major-version 21) - (and (= emacs-major-version 21) - (< emacs-minor-version 3))) - (defalias 'gnus-completing-read 'gnus-xmas-completing-read)) - ;; These ones are not defcutom'ed, sometimes not even defvar'ed. They ;; probably should. If that is done, the code below should then be moved ;; where each variable is defined, in order not to mess with user settings. ;; -- didier (add-hook 'gnus-score-mode-hook 'gnus-xmas-score-menu-add) (add-hook 'gnus-binary-mode-hook 'gnus-xmas-binary-menu-add) - (add-hook 'gnus-grouplens-mode-hook 'gnus-xmas-grouplens-menu-add) (add-hook 'gnus-server-mode-hook 'gnus-xmas-server-menu-add) (add-hook 'gnus-browse-mode-hook 'gnus-xmas-browse-menu-add) (add-hook 'gnus-draft-mode-hook 'gnus-xmas-draft-menu-add) @@ -567,7 +543,7 @@ the resulting string may be narrower than END-COLUMN. " based on " gnus-original-product-name " v" gnus-original-version-number "\n") (end-of-line 0) - (put-text-property (point-min) (point) 'face 'gnus-splash-face) + (put-text-property (point-min) (point) 'face 'gnus-splash) (insert-char ?\ (prog1 (max 0 (/ (- (window-width) (point)) 2)) (goto-char (point-min)))) @@ -617,7 +593,7 @@ the resulting string may be narrower than END-COLUMN. (rest (- wheight pheight))) (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n))) ;; Paint it. - (put-text-property (point-min) (point-max) 'face 'gnus-splash-face))) + (put-text-property (point-min) (point-max) 'face 'gnus-splash))) (goto-char (point-min)) (setq modeline-buffer-identification (list (concat gnus-version ": *Group*"))) @@ -814,7 +790,7 @@ XEmacs compatibility workaround." (defun gnus-group-add-icon () "Add an icon to the current line according to `gnus-group-icon-list'." (let* ((p (point)) - (end (gnus-point-at-eol)) + (end (point-at-eol)) ;; now find out where the line starts and leave point there. (beg (progn (beginning-of-line) (point)))) (save-restriction @@ -938,39 +914,15 @@ Warning: Don't insert text immediately after the image." glyph) (defun gnus-xmas-remove-image (image &optional category) + "Remove the image matching IMAGE and CATEGORY found first." (map-extents (lambda (ext unused) (when (equal (extent-end-glyph ext) image) (set-extent-property ext 'invisible nil) - (set-extent-property ext 'end-glyph nil)) - nil) + (set-extent-property ext 'end-glyph nil) + t)) nil nil nil nil nil 'gnus-image category)) -(defun gnus-xmas-completing-read (prompt table &optional - predicate require-match history) - (when (and history - (not (boundp history))) - (set history nil)) - (completing-read - (if (symbol-value history) - (concat prompt " (" (car (symbol-value history)) "): ") - (concat prompt ": ")) - table - predicate - require-match - nil - history)) - -;; This macro is because XEmacs versions prior to 21.2 do not have the -;; PROTOCOL argument to `open-network-stream'. -(defmacro gnus-xmas-open-network-stream (name buffer host service &optional protocol) - "Like `open-network-stream' but take into account older XEmacs versions." - (if (and (featurep 'xemacs) - (fboundp 'open-network-stream) - (emacs-version>= 21 2)) - `(open-network-stream ,name ,buffer ,host ,service ,protocol) - `(open-network-stream ,name ,buffer ,host ,service))) - (defun gnus-xmas-assq-delete-all (key alist) (let ((elem nil)) (while (setq elem (assq key alist))