;;; 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 <larsi@gnus.org>
;;; 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)
(defalias 'gnus-put-text-property 'gnus-xmas-put-text-property)
(defalias 'gnus-deactivate-mark 'ignore)
(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))
'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)
(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])
(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 (gnus-point-at-eol))
;; now find out where the line starts and leave point there.
(beg (progn (beginning-of-line) (point))))
(save-restriction
(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)
(with-temp-buffer
(if data-p
(insert file)
- (insert-file-contents file))
+ (insert-file-contents-literally file))
(make-glyph
(vector
(or (intern type)
(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))
(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))
+ nil nil nil nil nil 'gnus-image category))
(defun gnus-xmas-completing-read (prompt table &optional
predicate require-match history)
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))
+ (setq alist (delq elem alist)))
+ alist))
+
(provide 'gnus-xmas)
;;; gnus-xmas.el ends here