Re: tool-bar (Carbon port): labels under icons

[David Reitter <dreitter@inf.ed.ac.uk>]

[-- Attachment #1: Type: text/plain, Size: 1295 bytes --]

On 5 Apr 2008, at 13:33, YAMAMOTO Mitsuharu wrote:
>
> I thought users may want to see the change immediately with
> Command-click on the toolbar button, for example.  Also it looks more
> consistent with how to control the position/width of scroll bars and
> fringes.


For the latter I see some use case, but not for the icon labels.  It  
could be done, but I won't get around to it.

I'm attaching the patch to tool-bar.el which will load PNGs if present  
and also display the label if the underlying C code has this enabled.
(This is a combination of the earlier patches because they didn't  
apply separately.) It also fixes a bug in my previous patch affecting  
tool-bar-local-item-from-menu.

It would help if someone could test this on a different system.  It  
shouldn't actually change anything unless the PNGs or the labels are  
supported.

I'm unsure about this bit:

	  (define-key-after in-map (vector key)
	    (let ((rest (cdr defn)))
	      ;; If the rest of the definition starts
	      ;; with a list of menu cache info, get rid of that.
	      (if (and (consp rest) (consp (car rest)))
		  (setq rest (cdr rest)))
	      (append `(menu-item ,(or label (car (cdr rest))) ,(cdr rest))
		      (list :image image) props))))))))

When does menu cache info show up there?





[-- Attachment #2: toolbar-png.patch --]
[-- Type: application/octet-stream, Size: 16676 bytes --]

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 15:05:11 -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;
***************
*** 1835,1840 ****
--- 1841,1848 ----
     {
       Lisp_Object conversion, spec;
       Lisp_Object mask;
+       int release = 0;
+       int found_p = 0;

       spec = img->spec;

***************
*** 1850,1862 ****

       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);
 	  else if (CONSP (mask)
--- 1858,1872 ----

       mask = image_spec_value (spec, QCheuristic_mask, NULL);
       if (!NILP (mask))
! 	{
! 	  release = 1;
! 	  x_build_heuristic_mask (f, img, mask);
! 	}
       else
 	{
 	  mask = image_spec_value (spec, QCmask, &found_p);
! 	  if (found_p)
! 	    release = 1;
 	  if (EQ (mask, Qheuristic))
 	    x_build_heuristic_mask (f, img, Qt);
 	  else if (CONSP (mask)
***************
*** 1876,1882 ****


       /* Should we apply an image transformation algorithm?  */
!       conversion = image_spec_value (spec, QCconversion, NULL);
       if (EQ (conversion, Qdisabled))
 	x_disable_image (f, img);
       else if (EQ (conversion, Qlaplace))
--- 1886,1895 ----


       /* Should we apply an image transformation algorithm?  */
!       found_p = 0;
!       conversion = image_spec_value (spec, QCconversion, &found_p);
!       if (found_p)
! 	release = 1;
       if (EQ (conversion, Qdisabled))
 	x_disable_image (f, img);
       else if (EQ (conversion, Qlaplace))
***************
*** 1893,1898 ****
--- 1906,1918 ----
 			      Fplist_get (tem, QCmatrix),
 			      Fplist_get (tem, QCcolor_adjustment));
 	}
+ #if defined (MAC_OS) && USE_CG_DRAWING
+       if (release && img->data.ptr_val != NULL)
+ 	{
+ 	  CGImageRelease (img->data.ptr_val);
+ 	  img->data.ptr_val = NULL;
+ 	}
+ #endif
     }
 }

***************
*** 2767,2773 ****
--- 2787,2798 ----
     }
   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)))
*** tool-bar.el	05 Apr 2008 01:23:45 +0100	1.7.2.2
--- tool-bar.el	05 Apr 2008 14:30:07 +0100	
***************
*** 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.
***************
*** 110,147 ****
  ;;;###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
! for the fake function key in the menu keymap.  Remaining arguments
! 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))))
        (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)
--- 181,208 ----
  ;;;###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, or is structure of the form (IMG . LABEL),
! with the image name IMG, and a string with the label of the icon
! displayed in the tool-bar as LABEL. LABEL defaults to the symbol
! name of KEY.  DEF is the key definition and KEY is a symbol for
! the fake function key in the menu keymap Remaining arguments
! 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 or IMG 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* ((icon-name (if (consp icon) (car icon) icon))
! 	 (label (if (consp icon) (cdr icon) (symbol-name key)))
! 	 (is (tool-bar-get-image-spec icon-name))
! 	 (image (car is))
! 	 (images (cdr is))) 
      (when (and (display-images-p) image)
        (define-key-after map (vector key)
! 	`(menu-item ,label 
! 		    ,def :image ,images ,@props)))))
  
  ;;;###autoload
  (defun tool-bar-add-item-from-menu (command icon &optional map &rest props)
***************
*** 162,196 ****
  ;;;###autoload
  (defun tool-bar-local-item-from-menu (command icon in-map &optional from-map &rest props)
    "Define local tool bar binding for COMMAND using the given ICON.
! This makes a binding for COMMAND in IN-MAP, copying its binding from
! the menu bar in FROM-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.
  
  FROM-MAP must contain appropriate binding for `[menu-bar]' which
  holds a keymap."
    (unless from-map
      (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
--- 223,248 ----
  ;;;###autoload
  (defun tool-bar-local-item-from-menu (command icon in-map &optional from-map &rest props)
    "Define local tool bar binding for COMMAND using the given ICON.
! ICON names the image, or is structure of the form (IMG . LABEL),
! with the image name IMG, and a string with the label of the icon
! displyed in the tool-bar as LABEL. This function creates a
! binding for COMMAND in IN-MAP, copying its binding from the menu
! bar in FROM-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.
  
  FROM-MAP must contain appropriate binding for `[menu-bar]' which
  holds a keymap."
    (unless from-map
      (setq from-map global-map))
!   (let* ((icon-name (if (consp icon) (car icon) icon))
! 	 (label (if (consp icon) (cdr icon)))
! 	 (menu-bar-map (lookup-key from-map [menu-bar]))
  	 (keys (where-is-internal command menu-bar-map))
! 	 (is (tool-bar-get-image-spec icon-name))
! 	 (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)))
--- 262,272 ----
  			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 `(menu-item ,(or label (car (cddr defn)))) (cdddr defn) 
! 		      (list :image image) props))
  	  (setq defn (cdr defn))
  	  (define-key-after in-map (vector key)
  	    (let ((rest (cdr defn)))
***************
*** 223,229 ****
  	      ;; with a list of menu cache info, get rid of that.
  	      (if (and (consp rest) (consp (car rest)))
  		  (setq rest (cdr rest)))
! 	      (append `(menu-item ,(car defn) ,rest)
  		      (list :image image) props))))))))
  
  ;;; Set up some global items.  Additions/deletions up for grabs.
