Mercurial > emacs

--- a/lisp/gnus/ChangeLog	Mon Apr 17 13:44:56 2006 +0000
+++ b/lisp/gnus/ChangeLog	Mon Apr 17 18:26:22 2006 +0000
@@ -1,3 +1,27 @@
+2006-04-17  Reiner Steib  <Reiner.Steib@gmx.de>
+
+	* message.el (message-tool-bar-zap-list, message-tool-bar)
+	(message-tool-bar-gnome, message-tool-bar-retro): New variables.
+	(message-tool-bar-local-item-from-menu): Remove.
+	(message-tool-bar-map): Replace by `message-make-tool-bar'.
+	(message-make-tool-bar): New function.
+	(message-mode): Use `message-make-tool-bar'.
+
+	* gnus-sum.el (gnus-summary-tool-bar)
+	(gnus-summary-tool-bar-gnome, gnus-summary-tool-bar-retro)
+	(gnus-summary-tool-bar-zap-list): New variables.
+	(gnus-summary-make-tool-bar): Complete rewrite using
+	`gmm-tool-bar-from-list'.
+
+	* gnus-group.el (gnus-group-tool-bar, gnus-group-tool-bar-gnome)
+	(gnus-group-tool-bar-retro, gnus-group-tool-bar-zap-list): New
+	variables.
+	(gnus-group-make-tool-bar): Complete rewrite using
+	`gmm-tool-bar-from-list'.
+	(gnus-group-tool-bar-update): New function.
+
+	* gmm-utils.el: New file.
+
 2006-04-12  Ralf Angeli  <angeli@iwi.uni-sb.de>

 	* flow-fill.el (fill-flowed): Remove trailing space from blank
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/gnus/gmm-utils.el	Mon Apr 17 18:26:22 2006 +0000
@@ -0,0 +1,413 @@
+;;; gmm-utils.el --- Utility functions for Gnus, Message and MML
+
+;; Copyright (C) 2006 Free Software Foundation, Inc.
+
+;; Author: Reiner Steib <reiner.steib@gmx.de>
+;; Keywords: news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.	 See the
+;; 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, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;;; Commentary:
+
+;; This library provides self-contained utility functions.  The functions are
+;; used in Gnus, Message and MML, but within this library there are no
+;; dependencies on Gnus, Message, or MML or Gnus.
+
+;;; Code:
+
+;; (require 'wid-edit)
+
+(defgroup gmm nil
+  "Utility functions for Gnus, Message and MML"
+  :prefix "gmm-"
+  :version "23.0" ;; No Gnus
+  :group 'lisp)
+
+;; Helper functions from `gnus-utils.el': gmm-verbose, gmm-message, gmm-error
+
+(defcustom gmm-verbose 7
+  "Integer that says how verbose gmm should be.
+The higher the number, the more messages will flash to say what
+it done.  At zero, it will be totally mute; at five, it will
+display most important messages; and at ten, it will keep on
+jabbering all the time."
+  :type 'integer
+  :group 'gmm)
+
+;;;###autoload
+(defun gmm-message (level &rest args)
+  "If LEVEL is lower than `gmm-verbose' print ARGS using `message'.
+
+Guideline for numbers:
+1 - error messages, 3 - non-serious error messages, 5 - messages for things
+that take a long time, 7 - not very important messages on stuff, 9 - messages
+inside loops."
+  (if (<= level gmm-verbose)
+      (apply 'message args)
+    ;; We have to do this format thingy here even if the result isn't
+    ;; shown - the return value has to be the same as the return value
+    ;; from `message'.
+    (apply 'format args)))
+
+;;;###autoload
+(defun gmm-error (level &rest args)
+  "Beep an error if LEVEL is equal to or less than `gmm-verbose'.
+ARGS are passed to `message'."
+  (when (<= (floor level) gmm-verbose)
+    (apply 'message args)
+    (ding)
+    (let (duration)
+      (when (and (floatp level)
+		 (not (zerop (setq duration (* 10 (- level (floor level)))))))
+	(sit-for duration))))
+  nil)
+
+;;;###autoload
+(defun gmm-widget-p (symbol)
+  "Non-nil iff SYMBOL is a widget."
+  (get symbol 'widget-type))
+
+;; Copy of the `nnmail-lazy' code from `nnmail.el':
+(define-widget 'gmm-lazy 'default
+  "Base widget for recursive datastructures.
+
+This is copy of the `lazy' widget in Emacs 22.1 provided for compatibility."
+  :format "%{%t%}: %v"
+  :convert-widget 'widget-value-convert-widget
+  :value-create (lambda (widget)
+                  (let ((value (widget-get widget :value))
+                        (type (widget-get widget :type)))
+                    (widget-put widget :children
+                                (list (widget-create-child-value
+                                       widget (widget-convert type) value)))))
+  :value-delete 'widget-children-value-delete
+  :value-get (lambda (widget)
+               (widget-value (car (widget-get widget :children))))
+  :value-inline (lambda (widget)
+                  (widget-apply (car (widget-get widget :children))
+                                :value-inline))
+  :default-get (lambda (widget)
+                 (widget-default-get
+                  (widget-convert (widget-get widget :type))))
+  :match (lambda (widget value)
+           (widget-apply (widget-convert (widget-get widget :type))
+                         :match value))
+  :validate (lambda (widget)
+              (widget-apply (car (widget-get widget :children)) :validate)))
+
+;; Note: The format of `gmm-tool-bar-item' may change if some future Emacs
+;; version will provide customizable tool bar buttons using a different
+;; interface.
+
+;; TODO: Extend API so that the "Command" entry can be a function or a plist.
+;; In case of a list it should have the format...
+;;
+;;  (:none command-without-modifier
+;;   :shift command-with-shift-pressed
+;;   :control command-with-ctrl-pressed
+;;   :control-shift command-with-control-and-shift-pressed
+;;   ;; mouse-2 and mouse-3 can't be used in Emacs yet.
+;;   :mouse-2 command-on-mouse-2-press
+;;   :mouse-3 command-on-mouse-3-press) ;; typically a menu of related commands
+;;
+;; Combinations of mouse-[23] plus shift and/or controll might be overkill.
+;;
+;; Then use (plist-get rs-command :none), (plist-get rs-command :shift)
+
+(define-widget 'gmm-tool-bar-item (if (gmm-widget-p 'lazy) 'lazy 'gmm-lazy)
+  "Tool bar list item."
+  :tag "Tool bar item"
+  :type '(choice
+	  (list :tag "Command and Icon"
+		(function :tag "Command")
+		(string :tag "Icon file")
+		(choice
+		 (const :tag "Default map" nil)
+		 ;; Note: Usually we need non-nil attributes if map is t.
+		 (const :tag "No menu" t)
+		 (sexp :tag "Other map"))
+		(plist :inline t :tag "Properties"))
+	  (list :tag "Separator"
+		(const :tag "No command" gmm-ignore)
+		(string :tag "Icon file")
+		(const :tag "No map")
+		(plist :inline t :tag "Properties"))))
+
+(define-widget 'gmm-tool-bar-zap-list (if (gmm-widget-p 'lazy) 'lazy 'gmm-lazy)
+  "Tool bar zap list."
+  :tag "Tool bar zap list"
+  :type '(choice (const :tag "Zap all" t)
+		 (const :tag "Keep all" nil)
+		 (list
+		  ;; :value
+		  ;; Work around (bug in customize?), see
+		  ;; <news:v9is48jrj1.fsf@marauder.physik.uni-ulm.de>
+		  ;; (new-file open-file dired kill-buffer write-file
+		  ;; 	    print-buffer customize help)
+		  (set :inline t
+		       (const new-file)
+		       (const open-file)
+		       (const dired)
+		       (const kill-buffer)
+		       (const save-buffer)
+		       (const write-file)
+		       (const undo)
+		       (const cut)
+		       (const copy)
+		       (const paste)
+		       (const search-forward)
+		       (const print-buffer)
+		       (const customize)
+		       (const help))
+		  (repeat :inline t
+			  :tag "Other"
+			  (symbol :tag "Icon item")))))
+
+;; (defun gmm-color-cells (&optional display)
+;;   "Return the number of color cells supported by DISPLAY.
+;; Compatibility function."
+;;   ;; `display-color-cells' doesn't return more than 256 even if color depth is
+;;   ;; > 8 in Emacs 21.
+;;   ;;
+;;   ;; Feel free to add proper XEmacs support.
+;;   (let* ((cells (and (fboundp 'display-color-cells)
+;; 		     (display-color-cells display)))
+;; 	 (plane (and (fboundp 'x-display-planes)
+;; 		     (ash 1 (x-display-planes))))
+;; 	 (none -1))
+;;     (max (if (integerp cells) cells none)
+;; 	 (if (integerp plane) plane none))))
+
+(defcustom gmm-tool-bar-style
+  (if (and (boundp 'tool-bar-mode)
+	   tool-bar-mode
+	   (and (fboundp 'display-visual-class)
+		(not (memq (display-visual-class)
+			   (list 'static-gray 'gray-scale
+				 'static-color 'pseudo-color)))))
+      'gnome
+    'retro)
+  "Prefered tool bar style."
+  :type '(choice (const :tag "GNOME style" 'gnome)
+		 (const :tag "Retro look"  'retro))
+  :group 'gmm)
+
+(defvar tool-bar-map)
+
+;;;###autoload
+(defun gmm-tool-bar-from-list (icon-list zap-list default-map)
+  "Make a tool bar from ICON-LIST.
+
+Within each entry of ICON-LIST, the first element is a menu
+command, the second element is an icon file name and the third
+element is a test function.  You can use \\[describe-key]
+<menu-entry> to find out the name of a menu command.  The fourth
+and all following elements are passed a the PROPS argument to the
+function `tool-bar-local-item'.
+
+If ZAP-LIST is a list, remove those item from the default
+`tool-bar-map'.  If it is t, start with a new sparse map.  You
+can use \\[describe-key] <icon> to find out the name of an icon
+item.  When \\[describe-key] <icon> shows \"<tool-bar> <new-file>
+runs the command find-file\", then use `new-file' in ZAP-LIST.
+
+DEFAULT-MAP specifies the default key map for ICON-LIST."
+  (let (;; For Emacs 21, we must let-bind `tool-bar-map'.  In Emacs 22, we
+	;; could use some other local variable.
+	(tool-bar-map (if (eq zap-list t)
+			  (make-sparse-keymap)
+			(copy-keymap tool-bar-map))))
+    (when (listp zap-list)
+      ;; Zap some items which aren't relevant for this mode and take up space.
+      (dolist (key zap-list)
+	(define-key tool-bar-map (vector key) nil)))
+    (mapc (lambda (el)
+	    (let ((command (car el))
+		  (icon (nth 1 el))
+		  (fmap (or (nth 2 el) default-map))
+		  (props  (cdr (cdr (cdr el)))) )
+	      ;; command may stem from different from-maps:
+	      (cond ((eq command 'gmm-ignore)
+		     ;; The dummy `gmm-ignore', see `gmm-tool-bar-item'
+		     ;; widget.  Suppress tooltip by adding `:enable nil'.
+		     (if (fboundp 'tool-bar-local-item)
+			 (apply 'tool-bar-local-item icon nil nil
+				tool-bar-map :enable nil props)
+		       ;; (tool-bar-local-item ICON DEF KEY MAP &rest PROPS)
+		       ;; (tool-bar-add-item ICON DEF KEY &rest PROPS)
+		       (apply 'tool-bar-add-item icon nil nil :enable nil props)))
+		    ((equal fmap t) ;; Not a menu command
+		     (if (fboundp 'tool-bar-local-item)
+			 (apply 'tool-bar-local-item
+				icon command
+				(intern icon) ;; reuse icon or fmap here?
+				tool-bar-map props)
+		       ;; Emacs 21 compatibility:
+		       (apply 'tool-bar-add-item
+			      icon command
+			      (intern icon)
+			      props)))
+		    (t ;; A menu command
+		     (if (fboundp 'tool-bar-local-item-from-menu)
+			 (apply 'tool-bar-local-item-from-menu
+				;; (apply 'tool-bar-local-item icon def key
+				;; tool-bar-map props)
+				command icon tool-bar-map (symbol-value fmap)
+				props)
+		       ;; Emacs 21 compatibility:
+		       (apply 'tool-bar-add-item-from-menu
+			      command icon (symbol-value fmap)
+			      props))))
+	      t))
+	  (if (symbolp icon-list)
+	      (eval icon-list)
+	    icon-list))
+    tool-bar-map))
+
+;; WARNING: The following is subject to change.  Don't rely on it yet.
+
+;; From MH-E without modifications:
+
+(defmacro gmm-defun-compat (name function arg-list &rest body)
+  "Create function NAME.
+If FUNCTION exists, then NAME becomes an alias for FUNCTION.
+Otherwise, create function NAME with ARG-LIST and BODY."
+  (let ((defined-p (fboundp function)))
+    (if defined-p
+        `(defalias ',name ',function)
+      `(defun ,name ,arg-list ,@body))))
+
+(gmm-defun-compat gmm-image-search-load-path
+  image-search-load-path (file &optional path)
+  "Emacs 21 and XEmacs don't have `image-search-load-path'.
+This function returns nil on those systems."
+  nil)
+
+;; From MH-E with modifications:
+
+;; Don't use `gmm-defun-compat' until API changes in
+;; `image-load-path-for-library' in Emacs CVS are completed.
+
+(defun gmm-image-load-path-for-library (library image &optional path no-error)
+  "Return a suitable search path for images relative to LIBRARY.
+
+First it searches for IMAGE in `image-load-path' (excluding
+\"`data-directory'/images\") and `load-path', followed by a path
+suitable for LIBRARY, which includes \"../../etc/images\" and
+\"../etc/images\" relative to the library file itself, and then
+in \"`data-directory'/images\".
+
+Then this function returns a list of directories which contains
+first the directory in which IMAGE was found, followed by the
+value of `load-path'. If PATH is given, it is used instead of
+`load-path'.
+
+If NO-ERROR is non-nil and a suitable path can't be found, don't
+signal an error. Instead, return a list of directories as before,
+except that nil appears in place of the image directory.
+
+Here is an example that uses a common idiom to provide
+compatibility with versions of Emacs that lack the variable
+`image-load-path':
+
+    ;; Shush compiler.
+    (defvar image-load-path)
+
+    (let* ((load-path (image-load-path-for-library \"mh-e\" \"mh-logo.xpm\"))
+           (image-load-path (cons (car load-path)
+                                  (when (boundp 'image-load-path)
+                                    image-load-path))))
+      (mh-tool-bar-folder-buttons-init))"
+  (unless library (error "No library specified"))
+  (unless image   (error "No image specified"))
+  (let (image-directory image-directory-load-path)
+    ;; Check for images in image-load-path or load-path.
+    (let ((img image)
+          (dir (or
+                ;; Images in image-load-path.
+                (gmm-image-search-load-path image) ;; "gmm-" prefix!
+                ;; Images in load-path.
+                (locate-library image)))
+          parent)
+      ;; Since the image might be in a nested directory (for
+      ;; example, mail/attach.pbm), adjust `image-directory'
+      ;; accordingly.
+      (when dir
+        (setq dir (file-name-directory dir))
+        (while (setq parent (file-name-directory img))
+          (setq img (directory-file-name parent)
+                dir (expand-file-name "../" dir))))
+      (setq image-directory-load-path dir))
+
+    ;; If `image-directory-load-path' isn't Emacs' image directory,
+    ;; it's probably a user preference, so use it. Then use a
+    ;; relative setting if possible; otherwise, use
+    ;; `image-directory-load-path'.
+    (cond
+     ;; User-modified image-load-path?
+     ((and image-directory-load-path
+           (not (equal image-directory-load-path
+                       (file-name-as-directory
+                        (expand-file-name "images" data-directory)))))
+      (setq image-directory image-directory-load-path))
+     ;; Try relative setting.
+     ((let (library-name d1ei d2ei)
+        ;; First, find library in the load-path.
+        (setq library-name (locate-library library))
+        (if (not library-name)
+            (error "Cannot find library %s in load-path" library))
+        ;; And then set image-directory relative to that.
+        (setq
+         ;; Go down 2 levels.
+         d2ei (file-name-as-directory
+               (expand-file-name
+                (concat (file-name-directory library-name) "../../etc/images")))
+         ;; Go down 1 level.
+         d1ei (file-name-as-directory
+               (expand-file-name
+                (concat (file-name-directory library-name) "../etc/images"))))
+        (setq image-directory
+              ;; Set it to nil if image is not found.
+              (cond ((file-exists-p (expand-file-name image d2ei)) d2ei)
+                    ((file-exists-p (expand-file-name image d1ei)) d1ei)))))
+     ;; Use Emacs' image directory.
+     (image-directory-load-path
+      (setq image-directory image-directory-load-path))
+     (no-error
+      (message "Could not find image %s for library %s" image library))
+     (t
+      (error "Could not find image %s for library %s" image library)))
+
+    ;; Return an augmented `path' or `load-path'.
+    (nconc (list image-directory)
+           (delete image-directory (copy-sequence (or path load-path))))))
+
+(defun gmm-customize-mode (&optional mode)
+  "Customize customization group for MODE.
+If mode is nil, use `major-mode' of the curent buffer."
+  (interactive)
+  (customize-group
+   (or mode
+       (intern (let ((mode (symbol-name major-mode)))
+		 (string-match "^\\(.+\\)-mode$" mode)
+		 (match-string 1 mode))))))
+
+(provide 'gmm-utils)
+
+;; arch-tag: e0b60920-2ce6-40c1-bfc0-cadbbe26b602
+;;; gmm-utils.el ends here
--- a/lisp/gnus/gnus-group.el	Mon Apr 17 13:44:56 2006 +0000
+++ b/lisp/gnus/gnus-group.el	Mon Apr 17 18:26:22 2006 +0000
@@ -39,6 +39,7 @@
 (require 'gnus-range)
 (require 'gnus-win)
 (require 'gnus-undo)
+(require 'gmm-utils)
 (require 'time-date)
 (require 'gnus-ems)

@@ -979,36 +980,135 @@

     (gnus-run-hooks 'gnus-group-menu-hook)))

-(defvar gnus-group-toolbar-map nil)
-
-;; Emacs 21 tool bar.  Should be no-op otherwise.
-(defun gnus-group-make-tool-bar ()
-  (if (and
-       (condition-case nil (require 'tool-bar) (error nil))
-       (fboundp 'tool-bar-add-item-from-menu)
-       (default-value 'tool-bar-mode)
-       (not gnus-group-toolbar-map))
-      (setq gnus-group-toolbar-map
-	    (let ((tool-bar-map (make-sparse-keymap))
-		  (load-path (mm-image-load-path)))
-	      (tool-bar-add-item-from-menu
-	       'gnus-group-get-new-news "get-news" gnus-group-mode-map)
-	      (tool-bar-add-item-from-menu
-	       'gnus-group-get-new-news-this-group "gnntg" gnus-group-mode-map)
-	      (tool-bar-add-item-from-menu
-	       'gnus-group-catchup-current "catchup" gnus-group-mode-map)
-	      (tool-bar-add-item-from-menu
-	       'gnus-group-describe-group "describe-group" gnus-group-mode-map)
-	      (tool-bar-add-item "subscribe" 'gnus-group-subscribe 'subscribe
-				 :help "Subscribe to the current group")
-	      (tool-bar-add-item "unsubscribe" 'gnus-group-unsubscribe
-				 'unsubscribe
-				 :help "Unsubscribe from the current group")
-	      (tool-bar-add-item-from-menu
-	       'gnus-group-exit "exit-gnus" gnus-group-mode-map)
-	      tool-bar-map)))
-  (if gnus-group-toolbar-map
-      (set (make-local-variable 'tool-bar-map) gnus-group-toolbar-map)))
+
+(defvar gnus-group-tool-bar-map nil)
+
+(defun gnus-group-tool-bar-update (&optional symbol value)
+  "Update group buffer toolbar.
+Setter function for custom variables."
+  (when symbol
+    (set-default symbol value))
+  ;; (setq-default gnus-group-tool-bar-map nil)
+  ;; (use-local-map gnus-group-mode-map)
+  (when (gnus-alive-p)
+    (with-current-buffer gnus-group-buffer
+      (gnus-group-make-tool-bar t))))
+
+(defcustom gnus-group-tool-bar (if (eq gmm-tool-bar-style 'gnome)
+				   'gnus-group-tool-bar-gnome
+				 'gnus-group-tool-bar-retro)
+  "Specifies the Gnus group tool bar.
+
+It can be either a list or a symbol refering to a list.  See
+`gmm-tool-bar-from-list' for the format of the list.  The
+default key map is `gnus-group-mode-map'.
+
+Pre-defined symbols include `gnus-group-tool-bar-gnome' and
+`gnus-group-tool-bar-retro'."
+  :type '(choice (const :tag "GNOME style" gnus-group-tool-bar-gnome)
+		 (const :tag "Retro look" gnus-group-tool-bar-retro)
+		 (repeat :tag "User defined list" gmm-tool-bar-item)
+		 (symbol))
+  :version "23.0" ;; No Gnus
+  :initialize 'custom-initialize-default
+  :set 'gnus-group-tool-bar-update
+  :group 'gnus-group)
+
+(defcustom gnus-group-tool-bar-gnome
+  '((gnus-group-post-news "mail/compose")
+    ;; Some useful agent icons?  I don't use the agent so agent users should
+    ;; suggest useful commands:
+    (gnus-agent-toggle-plugged "connect" t
+     			       :visible (and gnus-agent (not gnus-plugged)))
+    (gnus-agent-toggle-plugged "disconnect" t
+     			       :visible (and gnus-agent gnus-plugged))
+    ;; FIXME: gnus-agent-toggle-plugged (in gnus-agent-group-make-menu-bar)
+    ;; should have a better help text.
+    (gnus-group-send-queue "mail/outbox" t
+			   :visible (and gnus-agent gnus-plugged)
+			   :help "Send articles from the queue group")
+    (gnus-group-get-new-news "mail/inbox" nil
+			     :visible (or (not gnus-agent)
+					  gnus-plugged))
+    ;; FIXME: gnus-*-read-group should have a better help text.
+    (gnus-topic-read-group "open" nil
+			   :visible (and (boundp 'gnus-topic-mode)
+					 gnus-topic-mode))
+    (gnus-group-read-group "open" nil
+			   :visible (not (and (boundp 'gnus-topic-mode)
+					      gnus-topic-mode)))
+    ;; (gnus-group-find-new-groups "???" nil)
+    (gnus-group-save-newsrc "save")
+    (gnus-group-describe-group "describe")
+    (gnus-group-unsubscribe-current-group "gnus/toggle-subscription")
+    (gnus-group-prev-unread-group "left-arrow")
+    (gnus-group-next-unread-group "right-arrow")
+    (gnus-group-exit "exit")
+    (gmm-customize-mode "preferences" t :help "Edit mode preferences")
+    (gnus-info-find-node "help"))
+  "List of functions for the group tool bar (GNOME style).
+
+See `gmm-tool-bar-from-list' for the format of the list."
+  :type '(repeat gmm-tool-bar-item)
+  :version "23.0" ;; No Gnus
+  :initialize 'custom-initialize-default
+  :set 'gnus-group-tool-bar-update
+  :group 'gnus-group)
+
+(defcustom gnus-group-tool-bar-retro
+  '((gnus-group-get-new-news "gnus/get-news")
+    (gnus-group-get-new-news-this-group "gnus/gnntg")
+    (gnus-group-catchup-current "gnus/catchup")
+    (gnus-group-describe-group "gnus/describe-group")
+    (gnus-group-subscribe "gnus/subscribe" t
+			  :help "Subscribe to the current group")
+    (gnus-group-unsubscribe "gnus/unsubscribe" t
+			    :help "Unsubscribe from the current group")
+    (gnus-group-exit "gnus/exit-gnus" gnus-group-mode-map))
+  "List of functions for the group tool bar (retro look).
+
+See `gmm-tool-bar-from-list' for the format of the list."
+  :type '(repeat gmm-tool-bar-item)
+  :version "23.0" ;; No Gnus
+  :initialize 'custom-initialize-default
+  :set 'gnus-group-tool-bar-update
+  :group 'gnus-group)
+
+(defcustom gnus-group-tool-bar-zap-list t
+  "List of icon items from the global tool bar.
+These items are not displayed in the Gnus group mode tool bar.
+
+See `gmm-tool-bar-from-list' for the format of the list."
+  :type 'gmm-tool-bar-zap-list
+  :version "23.0" ;; No Gnus
+  :initialize 'custom-initialize-default
+  :set 'gnus-group-tool-bar-update
+  :group 'gnus-group)
+
+(defvar image-load-path)
+
+(defun gnus-group-make-tool-bar (&optional force)
+  "Make a group mode tool bar from `gnus-group-tool-bar'.
+When FORCE, rebuild the tool bar."
+  (when (and (not (featurep 'xemacs))
+	     (boundp 'tool-bar-mode)
+	     tool-bar-mode
+	     ;; The Gnus 5.10.6 code checked (default-value 'tool-bar-mode).
+	     ;; Why?  --rsteib
+	     (or (not gnus-group-tool-bar-map) force))
+    (let* ((load-path
+	    (gmm-image-load-path-for-library "gnus"
+					     "gnus/toggle-subscription.xpm"
+					     nil t))
+           (image-load-path (cons (car load-path)
+                                  (when (boundp 'image-load-path)
+                                    image-load-path)))
+	   (map (gmm-tool-bar-from-list gnus-group-tool-bar
+					gnus-group-tool-bar-zap-list
+					'gnus-group-mode-map)))
+      (if map
+	  (set (make-local-variable 'tool-bar-map) map))))
+  gnus-group-tool-bar-map)

 (defun gnus-group-mode ()
   "Major mode for reading news.
@@ -1379,6 +1479,18 @@
 		(gnus-range-difference (list active) (gnus-info-read info))
 		seen))))))

+;; Moving through the Group buffer (in topic mode) e.g. with C-n doesn't
+;; update the state (enabled/disabled) of the icon
+;; `gnus-group-describe-group'.  After `C-l' the state is correct.  See the
+;; following report on emacs-devel
+;; <http://thread.gmane.org/v9acdmrcse.fsf@marauder.physik.uni-ulm.de>:
+
+;; From: Reiner Steib
+;; Subject: tool bar icons not updated according to :active condition
+;; Newsgroups: gmane.emacs.devel
+;; Date: Mon, 23 Jan 2006 19:59:13 +0100
+;; Message-ID: <v9acdmrcse.fsf@marauder.physik.uni-ulm.de>
+
 (defcustom gnus-group-update-tool-bar
   (and (not (featurep 'xemacs))
        (boundp 'tool-bar-mode)
--- a/lisp/gnus/gnus-sum.el	Mon Apr 17 13:44:56 2006 +0000
+++ b/lisp/gnus/gnus-sum.el	Mon Apr 17 18:26:22 2006 +0000
@@ -38,6 +38,7 @@
 (require 'gnus-int)
 (require 'gnus-undo)
 (require 'gnus-util)
+(require 'gmm-utils)
 (require 'mm-decode)
 (require 'nnoo)

@@ -2546,47 +2547,161 @@

 (defvar gnus-summary-tool-bar-map nil)

-;; Emacs 21 tool bar.  Should be no-op otherwise.
-(defun gnus-summary-make-tool-bar ()
-  (if (and (fboundp 'tool-bar-add-item-from-menu)
-	   (default-value 'tool-bar-mode)
-	   (not gnus-summary-tool-bar-map))
-      (setq gnus-summary-tool-bar-map
-	    (let ((tool-bar-map (make-sparse-keymap))
-		  (load-path (mm-image-load-path)))
-	      (tool-bar-add-item-from-menu
-	       'gnus-summary-prev-unread "prev-ur" gnus-summary-mode-map)
-	      (tool-bar-add-item-from-menu
-	       'gnus-summary-next-unread "next-ur" gnus-summary-mode-map)
-	      (tool-bar-add-item-from-menu
-	       'gnus-summary-post-news "post" gnus-summary-mode-map)
-	      (tool-bar-add-item-from-menu
-	       'gnus-summary-followup-with-original "fuwo" gnus-summary-mode-map)
-	      (tool-bar-add-item-from-menu
-	       'gnus-summary-followup "followup" gnus-summary-mode-map)
-	      (tool-bar-add-item-from-menu
-	       'gnus-summary-reply-with-original "reply-wo" gnus-summary-mode-map)
-	      (tool-bar-add-item-from-menu
-	       'gnus-summary-reply "reply" gnus-summary-mode-map)
-	      (tool-bar-add-item-from-menu
-	       'gnus-summary-caesar-message "rot13" gnus-summary-mode-map)
-	      (tool-bar-add-item-from-menu
-	       'gnus-uu-decode-uu "uu-decode" gnus-summary-mode-map)
-	      (tool-bar-add-item-from-menu
-	       'gnus-summary-save-article-file "save-aif" gnus-summary-mode-map)
-	      (tool-bar-add-item-from-menu
-	       'gnus-summary-save-article "save-art" gnus-summary-mode-map)
-	      (tool-bar-add-item-from-menu
-	       'gnus-uu-post-news "uu-post" gnus-summary-mode-map)
-	      (tool-bar-add-item-from-menu
-	       'gnus-summary-catchup "catchup" gnus-summary-mode-map)
-	      (tool-bar-add-item-from-menu
-	       'gnus-summary-catchup-and-exit "cu-exit" gnus-summary-mode-map)
-	      (tool-bar-add-item-from-menu
-	       'gnus-summary-exit "exit-summ" gnus-summary-mode-map)
-	      tool-bar-map)))
-  (if gnus-summary-tool-bar-map
-      (set (make-local-variable 'tool-bar-map) gnus-summary-tool-bar-map)))
+;; Note: The :set function in the `gnus-summary-tool-bar*' variables will only
+;; affect _new_ message buffers.  We might add a function that walks thru all
+;; summary-mode buffers and force the update.
+(defun gnus-summary-tool-bar-update (&optional symbol value)
+  "Update summary mode toolbar.
+Setter function for custom variables."
+  (setq-default gnus-summary-tool-bar-map nil)
+  (when symbol
+    ;; When used as ":set" function:
+    (set-default symbol value))
+  (when (gnus-buffer-live-p gnus-summary-buffer)
+    (with-current-buffer gnus-summary-buffer
+      (gnus-summary-make-tool-bar))))
+
+(defcustom gnus-summary-tool-bar (if (eq gmm-tool-bar-style 'gnome)
+				     'gnus-summary-tool-bar-gnome
+				   'gnus-summary-tool-bar-retro)
+  "Specifies the Gnus summary tool bar.
+
+It can be either a list or a symbol refering to a list.  See
+`gmm-tool-bar-from-list' for the format of the list.  The
+default key map is `gnus-summary-mode-map'.
+
+Pre-defined symbols include `gnus-summary-tool-bar-gnome' and
+`gnus-summary-tool-bar-retro'."
+  :type '(choice (const :tag "GNOME style" gnus-summary-tool-bar-gnome)
+		 (const :tag "Retro look"  gnus-summary-tool-bar-retro)
+		 (repeat :tag "User defined list" gmm-tool-bar-item)
+		 (symbol))
+  :version "23.0" ;; No Gnus
+  :initialize 'custom-initialize-default
+  :set 'gnus-summary-tool-bar-update
+  :group 'gnus-summary)
+
+(defcustom gnus-summary-tool-bar-gnome
+  '((gnus-summary-post-news "mail/compose" nil)
+    (gnus-summary-insert-new-articles "mail/inbox" nil
+				      :visible (or (not gnus-agent)
+						   gnus-plugged))
+    (gnus-summary-reply-with-original "mail/reply")
+    (gnus-summary-reply "mail/reply" nil :visible nil)
+    (gnus-summary-followup-with-original "mail/reply-all")
+    (gnus-summary-followup "mail/reply-all" nil :visible nil)
+    (gnus-summary-mail-forward "mail/forward")
+    (gnus-summary-save-article "mail/save")
+    (gnus-summary-search-article-forward "search" nil :visible nil)
+    (gnus-summary-print-article "print")
+    (gnus-summary-tick-article-forward "flag-followup" nil :visible nil)
+    ;; Some new commands that may need more suitable icons:
+    (gnus-summary-save-newsrc "save" nil :visible nil)
+    ;; (gnus-summary-show-article "stock_message-display" nil :visible nil)
+    (gnus-summary-prev-article "left-arrow")
+    (gnus-summary-next-article "right-arrow")
+    (gnus-summary-next-page "next-page")
+    ;; (gnus-summary-enter-digest-group "right_arrow" nil :visible nil)
+    ;;
+    ;; Maybe some sort-by-... could be added:
+    ;; (gnus-summary-sort-by-author "sort-a-z" nil :visible nil)
+    ;; (gnus-summary-sort-by-date "sort-1-9" nil :visible nil)
+    (gnus-summary-mark-as-expirable
+     "delete" nil
+     :visible (gnus-check-backend-function 'request-expire-articles
+					   gnus-newsgroup-name))
+    (gnus-summary-mark-as-spam
+     "mail/spam" t
+     :visible (and (fboundp 'spam-group-ham-contents-p)
+		   (spam-group-ham-contents-p gnus-newsgroup-name))
+     :help "Mark as spam")
+    (gnus-summary-mark-as-read-forward
+     "mail/not-spam" nil
+     :visible (and (fboundp 'spam-group-spam-contents-p)
+		   (spam-group-spam-contents-p gnus-newsgroup-name)))
+    ;;
+    (gnus-summary-exit "exit")
+    (gmm-customize-mode "preferences" t :help "Edit mode preferences")
+    (gnus-info-find-node "help"))
+  "List of functions for the summary tool bar (GNOME style).
+
+See `gmm-tool-bar-from-list' for the format of the list."
+  :type '(repeat gmm-tool-bar-item)
+  :version "23.0" ;; No Gnus
+  :initialize 'custom-initialize-default
+  :set 'gnus-summary-tool-bar-update
+  :group 'gnus-summary)
+
+(defcustom gnus-summary-tool-bar-retro
+  '((gnus-summary-prev-unread-article "gnus/prev-ur")
+    (gnus-summary-next-unread-article "gnus/next-ur")
+    (gnus-summary-post-news "gnus/post")
+    (gnus-summary-followup-with-original "gnus/fuwo")
+    (gnus-summary-followup "gnus/followup")
+    (gnus-summary-reply-with-original "gnus/reply-wo")
+    (gnus-summary-reply "gnus/reply")
+    (gnus-summary-caesar-message "gnus/rot13")
+    (gnus-uu-decode-uu "gnus/uu-decode")
+    (gnus-summary-save-article-file "gnus/save-aif")
+    (gnus-summary-save-article "gnus/save-art")
+    (gnus-uu-post-news "gnus/uu-post")
+    (gnus-summary-catchup "gnus/catchup")
+    (gnus-summary-catchup-and-exit "gnus/cu-exit")
+    (gnus-summary-exit "gnus/exit-summ")
+    ;; Some new command that may need more suitable icons:
+    (gnus-summary-print-article "gnus/print" nil :visible nil)
+    (gnus-summary-mark-as-expirable "gnus/close" nil :visible nil)
+    (gnus-summary-save-newsrc "gnus/save" nil :visible nil)
+    ;; (gnus-summary-enter-digest-group "gnus/right_arrow" nil :visible nil)
+    (gnus-summary-search-article-forward "gnus/search" nil :visible nil)
+    ;; (gnus-summary-insert-new-articles "gnus/paste" nil :visible nil)
+    ;; (gnus-summary-toggle-threads "gnus/open" nil :visible nil)
+    ;;
+    (gnus-info-find-node "gnus/help" nil :visible nil))
+  "List of functions for the summary tool bar (retro look).
+
+See `gmm-tool-bar-from-list' for the format of the list."
+  :type '(repeat gmm-tool-bar-item)
+  :version "23.0" ;; No Gnus
+  :initialize 'custom-initialize-default
+  :set 'gnus-summary-tool-bar-update
+  :group 'gnus-summary)
+
+(defcustom gnus-summary-tool-bar-zap-list t
+  "List of icon items from the global tool bar.
+These items are not displayed in the Gnus summary mode tool bar.
+
+See `gmm-tool-bar-from-list' for the format of the list."
+  :type 'gmm-tool-bar-zap-list
+  :version "23.0" ;; No Gnus
+  :initialize 'custom-initialize-default
+  :set 'gnus-summary-tool-bar-update
+  :group 'gnus-summary)
+
+(defvar image-load-path)
+
+(defun gnus-summary-make-tool-bar (&optional force)
+  "Make a summary mode tool bar from `gnus-summary-tool-bar'.
+When FORCE, rebuild the tool bar."
+  (when (and (not (featurep 'xemacs))
+	     (boundp 'tool-bar-mode)
+	     tool-bar-mode
+	     (or (not gnus-summary-tool-bar-map) force))
+    (let* ((load-path
+	    (gmm-image-load-path-for-library "gnus"
+					     "mail/save.xpm"
+					     nil t))
+           (image-load-path (cons (car load-path)
+                                  (when (boundp 'image-load-path)
+                                    image-load-path)))
+	   (map (gmm-tool-bar-from-list gnus-summary-tool-bar
+					gnus-summary-tool-bar-zap-list
+					'gnus-summary-mode-map)))
+      (when map
+	;; Need to set `gnus-summary-tool-bar-map' because `gnus-article-mode'
+	;; uses it's value.
+	(setq gnus-summary-tool-bar-map map))))
+  (set (make-local-variable 'tool-bar-map) gnus-summary-tool-bar-map))

 (defun gnus-score-set-default (var value)
   "A version of set that updates the GNU Emacs menu-bar."
--- a/lisp/gnus/message.el	Mon Apr 17 13:44:56 2006 +0000
+++ b/lisp/gnus/message.el	Mon Apr 17 18:26:22 2006 +0000
@@ -37,6 +37,7 @@
   (defvar gnus-list-identifiers)) ; gnus-sum is required where necessary
 (require 'canlock)
 (require 'mailheader)
+(require 'gmm-utils)
 (require 'nnheader)
 ;; This is apparently necessary even though things are autoloaded.
 ;; Because we dynamically bind mail-abbrev-mode-regexp, we'd better
@@ -2529,7 +2530,7 @@
     (set (make-local-variable 'font-lock-defaults)
 	 '(message-font-lock-keywords t))
     (if (boundp 'tool-bar-map)
-	(set (make-local-variable 'tool-bar-map) (message-tool-bar-map))))
+	(set (make-local-variable 'tool-bar-map) (message-make-tool-bar))))
   (easy-menu-add message-mode-menu message-mode-map)
   (easy-menu-add message-mode-field-menu message-mode-map)
   (gnus-make-local-hook 'after-change-functions)
@@ -6586,53 +6587,123 @@

 ;; Support for toolbar
 (eval-when-compile
-  (defvar tool-bar-map)
   (defvar tool-bar-mode))

-(defun message-tool-bar-local-item-from-menu (command icon in-map &optional from-map &rest props)
-  ;; We need to make tool bar entries in local keymaps with
-  ;; `tool-bar-local-item-from-menu' in Emacs >= 22
-  (if (fboundp 'tool-bar-local-item-from-menu)
-      (tool-bar-local-item-from-menu command icon in-map from-map props)
-    (tool-bar-add-item-from-menu command icon from-map props)))
-
-(defun message-tool-bar-map ()
-  (or message-tool-bar-map
-      (setq message-tool-bar-map
-	    (and
-	     (condition-case nil (require 'tool-bar) (error nil))
-	     (fboundp 'tool-bar-add-item-from-menu)
+;; Note: The :set function in the `message-tool-bar*' variables will only
+;; affect _new_ message buffers.  We might add a function that walks thru all
+;; message-mode buffers and force the update.
+(defun message-tool-bar-update (&optional symbol value)
+  "Update message mode toolbar.
+Setter function for custom variables."
+  (setq-default message-tool-bar-map nil)
+  (when symbol
+    ;; When used as ":set" function:
+    (set-default symbol value)))
+
+(defcustom message-tool-bar (if (eq gmm-tool-bar-style 'gnome)
+				'message-tool-bar-gnome
+			      'message-tool-bar-retro)
+  "Specifies the message mode tool bar.
+
+It can be either a list or a symbol refering to a list.  See
+`gmm-tool-bar-from-list' for the format of the list.  The
+default key map is `message-mode-map'.
+
+Pre-defined symbols include `message-tool-bar-gnome' and
+`message-tool-bar-retro'."
+  :type '(repeat gmm-tool-bar-list-item)
+  :type '(choice (const :tag "GNOME style" message-tool-bar-gnome)
+		 (const :tag "Retro look"  message-tool-bar-retro)
+		 (repeat :tag "User defined list" gmm-tool-bar-item)
+		 (symbol))
+  :version "22.1" ;; Gnus 5.10.9
+  :initialize 'custom-initialize-default
+  :set 'message-tool-bar-update
+  :group 'message)
+
+(defcustom message-tool-bar-gnome
+  '((ispell-message "spell" nil
+		    :visible (or (not (boundp 'flyspell-mode))
+				 (not flyspell-mode)))
+    (flyspell-buffer "spell" t
+		     :visible (and (boundp 'flyspell-mode)
+				   flyspell-mode)
+		     :help "Flyspell whole buffer")
+    (gmm-ignore "separator")
+    (message-send-and-exit "mail/send")
+    (message-dont-send "mail/save-draft")
+    (message-kill-buffer "close") ;; stock_cancel
+    (mml-attach-file "attach" mml-mode-map)
+    (mml-preview "mail/preview" mml-mode-map)
+    ;; (mml-secure-message-sign-encrypt "lock" mml-mode-map :visible nil)
+    (message-insert-importance-high "important" nil :visible nil)
+    (message-insert-importance-low "unimportant" nil :visible nil)
+    (message-insert-disposition-notification-to "receipt" nil :visible nil)
+    (gmm-customize-mode "preferences" t :help "Edit mode preferences")
+    (message-info "help" t :help "Message manual"))
+  "List of items for the message tool bar (GNOME style).
+
+See `gmm-tool-bar-from-list' for details on the format of the list."
+  :type '(repeat gmm-tool-bar-item)
+  :version "22.1" ;; Gnus 5.10.9
+  :initialize 'custom-initialize-default
+  :set 'message-tool-bar-update
+  :group 'message)
+
+(defcustom message-tool-bar-retro
+  '(;; Old Emacs 21 icon for consistency.
+    (message-send-and-exit "gnus/mail_send")
+    (message-kill-buffer "close")
+    (message-dont-send "cancel")
+    (mml-attach-file "attach" mml-mode-map)
+    (ispell-message "spell")
+    (mml-preview "preview" mml-mode-map)
+    (message-insert-importance-high "gnus/important")
+    (message-insert-importance-low "gnus/unimportant")
+    (message-insert-disposition-notification-to "gnus/receipt"))
+  "List of items for the message tool bar (retro style).
+
+See `gmm-tool-bar-from-list' for details on the format of the list."
+  :type '(repeat gmm-tool-bar-item)
+  :version "22.1" ;; Gnus 5.10.9
+  :initialize 'custom-initialize-default
+  :set 'message-tool-bar-update
+  :group 'message)
+
+(defcustom message-tool-bar-zap-list
+  '(new-file open-file dired kill-buffer write-file
+	     print-buffer customize help)
+  "List of icon items from the global tool bar.
+These items are not displayed on the message mode tool bar.
+
+See `gmm-tool-bar-from-list' for the format of the list."
+  :type 'gmm-tool-bar-zap-list
+  :version "22.1" ;; Gnus 5.10.9
+  :initialize 'custom-initialize-default
+  :set 'message-tool-bar-update
+  :group 'message)
+
+(defvar image-load-path)
+
+(defun message-make-tool-bar (&optional force)
+  "Make a message mode tool bar from `message-tool-bar-list'.
+When FORCE, rebuild the tool bar."
+  (when (and (not (featurep 'xemacs))
+	     (boundp 'tool-bar-mode)
 	     tool-bar-mode
-	     (let ((tool-bar-map (copy-keymap tool-bar-map))
-		   (load-path (mm-image-load-path)))
-	       ;; Zap some items which aren't so relevant and take
-	       ;; up space.
-	       (dolist (key '(print-buffer kill-buffer save-buffer
-					   write-file dired open-file))
-		 (define-key tool-bar-map (vector key) nil))
-	       (message-tool-bar-local-item-from-menu
-		'message-send-and-exit "mail/send" tool-bar-map message-mode-map)
-	       (message-tool-bar-local-item-from-menu
-		'message-kill-buffer "close" tool-bar-map message-mode-map)
-	       (message-tool-bar-local-item-from-menu
-		    'message-dont-send "cancel" tool-bar-map message-mode-map)
-	       (message-tool-bar-local-item-from-menu
-		'mml-attach-file "attach" tool-bar-map mml-mode-map)
-	       (message-tool-bar-local-item-from-menu
-		'ispell-message "spell" tool-bar-map message-mode-map)
-	       (message-tool-bar-local-item-from-menu
-		'mml-preview "preview"
-		tool-bar-map mml-mode-map)
-	       (message-tool-bar-local-item-from-menu
-		'message-insert-importance-high "important"
-		tool-bar-map message-mode-map)
-	       (message-tool-bar-local-item-from-menu
-		'message-insert-importance-low "unimportant"
-		tool-bar-map message-mode-map)
-	       (message-tool-bar-local-item-from-menu
-		'message-insert-disposition-notification-to "receipt"
-		tool-bar-map message-mode-map)
-	       tool-bar-map)))))
+	     (or (not message-tool-bar-map) force))
+    (setq message-tool-bar-map
+	  (let* ((load-path
+		  (gmm-image-load-path-for-library "message"
+						   "mail/save-draft.xpm"
+						   nil t))
+		 (image-load-path (cons (car load-path)
+					(when (boundp 'image-load-path)
+					  image-load-path))))
+	    (gmm-tool-bar-from-list message-tool-bar
+				    message-tool-bar-zap-list
+				    'message-mode-map))))
+  message-tool-bar-map)

 ;;; Group name completion.