*** /cvs/emacs/lisp/tool-bar.el	2007-01-18 20:14:52.000000000 +0000
--- tool-bar.el	2007-01-18 14:18:55.000000000 +0000
***************
*** 98,113 ****
  PROPS are additional items to add to the menu item specification.  See
  Info node `(elisp)Tool Bar'.  Items are added from left to right.
  
! ICON is the base name of a file containing the image to use.  The
! function will first try to use low-color/ICON.xpm if display-color-cells
! is less or equal to 256, then ICON.xpm, then ICON.pbm, and finally
! ICON.xbm, using `find-image'.
  
  Use this function only to make bindings in the global value of `tool-bar-map'.
  To define items in any other map, use `tool-bar-local-item'."
    (apply 'tool-bar-local-item icon def key tool-bar-map props))
  
  ;;;###autoload
  (defun tool-bar-local-item (icon def key map &rest props)
    "Add an item to the tool bar in map MAP.
  ICON names the image, DEF is the key definition and KEY is a symbol
--- 98,163 ----
  PROPS are additional items to add to the menu item specification.  See
  Info node `(elisp)Tool Bar'.  Items are added from left to right.
  
! ICON is the base name of a file containing the image to use.
  
  Use this function only to make bindings in the global value of `tool-bar-map'.
  To define items in any other map, use `tool-bar-local-item'."
    (apply 'tool-bar-local-item icon def key tool-bar-map props))
  
  ;;;###autoload
+ (defun tool-bar-find-best-icon (base-name)
+   "Find the best available icon with for local display capabilities
+ 
+ BASE NAME is the sought filename without path or extension.
+ 
+ For color screens, the function will first try to find low-color/BASE-NAME.xpm if display-color-cells is less or equal to 256, then BASE-NAME.png if PNG is supported, then BASE-NAME.xpm, then BASE-NAME.pbm, and finally BASE-NAME.xbm.
+ 
+ For monochrome screens, the function will first try to find BASE-NAME.pbm, then BASE-NAME.xbm, then low-color/BASE-NAME.xpm, then BASE-NAME.png if PNG is supported, then BASE-NAME.xpm.
+ 
+ Currently, the function does not test for XPM support, only PNG.
+ 
+ If no suitable icon file is found, returns nil."
+   (let* ((fg (face-attribute 'tool-bar :foreground))
+         (bg (face-attribute 'tool-bar :background))
+ 	(colors (nconc (if (eq fg 'unspecified) nil (list :foreground fg))
+ 		       (if (eq bg 'unspecified) nil (list :background bg))))
+ 	(xpm-spec (list :type 'xpm :file (concat base-name ".xpm")))
+ 	(xpm-lo-spec (if (> (display-color-cells) 256)
+ 			 nil ;; Not required
+ 		       (list :type 'xpm :file
+ 			     (concat "low-color/" base-name ".xpm"))))
+ 	(pbm-spec (append (list :type 'pbm :file
+ 				(concat base-name ".pbm")) colors))
+ 	(xbm-spec (append (list :type 'xbm :file
+ 				(concat base-name ".xbm")) colors))
+ 	;; Add PNG if supported.
+ 	(png-spec (if (image-type-available-p 'png)
+ 		      (append (list :type 'png :file
+ 				    (concat base-name ".png")) colors) 
+ 		    nil ; Not supported
+ 		    ))
+ 	;; Formats listed in order of decreasing preference.
+ 	(formats-for-monochrome-screens 
+ 	 (list pbm-spec    ; Concise monochrome
+ 	       xbm-spec    ; Verbose monochrome
+ 	       xpm-lo-spec ; Low-color
+ 	       png-spec    ; High quality color: nil if unsupported
+ 	       xpm-spec    ; Poor quality color
+ 	       ))
+ 	 (formats-for-color-screens 
+ 	  (list xpm-lo-spec ; Low-color: nil if not preferred
+ 		png-spec    ; High quality color: nil if unsupported
+ 		xpm-spec    ; Poor quality color
+ 		pbm-spec    ; Concise monochrome
+ 		xbm-spec    ; Verbose monochrome
+ 		)))
+ 	 (find-image
+ 		 (if (display-color-p)
+ 		     formats-for-color-screens
+ 		   formats-for-monochrome-screens)))
+ )
+ 
+ ;;;###autoload
  (defun tool-bar-local-item (icon def key map &rest props)
    "Add an item to the tool bar in map MAP.
  ICON names the image, DEF is the key definition and KEY is a symbol
***************
*** 115,142 ****
  PROPS are additional items to add to the menu item specification.  See
  Info node `(elisp)Tool Bar'.  Items are added from left to right.
  
! ICON is the base name of a file containing the image to use.  The
! function will first try to use low-color/ICON.xpm if display-color-cells
! is less or equal to 256, then ICON.xpm, then ICON.pbm, and finally
! ICON.xbm, using `find-image'."
!   (let* ((fg (face-attribute 'tool-bar :foreground))
! 	 (bg (face-attribute 'tool-bar :background))
! 	 (colors (nconc (if (eq fg 'unspecified) nil (list :foreground fg))
! 			(if (eq bg 'unspecified) nil (list :background bg))))
! 	 (xpm-spec (list :type 'xpm :file (concat icon ".xpm")))
! 	 (xpm-lo-spec (if (> (display-color-cells) 256)
! 			  nil
! 			(list :type 'xpm :file
!                               (concat "low-color/" icon ".xpm"))))
! 	 (pbm-spec (append (list :type 'pbm :file
!                                  (concat icon ".pbm")) colors))
! 	 (xbm-spec (append (list :type 'xbm :file
!                                  (concat icon ".xbm")) colors))
! 	 (image (find-image
! 		(if (display-color-p)
! 		    (list xpm-lo-spec xpm-spec pbm-spec xbm-spec)
! 		  (list pbm-spec xbm-spec xpm-lo-spec xpm-spec)))))
! 
      (when (and (display-images-p) image)
        (unless (image-mask-p image)
  	(setq image (append image '(:mask heuristic))))
--- 165,172 ----
  PROPS are additional items to add to the menu item specification.  See
  Info node `(elisp)Tool Bar'.  Items are added from left to right.
  
! ICON is the base name of a file containing the image to use."
!    (let* ((image (tool-bar-find-best-icon icon)))
      (when (and (display-images-p) image)
        (unless (image-mask-p image)
  	(setq image (append image '(:mask heuristic))))
***************
*** 148,155 ****
    "Define tool bar binding for COMMAND in keymap MAP using the given ICON.
  This makes a binding for COMMAND in `tool-bar-map', copying its
  binding from the menu bar in MAP (which defaults to `global-map'), but
! modifies the binding by adding an image specification for ICON.  It
! finds ICON just like `tool-bar-add-item'.  PROPS are additional
  properties to add to the binding.
  
  MAP must contain appropriate binding for `[menu-bar]' which holds a keymap.
--- 178,185 ----
    "Define tool bar binding for COMMAND in keymap MAP using the given ICON.
  This makes a binding for COMMAND in `tool-bar-map', copying its
  binding from the menu bar in MAP (which defaults to `global-map'), but
! modifies the binding by adding an image specification for ICON. It
! finds ICON just like `tool-bar-add-item'. PROPS are additional
  properties to add to the binding.
  
  MAP must contain appropriate binding for `[menu-bar]' which holds a keymap.
***************
*** 174,196 ****
      (setq from-map global-map))
    (let* ((menu-bar-map (lookup-key from-map [menu-bar]))
  	 (keys (where-is-internal command menu-bar-map))
! 	 (fg (face-attribute 'tool-bar :foreground))
! 	 (bg (face-attribute 'tool-bar :background))
! 	 (colors (nconc (if (eq fg 'unspecified) nil (list :foreground fg))
! 			(if (eq bg 'unspecified) nil (list :background bg))))
! 	 (xpm-spec (list :type 'xpm :file (concat icon ".xpm")))
! 	 (xpm-lo-spec (if (> (display-color-cells) 256)
! 			  nil
! 			(list :type 'xpm :file
!                               (concat "low-color/" icon ".xpm"))))
! 	 (pbm-spec (append (list :type 'pbm :file
!                                  (concat icon ".pbm")) colors))
! 	 (xbm-spec (append (list :type 'xbm :file
!                                  (concat icon ".xbm")) colors))
! 	 (spec (if (display-color-p)
! 		   (list xpm-lo-spec xpm-spec pbm-spec xbm-spec)
! 		 (list pbm-spec xbm-spec xpm-lo-spec xpm-spec)))
! 	 (image (find-image spec))
  	 submap key)
      (when (and (display-images-p) image)
        ;; We'll pick up the last valid entry in the list of keys if
--- 204,210 ----
      (setq from-map global-map))
    (let* ((menu-bar-map (lookup-key from-map [menu-bar]))
  	 (keys (where-is-internal command menu-bar-map))
! 	 (image (tool-bar-find-best-icon icon))
  	 submap key)
      (when (and (display-images-p) image)
        ;; We'll pick up the last valid entry in the list of keys if