*** empty log message ***
[gnus] / lisp / gnus-xmas.el
index 09fdb05..4cc1c9b 100644 (file)
@@ -17,8 +17,9 @@
 ;; GNU General Public License for more details.
 
 ;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; 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.
 
 ;;; Commentary:
 
@@ -87,7 +88,7 @@ automatically.")
 (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 (and (stringp buffer) (not (setq buffer (get-buffer buffer))))
+  (if (stringp buffer) 
       nil
     (map-extents (lambda (extent ignored)
                   (remove-text-properties 
@@ -138,6 +139,17 @@ It is provided only to ease porting of broken FSF Emacs programs."
      '(gnus-topic nil gnus-topic-level nil gnus-topic-visible nil))
     (goto-char end)))
                  
+(defun gnus-xmas-topic-remove-excess-properties ()
+  (let ((end (point))
+       (beg (progn (forward-line -1) (point))))
+    (remove-text-properties beg end '(gnus-group nil))
+    (goto-char end)))
+
+(defun gnus-xmas-extent-start-open (point)
+  (map-extents (lambda (extent arg)
+                (set-extent-property extent 'start-open t))
+              nil point (min (1+ (point)) (point-max))))
+                 
 (defun gnus-xmas-copy-article-buffer (&optional article-buffer)
   (setq gnus-article-copy (get-buffer-create " *gnus article copy*"))
   (buffer-disable-undo gnus-article-copy)
@@ -169,11 +181,6 @@ call it with the value of the `gnus-data' text property."
 (defun gnus-xmas-move-overlay (extent start end &optional buffer)
   (set-extent-endpoints extent start end))
 
-(defun gnus-xmas-make-overlay (from to &optional buf)
-  (let ((extent (make-extent from to buf)))
-    (set-extent-property extent 'detachable nil)
-    extent))
-
 ;; Fixed by Christopher Davis <ckd@loiosh.kei.com>.
 (defun gnus-xmas-article-add-button (from to fun &optional data)
   "Create a button between FROM and TO with callback FUN and data DATA."
@@ -232,21 +239,45 @@ call it with the value of the `gnus-data' text property."
               (select-window lowest-window)
               (setq window-search nil)))))))
 
+(defmacro gnus-xmas-menu-add (type &rest menus)
+  `(gnus-xmas-menu-add-1 ',type ',menus))
+(put 'gnus-xmas-menu-add 'lisp-indent-function 1)
+(put 'gnus-xmas-menu-add 'lisp-indent-hook 1)
+
+(defun gnus-xmas-menu-add-1 (type menus)
+  (when (and menu-bar-mode
+            (gnus-visual-p (intern (format "%s-menu" type)) 'menu))
+    (while menus
+      (easy-menu-add (symbol-value (pop menus))))))
+
 (defun gnus-xmas-group-menu-add ()
-  (easy-menu-add gnus-group-reading-menu)
-  (easy-menu-add gnus-group-group-menu)
-  (easy-menu-add gnus-group-misc-menu))
+  (gnus-xmas-menu-add group
+    gnus-group-reading-menu gnus-group-group-menu gnus-group-misc-menu))
 
 (defun gnus-xmas-summary-menu-add ()
-  (easy-menu-add gnus-summary-article-menu)
-  (easy-menu-add gnus-summary-thread-menu)
-  (easy-menu-add gnus-summary-misc-menu)
-  (easy-menu-add gnus-summary-post-menu)
-  (easy-menu-add gnus-summary-kill-menu)) 
+  (gnus-xmas-menu-add summary
+    gnus-summary-article-menu gnus-summary-thread-menu
+    gnus-summary-misc-menu gnus-summary-post-menu gnus-summary-kill-menu))
 
 (defun gnus-xmas-article-menu-add ()
-  (easy-menu-add gnus-article-article-menu)
-  (easy-menu-add gnus-article-treatment-menu))
+  (gnus-xmas-menu-add article
+    gnus-article-article-menu gnus-article-treatment-menu))
+
+(defun gnus-xmas-pick-menu-add ()
+  (gnus-xmas-menu-add pick
+    gnus-pick-menu))
+
+(defun gnus-xmas-binary-menu-add ()
+  (gnus-xmas-menu-add binary
+    gnus-binary-menu))
+
+(defun gnus-xmas-tree-menu-add ()
+  (gnus-xmas-menu-add tree
+    gnus-tree-menu))
+
+(defun gnus-xmas-grouplens-menu-add ()
+  (gnus-xmas-menu-add grouplens
+    gnus-grouplens-menu))
 
 (defun gnus-xmas-read-event-char ()
   "Get the next event."
@@ -289,12 +320,15 @@ call it with the value of the `gnus-data' text property."
   (or (face-differs-from-default-p 'underline)
       (funcall (intern "set-face-underline-p") 'underline t))
 
-  (fset 'gnus-make-overlay 'gnus-xmas-make-overlay)
+  (fset 'gnus-make-overlay 'make-extent)
   (fset 'gnus-overlay-put 'set-extent-property)
   (fset 'gnus-move-overlay 'gnus-xmas-move-overlay)
   (fset 'gnus-overlay-end 'extent-end-position)
+  (fset 'gnus-extent-detached-p 'extent-detached-p)
       
-  (fset 'set-text-properties 'gnus-xmas-set-text-properties)
+  (require 'text-props)
+  (if (< emacs-minor-version 14)
+      (fset 'gnus-set-text-properties 'gnus-xmas-set-text-properties))
 
   (fset 'nnheader-find-file-noselect 'gnus-xmas-find-file-noselect)
 
@@ -332,11 +366,12 @@ variables get.  You would normally not change this variable, but
 pounce directly on the real variables themselves.")
 
 
-  (or (fboundp 'x-color-values)
-      (fset 'x-color-values 
-           (lambda (color)
-             (color-instance-rgb-components
-              (make-color-instance color)))))
+  (fset 'gnus-x-color-values 
+       (if (fboundp 'x-color-values)
+           'x-color-values
+         (lambda (color)
+           (color-instance-rgb-components
+            (make-color-instance color)))))
     
   (defvar gnus-background-mode 
     (let ((bg-resource 
@@ -346,9 +381,9 @@ pounce directly on the real variables themselves.")
          (params (frame-parameters)))
       (cond (bg-resource (intern (downcase bg-resource)))
            ((and (assq 'background-color params)
-                 (< (apply '+ (x-color-values
+                 (< (apply '+ (gnus-x-color-values
                                (cdr (assq 'background-color params))))
-                    (/ (apply '+ (x-color-values "white")) 3)))
+                    (/ (apply '+ (gnus-x-color-values "white")) 3)))
             'dark)
            (t 'light)))
     "A symbol indicating the Emacs background brightness.
@@ -374,23 +409,29 @@ pounce directly on the real variables themselves.")
   (fset 'gnus-summary-recenter 'gnus-xmas-summary-recenter)
   (fset 'gnus-group-remove-excess-properties
        'gnus-xmas-group-remove-excess-properties)
+  (fset 'gnus-topic-remove-excess-properties
+       'gnus-xmas-topic-remove-excess-properties)
+  (fset 'gnus-extent-start-open 'gnus-xmas-extent-start-open)
   (fset 'gnus-copy-article-buffer 'gnus-xmas-copy-article-buffer)
   (fset 'gnus-article-push-button 'gnus-xmas-article-push-button)
   (fset 'gnus-article-add-button 'gnus-xmas-article-add-button)
   (fset 'gnus-window-top-edge 'gnus-xmas-window-top-edge)
-  (fset 'set-text-properties 'gnus-xmas-set-text-properties)
   (fset 'gnus-read-event-char 'gnus-xmas-read-event-char)
   (fset 'gnus-group-startup-message 'gnus-xmas-group-startup-message)
   (fset 'gnus-tree-minimize 'gnus-xmas-tree-minimize)
-
-  (or (fboundp 'appt-select-lowest-window)
-      (fset 'appt-select-lowest-window 
-           'gnus-xmas-appt-select-lowest-window))
+  (fset 'gnus-appt-select-lowest-window 
+       'gnus-xmas-appt-select-lowest-window)
+  (fset 'gnus-mail-strip-quoted-names 'gnus-xmas-mail-strip-quoted-names)
 
   (add-hook 'gnus-group-mode-hook 'gnus-xmas-group-menu-add)
   (add-hook 'gnus-summary-mode-hook 'gnus-xmas-summary-menu-add)
   (add-hook 'gnus-article-mode-hook 'gnus-xmas-article-menu-add)
 
+  (add-hook 'gnus-pick-mode-hook 'gnus-xmas-pick-menu-add)
+  (add-hook 'gnus-tree-mode-hook 'gnus-xmas-tree-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-group-mode-hook 'gnus-xmas-setup-group-toolbar)
   (add-hook 'gnus-summary-mode-hook 'gnus-xmas-setup-summary-toolbar))
 
@@ -406,7 +447,7 @@ pounce directly on the real variables themselves.")
        (while path
          (setq dir (concat
                     (file-name-directory (directory-file-name (car path)))
-                    "etc/"))
+                    "etc/gnus/"))
          (if (and (file-exists-p dir)
                   (file-directory-p dir)
                   (file-exists-p (concat dir "gnus-group-exit-icon-up.xpm")))
@@ -568,6 +609,7 @@ If it is non-nil, it must be a toolbar.  The five legal values are
 
 ;; Written by Erik Naggum <erik@naggum.no>.
 ;; Saved by Steve Baur <steve@miranova.com>.
+(or (fboundp 'insert-file-contents-literally)
 (defun insert-file-contents-literally (filename &optional visit beg end replace)
   "Like `insert-file-contents', q.v., but only reads in the file.
 A buffer may be modified in several ways after reading into the buffer due
@@ -587,7 +629,7 @@ find-file-hooks, etc.
           (insert-file-contents filename visit beg end replace))
       (if find-buffer-file-type-function
           (fset 'find-buffer-file-type find-buffer-file-type-function)
-        (fmakunbound 'find-buffer-file-type)))))
+        (fmakunbound 'find-buffer-file-type))))))
 
 (defun gnus-xmas-find-file-noselect (filename &optional nowarn rawfile)
   "Read file FILENAME into a buffer and return the buffer.
@@ -698,5 +740,11 @@ The buffer is not selected, just returned to the caller."
            (after-find-file error (not nowarn)))))
       buf)))
 
+(defun gnus-xmas-mail-strip-quoted-names (address)
+  "Protect mail-strip-quoted-names from NIL input.
+XEmacs compatibility workaround."
+  (if (null address)
+      nil
+    (mail-strip-quoted-names address)))
 
 ;;; gnus-xmas.el ends here