Re: svn icons in the toolbar

[David Reitter]

On 3 Sep 2007, at 08:53, address@hidden wrote:

> That said, I also wonder why converting png:s to xpm wouldnt be
> equivalent. Does the png library handle alpha channels and
> anti-aliasing to the background conveniently, which the xpm library
> presumably doesnt?

Correct.

For Aquamacs, I convert PNGs into XPMs with a pre-defined background  
color (matte), which is used in lieu of alpha blending. This works  
fine until the user changes the background color of the toolbar. A  
screenshot of the toolbar with some icons enabled is attached.

I tried using PNGs for the toolbar, and I wrote a patch to support  
that (see below, don't know if it still applies cleanly).

However, there always was a problem with the specification of  
selected / disabled states of the icons, which somehow didn't work  
correctly for PNGs at least in the Carbon port (IIRC - this is more  
than a year ago).

It would be very nice if PNGs worked, and if selected and disabled  
states were fully supported.

Alternatively, the IMHO much better solution would be to support  
toolkit toolbars, because that'll give users all the functionality of  
the toolkit (native look, best quality images, in some cases  
drag&drop / reordering). A fallback to XPM is always possible, of  
course, in non-toolkit builds.

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)))