(sha1): Add defgroup.

[gnus] / lisp / gnus-xmas.el

diff --git a/lisp/gnus-xmas.el b/lisp/gnus-xmas.el
index 3f72b5d..54b8e88 100644 (file)
--- 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 <larsi@gnus.org>
@@ -27,6 +27,14 @@
 
 ;;; 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)
@@ -390,6 +398,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)
+  (defalias 'gnus-assq-delete-all 'gnus-xmas-assq-delete-all)
 
   (if (and (<= emacs-major-version 19)
           (< emacs-minor-version 14))
@@ -436,6 +445,7 @@ call it with the value of the `gnus-data' text property."
     '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)
@@ -480,6 +490,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 +723,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 +737,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 (gnus-point-at-eol))
         ;; now find out where the line starts and leave point there.
         (beg (progn (beginning-of-line) (point))))
     (save-restriction
@@ -809,7 +820,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 +832,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 +842,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,21 +853,21 @@ 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))
+   nil nil nil nil nil 'gnus-image category))
 
 (defun gnus-xmas-completing-read (prompt table &optional
                                         predicate require-match history)
@@ -873,6 +884,22 @@ Warning: Don't insert text immediately after the image."
    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