tool-bar (Carbon port): labels under icons

tool-bar (Carbon port): labels under icons

[David Reitter]

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

Can I suggest the following patch that allows the use of labels under  
the icons as is standard on the OS?


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

	* tool-bar.el (tool-bar-local-item): Accept string for KEY
	as icon label.
	(tool-bar-setup): Use readable strings for labels.
	

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

	* macterm.c [USE_MAC_TOOLBAR]: Add Vmac_tool_bar_display_mode.
	(update_frame_tool_bar) [USE_MAC_TOOLBAR]: set display mode.




[-- Attachment #2: tool-bar-display-mode.patch --]
[-- Type: application/octet-stream, Size: 4195 bytes --]

Index: src/macterm.c
===================================================================
RCS file: /sources/emacs/emacs/src/macterm.c,v
retrieving revision 1.214.2.16
diff -c -r1.214.2.16 macterm.c
*** src/macterm.c	29 Mar 2008 00:46:51 -0000	1.214.2.16
--- src/macterm.c	5 Apr 2008 07:42:28 -0000
***************
*** 87,92 ****
--- 87,97 ----
  
  Lisp_Object Vx_toolkit_scroll_bars;
  
+ #if USE_MAC_TOOLBAR
+ /* Specify whether to display the tool bar as icons with labels. */
+ Lisp_Object Vmac_tool_bar_display_mode;
+ #endif
+ 
  /* If non-zero, the text will be rendered using Core Graphics text
     rendering which may anti-alias the text.  */
  int mac_use_core_graphics;
***************
*** 5955,5961 ****
      }
  
    if (err == noErr)
!     err = HIToolbarSetDisplayMode (toolbar, kHIToolbarDisplayModeIconOnly);
    if (err == noErr)
      {
        static const EventTypeSpec specs[] =
--- 5985,5991 ----
      }
  
    if (err == noErr)
!     err = HIToolbarSetDisplayMode (toolbar, kHIToolbarDisplayModeDefault);
    if (err == noErr)
      {
        static const EventTypeSpec specs[] =
*** 6099,6104 ****
--- 6130,6148 ----
    while (pos < old_count)
      HIToolbarRemoveItemAtIndex (toolbar, --old_count);
  
+   if (EQ (Vmac_tool_bar_display_mode, intern ("labels")))
+     {
+       HIToolbarSetDisplayMode (toolbar, kHIToolbarDisplayModeIconAndLabel);
+     }
+   else if (EQ (Vmac_tool_bar_display_mode, intern ("icons")))
+     {
+       HIToolbarSetDisplayMode (toolbar, kHIToolbarDisplayModeIconOnly);
+     }
+   else
+     {
+       HIToolbarSetDisplayMode (toolbar, kHIToolbarDisplayModeDefault);
+     } 
+   
    ShowHideWindowToolbar (FRAME_MAC_WINDOW (f), true,
  			 !win_gravity && f == mac_focus_frame (dpyinfo));
    /* Mac OS X 10.3 does not issue kEventWindowBoundsChanged events on
***************
*** 12984,12989 ****
--- 13028,13042 ----
  mouse-3 and the command-key will register for mouse-2.  */);
    Vmac_emulate_three_button_mouse = Qnil;
  
