X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-xmas.el;h=6f0a2a1d7f21fb8c7c47935ebcc03ce0ef0fe512;hb=6a25cffa8161aedf763c884fcc612080939437c8;hp=3f72b5d32187967714a1da396959a473c47fdcec;hpb=935efec5c0128a5ae61c7e3101aca3dec0aa1727;p=gnus diff --git a/lisp/gnus-xmas.el b/lisp/gnus-xmas.el index 3f72b5d32..6f0a2a1d7 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 +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -27,10 +27,19 @@ ;;; Code: +(eval-when-compile + (autoload 'gnus-active "gnus" nil nil 'macro) + (autoload 'gnus-group-entry "gnus" nil nil 'macro) + (autoload 'gnus-info-level "gnus" nil nil 'macro) + (autoload 'gnus-info-marks "gnus" nil nil 'macro) + (autoload 'gnus-info-method "gnus" nil nil 'macro) + (autoload 'gnus-info-score "gnus" nil nil 'macro)) + (require 'text-props) (defvar menu-bar-mode (featurep 'menubar)) (require 'messagexmas) (require 'wid-edit) +(require 'run-at-time) (defgroup gnus-xmas nil "XEmacsoid support for Gnus" @@ -95,27 +104,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))) @@ -248,7 +243,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)) @@ -336,10 +331,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 @@ -390,10 +381,7 @@ call it with the value of the `gnus-data' text property." (defalias 'gnus-put-text-property 'gnus-xmas-put-text-property) (defalias 'gnus-deactivate-mark 'ignore) (defalias 'gnus-window-edges 'window-pixel-edges) - - (if (and (<= emacs-major-version 19) - (< emacs-minor-version 14)) - (defalias 'gnus-set-text-properties 'gnus-xmas-set-text-properties)) + (defalias 'gnus-assq-delete-all 'gnus-xmas-assq-delete-all) (unless (boundp 'standard-display-table) (setq standard-display-table nil)) @@ -415,7 +403,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." @@ -428,14 +419,15 @@ 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 'gnus-xmas-mode-line-buffer-identification) (defalias 'gnus-key-press-event-p 'key-press-event-p) (defalias 'gnus-region-active-p 'region-active-p) + (defalias 'gnus-mark-active-p 'region-exists-p) (defalias 'gnus-annotation-in-region-p 'gnus-xmas-annotation-in-region-p) (defalias 'gnus-mime-button-menu 'gnus-xmas-mime-button-menu) (defalias 'gnus-image-type-available-p 'gnus-xmas-image-type-available-p) @@ -443,18 +435,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) @@ -480,6 +466,7 @@ call it with the value of the `gnus-data' text property." :color-symbols (("thing" . ,(car gnus-logo-colors)) ("shadow" . ,(cadr gnus-logo-colors)) + ("oort" . "#eeeeee") ("background" . ,(face-background 'default)))]) ((featurep 'xbm) `[xbm :file ,logo-xbm]) @@ -712,9 +699,9 @@ XEmacs compatibility workaround." (eq (cadr (memq 'gnus-undeletable (text-properties-at b))) t) (text-property-any b e 'gnus-undeletable t)))) -(defun gnus-xmas-mime-button-menu (event) +(defun gnus-xmas-mime-button-menu (event prefix) "Construct a context-sensitive menu of MIME commands." - (interactive "e") + (interactive "e\nP") (let ((response (get-popup-menu-response `("MIME Part" ,@(mapcar (lambda (c) `[,(caddr c) ,(car c) t]) @@ -726,7 +713,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 (progn (end-of-line) (point))) + (end (point-at-eol)) ;; now find out where the line starts and leave point there. (beg (progn (beginning-of-line) (point)))) (save-restriction @@ -809,7 +796,7 @@ XEmacs compatibility workaround." (with-temp-buffer (if data-p (insert file) - (insert-file-contents file)) + (insert-file-contents-literally file)) (shell-command-on-region (point-min) (point-max) "ppmtoxpm 2>/dev/null" t) (setq file (buffer-string) @@ -821,7 +808,7 @@ XEmacs compatibility workaround." (with-temp-buffer (if data-p (insert file) - (insert-file-contents file)) + (insert-file-contents-literally file)) (make-glyph (vector (or (intern type) @@ -831,7 +818,7 @@ XEmacs compatibility workaround." (set-glyph-face glyph face)) glyph)) -(defun gnus-xmas-put-image (glyph &optional string) +(defun gnus-xmas-put-image (glyph &optional string category) "Insert STRING, but display GLYPH. Warning: Don't insert text immediately after the image." (let ((begin (point)) @@ -842,37 +829,29 @@ Warning: Don't insert text immediately after the image." (insert string) (setq begin (1- begin))) (setq extent (make-extent begin (point))) - (set-extent-property extent 'gnus-image t) + (set-extent-property extent 'gnus-image category) (set-extent-property extent 'duplicable t) (if string (set-extent-property extent 'invisible t)) (set-extent-property extent 'end-glyph glyph)) glyph) -(defun gnus-xmas-remove-image (image) +(defun gnus-xmas-remove-image (image &optional category) (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) - nil nil nil nil nil 'gnus-image)) - -(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)) + nil nil nil nil nil 'gnus-image category)) + +(defun gnus-xmas-assq-delete-all (key alist) + (let ((elem nil)) + (while (setq elem (assq key alist)) + (setq alist (delq elem alist))) + alist)) (provide 'gnus-xmas) +;;; arch-tag: 4e84de3f-ea0a-4ee3-bfeb-e03d46fcacef ;;; gnus-xmas.el ends here