--- 274,280 ----
  	      ;; with a list of menu cache info, get rid of that.
  	      (if (and (consp rest) (consp (car rest)))
  		  (setq rest (cdr rest)))
! 	      (append `(menu-item ,(or label (car (cdr rest))) ,(cdr rest))
  		      (list :image image) props))))))))
  
  ;;; Set up some global items.  Additions/deletions up for grabs.
***************
*** 232,247 ****
    ;; People say it's bad to have EXIT on the tool bar, since users
    ;; might inadvertently click that button.
    ;;(tool-bar-add-item-from-menu 'save-buffers-kill-emacs "exit")
!   (tool-bar-add-item-from-menu 'find-file "new")
!   (tool-bar-add-item-from-menu 'menu-find-file-existing "open")
!   (tool-bar-add-item-from-menu 'dired "diropen")
    (tool-bar-add-item-from-menu 'kill-this-buffer "close")
!   (tool-bar-add-item-from-menu 'save-buffer "save" nil
  			       :visible '(or buffer-file-name
  					     (not (eq 'special
  						      (get major-mode
  							   'mode-class)))))
!   (tool-bar-add-item-from-menu 'write-file "saveas" nil
  			       :visible '(or buffer-file-name
  					     (not (eq 'special
  						      (get major-mode
--- 283,298 ----
    ;; People say it's bad to have EXIT on the tool bar, since users
    ;; might inadvertently click that button.
    ;;(tool-bar-add-item-from-menu 'save-buffers-kill-emacs "exit")
!   (tool-bar-add-item-from-menu 'find-file '("new" . "New"))
!   (tool-bar-add-item-from-menu 'menu-find-file-existing '("open" . "Open"))
!   (tool-bar-add-item-from-menu 'dired '("diropen" . "Directory"))
    (tool-bar-add-item-from-menu 'kill-this-buffer "close")
!   (tool-bar-add-item-from-menu 'save-buffer '("save" . "Save") nil
  			       :visible '(or buffer-file-name
  					     (not (eq 'special
  						      (get major-mode
  							   'mode-class)))))
!   (tool-bar-add-item-from-menu 'write-file '("saveas" . "Save As") nil
  			       :visible '(or buffer-file-name
  					     (not (eq 'special
  						      (get major-mode
***************
*** 273,282 ****
    ;; we must explicitly operate on the default value.
  
    (let ((tool-bar-map (default-value 'tool-bar-map)))
!     (tool-bar-add-item "preferences" 'customize 'customize
  		       :help "Edit preferences (customize)")
  
!     (tool-bar-add-item "help" (lambda ()
  				(interactive)
  				(popup-menu menu-bar-help-menu))
  		       'help
--- 324,333 ----
    ;; we must explicitly operate on the default value.
  
    (let ((tool-bar-map (default-value 'tool-bar-map)))
!     (tool-bar-add-item '("preferences" . "Customize") 'customize 'customize
  		       :help "Edit preferences (customize)")
  
!     (tool-bar-add-item '("help" . "Help") (lambda ()
  				(interactive)
  				(popup-menu menu-bar-help-menu))
  		       'help

[-- Attachment #3: Type: text/plain, Size: 1 bytes --]