X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-xmas.el;h=a879a308f82aba724106caa7a0f344b3c1ff6b3c;hb=cbf2922da7f444ccaa42fd7d9a2fd9311c6c3ae3;hp=1806cebd7e16833f742e4e17d5b264dce01d91ab;hpb=f344bd14c4b7e73add97d561de63bb7d85ab6571;p=gnus diff --git a/lisp/gnus-xmas.el b/lisp/gnus-xmas.el index 1806cebd7..a879a308f 100644 --- a/lisp/gnus-xmas.el +++ b/lisp/gnus-xmas.el @@ -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))) @@ -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." @@ -444,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) @@ -728,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 (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 @@ -811,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) @@ -823,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) @@ -833,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)) @@ -844,36 +829,27 @@ 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)