Re: png images in tool-bar / alpha mask

[David Reitter <david.reitter@gmail.com>]

On 2 Apr 2008, at 13:39, YAMAMOTO Mitsuharu wrote:
>
>> I'm working on a patch to see if this is doable.  I'll get back to
>> you once I've tested it.
>
> OK, I'll wait a month.

OK, how about the patches below?

The change to image.c is actually very short.
The patch to tool-bar.el is intended to load PNG files where they are  
available, and to automatically load files named <basename>_dis.<ext>  
and <basename>_sel.<ext> to automatically find the disabled (greyed  
out) and selected (darkened) variant where provided.

I find that the algorithm that is applied now (by OS X at least) to my  
PNG graphics works perfectly, so I'm not even providing the _dis and  
_sel files any longer.  However, this was beneficial when the non-tool- 
kit toolbar was used to avoid the default manipulation of the images,  
so I'm leaving it in for others.




Index: image.c
===================================================================
RCS file: /sources/emacs/emacs/src/image.c,v
retrieving revision 1.65.2.13
diff -c -r1.65.2.13 image.c
*** image.c	28 Mar 2008 14:57:32 -0000	1.65.2.13
--- image.c	3 Apr 2008 15:01:11 -0000
***************
*** 2767,2773 ****
       }
     CGContextDrawImage (context, rectangle, image);
     QDEndCGContext (ximg, &context);
!   CGImageRelease (image);

     /* Maybe fill in the background field while we have ximg handy. */
     if (NILP (image_spec_value (img->spec, QCbackground, NULL)))
--- 2767,2774 ----
       }
     CGContextDrawImage (context, rectangle, image);
     QDEndCGContext (ximg, &context);
!
!   img->data.ptr_val = image; /* retain original data */

     /* Maybe fill in the background field while we have ximg handy. */
     if (NILP (image_spec_value (img->spec, QCbackground, NULL)))
Index: tool-bar.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/tool-bar.el,v
retrieving revision 1.7.2.2
diff -c -r1.7.2.2 tool-bar.el
*** tool-bar.el	7 Jan 2008 02:44:11 -0000	1.7.2.2
--- tool-bar.el	3 Apr 2008 15:04:53 -0000
***************
*** 90,95 ****
--- 90,165 ----
   		'(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))
+
+ (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") :background "grey") )
+ 	 (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)
--- 189,200 ----
   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
--- 227,235 ----
       (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)))
--- 249,258 ----
   			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)))