Index: lisp/tool-bar.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/tool-bar.el,v
retrieving revision 1.5
diff -c -r1.5 tool-bar.el
*** lisp/tool-bar.el	6 Feb 2006 14:33:35 -0000	1.5
--- lisp/tool-bar.el	2 May 2006 11:18:01 -0000
***************
*** 90,95 ****
--- 90,166 ----
   		'(menu-item "tool bar" ignore
   			    :filter (lambda (ignore) tool-bar-map)))

+ (defun tool-bar-set-file-extension (image-spec-list extension)
+   "Set new file extensions for all :file properties
+ Replace any extensions of :file properties in elements of
+ IMAGE-SPEC-LIST. An extension may start with a period . or an
+ underscore. EXTENSION and the original file name extension (starting
+ with a period) are added to the file name.
+
+ E.g. foo_dis.xpm becomes foo_sel.xpm if EXTENSION is '_sel'."
+   (mapcar
+    (lambda (spec)
+      (let ((f (plist-get spec :file))
+ 	    )
+         (if (null f)
+ 	    spec
+ 	  ;; need to replace previous extensions, including those
+ 	  ;; starting with _ -
+ 	  (plist-put spec :file (concat (replace-regexp-in-string "[\.\_].*$"
+ 								  "" f)
+ 					extension
+ 					(file-name-extension f t)))
+ 	  )))
+    image-spec-list))
+
+ ;; (cdr (tool-bar-get-image-spec "new"))
+ (defun tool-bar-get-image-spec (icon)
+   (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"))))
+ 	 (png-spec (list :type 'png
+ 			   :file (concat icon ".png")) )
+ 	 (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 png-spec xpm-lo-spec xpm-spec pbm-spec xbm-spec)
+ 		  (list pbm-spec xbm-spec xpm-lo-spec xpm-spec))))
+ 	 (image-sel (find-image
+ 		     (if (display-color-p)
+ 			 (tool-bar-set-file-extension
+ 			  (list png-spec xpm-lo-spec xpm-spec pbm-spec xbm-spec)
+ 			  "_sel")
+ 		       nil)))
+ 	 (image-dis (find-image
+ 		     (if (display-color-p)
+ 			 (tool-bar-set-file-extension
+ 			  (list png-spec xpm-lo-spec xpm-spec pbm-spec xbm-spec)
+ 			  "_dis")
+ 		       nil)))
+ 	 (images (when image ;; image may be nil if not found.
+ 		   (unless (image-mask-p image)
+ 		     (setq image (append image '(:mask heuristic))))
+ 		   (if (and image-sel image-dis)
+ 		       (progn		
+ 			 (unless (image-mask-p image-sel)
+ 			   (setq image-sel (append image-sel
+ 						   '(:mask heuristic))))
+ 			 (unless (image-mask-p image-dis)
+ 			   (setq image-dis (append image-dis
+ 						   '(:mask heuristic))))
+ 			 (vector image-sel image image-dis image-dis))
+ 		     image))))
+     (cons image images)))
+
   ;;;###autoload
   (defun tool-bar-add-item (icon def key &rest props)
     "Add an item to the tool bar.
***************
*** 119,147 ****
   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))))
         (define-key-after map (vector key)
! 	`(menu-item ,(symbol-name key) ,def :image ,image ,@props)))))

   ;;;###autoload
   (defun tool-bar-add-item-from-menu (command icon &optional map  
&rest props)
--- 190,203 ----
   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* ((is (tool-bar-get-image-spec icon))
! 	 (image (car is))
! 	 (images (cdr is)))

       (when (and (display-images-p) image)
!
         (define-key-after map (vector key)
! 	`(menu-item ,(symbol-name key) ,def :image ,images ,@props)))))

   ;;;###autoload
   (defun tool-bar-add-item-from-menu (command icon &optional map  
&rest props)
***************
*** 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
--- 230,238 ----
       (setq from-map global-map))
     (let* ((menu-bar-map (lookup-key from-map [menu-bar]))
   	 (keys (where-is-internal command menu-bar-map))
! 	 (is (tool-bar-get-image-spec icon))
! 	 (image (car is))
! 	 (images (cdr is))
   	 submap key)
       (when (and (display-images-p) image)
         ;; We'll pick up the last valid entry in the list of keys if
***************
*** 210,221 ****
   			key kk)))))
         (when (and (symbolp submap) (boundp submap))
   	(setq submap (eval submap)))
-       (unless (image-mask-p image)
- 	(setq image (append image '(:mask heuristic))))
         (let ((defn (assq key (cdr submap))))
   	(if (eq (cadr defn) 'menu-item)
   	    (define-key-after in-map (vector key)
! 	      (append (cdr defn) (list :image image) props))
   	  (setq defn (cdr defn))
   	  (define-key-after in-map (vector key)
   	    (let ((rest (cdr defn)))
--- 252,261 ----
   			key kk)))))
         (when (and (symbolp submap) (boundp submap))
   	(setq submap (eval submap)))
         (let ((defn (assq key (cdr submap))))
   	(if (eq (cadr defn) 'menu-item)
   	    (define-key-after in-map (vector key)
! 	      (append (cdr defn) (list :image images) props))
   	  (setq defn (cdr defn))
   	  (define-key-after in-map (vector key)
   	    (let ((rest (cdr defn)))