+ #if USE_MAC_TOOLBAR
+   DEFVAR_LISP ("mac-tool-bar-display-mode", &Vmac_tool_bar_display_mode,
+     doc: /* *Specify whether to display the tool bar as icons with labels.
+ The value can be `icons' (for icons only), `labels' (for icons with labels)
+ and nil, in which case the system default is assumed.
+ The default is nil.  */);
+   Vmac_tool_bar_display_mode = Qnil;
+ #endif
+ 
  #if TARGET_API_MAC_CARBON
    DEFVAR_BOOL ("mac-wheel-button-is-mouse-2", &mac_wheel_button_is_mouse_2,
      doc: /* *Non-nil if the wheel button is mouse-2 and the right click mouse-3.
*** lisp/tool-bar.el	05 Apr 2008 01:23:45 +0100	1.7.2.2
--- lisp/tool-bar.el	05 Apr 2008 01:24:23 +0100	
***************
*** 141,147 ****
        (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)
--- 141,148 ----
        (unless (image-mask-p image)
  	(setq image (append image '(:mask heuristic))))
        (define-key-after map (vector key)
! 	`(menu-item ,(if (stringp key) key (symbol-name key))
! 		    ,def :image ,image ,@props)))))
  
  ;;;###autoload
  (defun tool-bar-add-item-from-menu (command icon &optional map &rest props)
***************
*** 273,285 ****
    ;; 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
  		       :help "Pop up the Help menu"))
    )
  
--- 274,286 ----
    ;; 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"
  		       :help "Pop up the Help menu"))
    )
  

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

[Jan Djärv]

Such a feature would be nice to have globally, not just for Mac.  I disable 
labels for the Gtk+ port for the simple reason that there where no labels 
available in the current tool bar definition.  The help strings are too long.

	Jan D.


David Reitter skrev:
> Can I suggest the following patch that allows the use of labels under 
> the icons as is standard on the OS?
> 
> 
> 2008-04-05  David Reitter <david.reitter@gmail.com>
> 
>     * tool-bar.el (tool-bar-local-item): Accept string for KEY
>     as icon label.
>     (tool-bar-setup): Use readable strings for labels.
>     
> 
> 2008-04-05  David Reitter <david.reitter@gmail.com>
> 
>     * macterm.c [USE_MAC_TOOLBAR]: Add Vmac_tool_bar_display_mode.
>     (update_frame_tool_bar) [USE_MAC_TOOLBAR]: set display mode.
> 
> 
> 

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

[YAMAMOTO Mitsuharu]

>>>>> On Sat, 5 Apr 2008 08:50:01 +0100, David Reitter <dreitter@inf.ed.ac.uk> said:

> Can I suggest the following patch that allows the use of labels under  
> the icons as is standard on the OS?

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

> 	* tool-bar.el (tool-bar-local-item): Accept string for KEY
> 	as icon label.
> 	(tool-bar-setup): Use readable strings for labels.

It sets a string as an event type.  But the "Classifying Events" node
in the Emacs Lisp info says "the event type is always a symbol or a
character".

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

> 	* macterm.c [USE_MAC_TOOLBAR]: Add Vmac_tool_bar_display_mode.

Shouldn't it be a frame parameter rather than a variable?

				     YAMAMOTO Mitsuharu
				mituharu@math.s.chiba-u.ac.jp

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

[YAMAMOTO Mitsuharu]

>>>>> On Sat, 05 Apr 2008 10:10:13 +0200, Jan Djärv <jan.h.d@swipnet.se> said:

> Such a feature would be nice to have globally, not just for Mac.

Actually, I experimentally enabled such a feature while I was
developing the toolkit tool bar code for the Carbon port.  But I
removed it as I wasn't willing to provide it as a Mac-only feature.

> I disable labels for the Gtk+ port for the simple reason that there
> where no labels available in the current tool bar definition.  The
> help strings are too long.

The Carbon port uses the TOOL_BAR_ITEM_CAPTION property, mostly
derived from labels for menu items and usually shorter than the help
string, for overflowed tool bar items.

http://lists.gnu.org/archive/html/emacs-devel/2007-06/msg00433.html.

				     YAMAMOTO Mitsuharu
				mituharu@math.s.chiba-u.ac.jp

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

[David Reitter]

On 5 Apr 2008, at 09:40, YAMAMOTO Mitsuharu wrote:

> It sets a string as an event type.  But the "Classifying Events" node
> in the Emacs Lisp info says "the event type is always a symbol or a
> character".

True.  The new patch is below.  `tool-bar-add-item' and friends remain  
backwards-compatible.

>> 	* macterm.c [USE_MAC_TOOLBAR]: Add Vmac_tool_bar_display_mode.
>
> Shouldn't it be a frame parameter rather than a variable?


Either users need the labels, or they don't and want to save space.   
Can you think of a use case?

*** tool-bar.el	05 Apr 2008 01:23:45 +0100	1.7.2.2
--- tool-bar.el	05 Apr 2008 12:47:39 +0100	
***************
*** 110,156 ****
   ;;;###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)
     "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.

--- 110,165 ----
   ;;;###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)))
! 	 (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-name ".xpm")))
   	 (xpm-lo-spec (if (> (display-color-cells) 256)
   			  nil
   			(list :type 'xpm :file
!                               (concat "low-color/" icon-name  
".xpm"))))
   	 (pbm-spec (append (list :type 'pbm :file
!                                  (concat icon-name ".pbm")) colors))
   	 (xbm-spec (append (list :type 'xbm :file
!                                  (concat icon-name ".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 ,label ,def :image ,image ,@props)))))

   ;;;###autoload
   (defun tool-bar-add-item-from-menu (command icon &optional map  
&rest props)
     "Define tool bar binding for COMMAND in keymap MAP 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. LABEL defaults to the string
! defined for the menu item.  This function creates 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.

***************
*** 162,192 ****
   ;;;###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)))
--- 171,206 ----
   ;;;###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))
   	 (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-name ".xpm")))
   	 (xpm-lo-spec (if (> (display-color-cells) 256)
   			  nil
   			(list :type 'xpm :file
!                               (concat "low-color/" icon-name  
".xpm"))))
   	 (pbm-spec (append (list :type 'pbm :file
!                                  (concat icon-name ".pbm")) colors))
   	 (xbm-spec (append (list :type 'xbm :file
!                                  (concat icon-name ".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)))
***************
*** 215,221 ****
         (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)))
--- 229,236 ----
         (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 (cdr 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.
--- 238,244 ----
   	      ;; 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 defn)) ,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
--- 247,262 ----
     ;; 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
--- 288,297 ----
     ;; 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

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

[YAMAMOTO Mitsuharu]

>>>>> On Sat, 5 Apr 2008 12:48:20 +0100, David Reitter <dreitter@inf.ed.ac.uk> said:

>>> * macterm.c [USE_MAC_TOOLBAR]: Add Vmac_tool_bar_display_mode.
>> 
>> Shouldn't it be a frame parameter rather than a variable?

> Either users need the labels, or they don't and want to save space.
> Can you think of a use case?

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.

				     YAMAMOTO Mitsuharu
				mituharu@math.s.chiba-u.ac.jp

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

[David Reitter]

[-- 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 --]

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

[Stefan Monnier]

> Can I suggest the following patch that allows the use of labels under the
> icons as is standard on the OS?

I think the feature is a good one, but it needs to be supported under
GNU/Linux as well.  The reason why we don't have it is because the
non-toolkit toolbar does not support it (i.e. the code for it was simply
not written), but now that we use Gtk it should not be difficult.

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

> 	* tool-bar.el (tool-bar-local-item): Accept string for KEY
> 	as icon label.

We should add a :caption property to menu-items instead.  Using strings
for keys may work, but it's a hack.


        Stefan

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

[David Reitter]

On 5 Apr 2008, at 16:40, Stefan Monnier wrote:
>>
>> 	* tool-bar.el (tool-bar-local-item): Accept string for KEY
>> 	as icon label.
>
> We should add a :caption property to menu-items instead.  Using  
> strings
> for keys may work, but it's a hack.

In the last patch that I posted here, I've changed that now to use the  
`item-name' element in an menu-item structure of the form
(menu-item item-name real-binding . item-property-list)
which is usually a string.  tool-bar.el now as a backwards-compatible  
interface to set the labels.  One can use a :caption property if using  
the menu item string is inappropriate for some reason.
This works nicely now in the Carbon (the new native tool bar code by  
Yamamoto Mitsuharu is really nice and allows for high-quality tool bar  
interactions, especially when PNGs are used for icons).  Someone who  
understands GTK could probably try out switching labels on there, too.

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

[Stefan Monnier]

> In the last patch that I posted here, I've changed that now to use the
> item-name' element in an menu-item structure of the form
> (menu-item item-name real-binding . item-property-list)
> which is usually a string.

Oh, yes, the item-name is a very good choice.  I forgot that it was
currently ignored.  No need for :caption then.


        Stefan