Re: png images in tool-bar / alpha mask

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

On 4 Apr 2008, at 00:12, YAMAMOTO Mitsuharu wrote:
> `:mask nil' means removing the mask.
> Should be #if instead of #ifdef.
> Need to release it if !USE_CG_DRAWING.


All good points. Thanks.
Also, image-mask-p needed to be changed to recognize the alpha channel.



2008-04-04  David Reitter <david.reitter@gmail.com>

	* tool-bar.el (tool-bar-set-file-extension): add function
	(tool-bar-get-image-spec): load PNG if available and load image
	files named foo_sel.bar and foo_dis.bar to define selected and
  	disabled state images.
	(tool-bar-local-item-from-menu): take images and masks from icon,
	do not create extra mask.


2008-04-04  David Reitter <david.reitter@gmail.com>

	* image.c (image_load_quartz2d) [USE_CG_DRAWING]: retain
	platform image data
	(postprocess_image) [USE_CG_DRAWING]: release data when
	making modifications to the image
	(Fimage_mask_p) [USE_CG_DRAWING]: check for mask in data




Index: lisp/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
*** lisp/tool-bar.el	7 Jan 2008 02:44:11 -0000	1.7.2.2
--- lisp/tool-bar.el	4 Apr 2008 11:22:19 -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))
+
+ (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 (if (image-type-available-p 'png)
+ 		       (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)
--- 190,201 ----
   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
--- 228,236 ----
       (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)))
--- 250,259 ----
   			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)))
Index: src/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
*** src/image.c	28 Mar 2008 14:57:32 -0000	1.65.2.13
--- src/image.c	4 Apr 2008 11:14:01 -0000
***************
*** 1135,1140 ****
--- 1135,1146 ----
         struct image *img = IMAGE_FROM_ID (f, id);
         if (img->mask)
   	mask = Qt;
+ #if USE_CG_DRAWING
+       /* Mask may be in an Alpha channel in the image data */
+       if (img->data.ptr_val != NULL &&
+ 	  CGImageGetAlphaInfo(img->data.ptr_val) != kCGImageAlphaNone)
+ 	mask = Qt;
+ #endif
       }
     else
       error ("Invalid image specification");
***************
*** 1549,1555 ****
       }

   #if defined (MAC_OS) && USE_CG_DRAWING
!   if (img->data.ptr_val)
       {
         CGImageRelease (img->data.ptr_val);
         img->data.ptr_val = NULL;
--- 1555,1561 ----
       }

   #if defined (MAC_OS) && USE_CG_DRAWING
!   if (img->data.ptr_val != NULL)
       {
         CGImageRelease (img->data.ptr_val);
         img->data.ptr_val = NULL;
***************
*** 1850,1861 ****

         mask = image_spec_value (spec, QCheuristic_mask, NULL);
         if (!NILP (mask))
! 	x_build_heuristic_mask (f, img, mask);
         else
   	{
   	  int found_p;

   	  mask = image_spec_value (spec, QCmask, &found_p);

   	  if (EQ (mask, Qheuristic))
   	    x_build_heuristic_mask (f, img, Qt);
--- 1856,1883 ----

         mask = image_spec_value (spec, QCheuristic_mask, NULL);
         if (!NILP (mask))
! 	{
! #if defined (MAC_OS) && USE_CG_DRAWING
! 	  if (img->data.ptr_val != NULL)
! 	    {
! 	      CGImageRelease (img->data.ptr_val);
! 	      img->data.ptr_val = NULL;
! 	    }
! #endif
! 	  x_build_heuristic_mask (f, img, mask);
! 	}
         else
   	{
   	  int found_p;

   	  mask = image_spec_value (spec, QCmask, &found_p);
+ #if defined (MAC_OS) && USE_CG_DRAWING
+ 	  if (found_p && img->data.ptr_val != NULL)
+ 	    {
+ 	      CGImageRelease (img->data.ptr_val);
+ 	      img->data.ptr_val = NULL;
+ 	    }
+ #endif

   	  if (EQ (mask, Qheuristic))
   	    x_build_heuristic_mask (f, img, Qt);
***************
*** 2767,2773 ****
--- 2789,2800 ----
       }
     CGContextDrawImage (context, rectangle, image);
     QDEndCGContext (ximg, &context);
+
+ #if USE_CG_DRAWING
+   img->data.ptr_val = image; /* retain original data */
+ #else
     CGImageRelease (image);
+ #endif

     /* Maybe fill in the background field while we have ximg handy. */
     if (NILP (image_spec_value (img->spec, QCbackground, NULL)))