From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: David Reitter Newsgroups: gmane.emacs.devel Subject: Re: tool-bar (Carbon port): labels under icons Date: Sat, 5 Apr 2008 14:36:23 +0100 Message-ID: <6DB08B92-6D07-4AA8-AE70-8F9035AEF280@inf.ed.ac.uk> References: <1B41BDB3-EFEC-4CFC-8006-2233F8D90024@inf.ed.ac.uk> <488FE8E4-8EF1-4025-91BB-CDAD87B365B2@inf.ed.ac.uk> NNTP-Posting-Host: lo.gmane.org Mime-Version: 1.0 (Apple Message framework v919.2) Content-Type: multipart/mixed; boundary=Apple-Mail-70--685367013 X-Trace: ger.gmane.org 1207402628 9757 80.91.229.12 (5 Apr 2008 13:37:08 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Sat, 5 Apr 2008 13:37:08 +0000 (UTC) To: emacs- devel Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Sat Apr 05 15:37:39 2008 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([199.232.76.165]) by lo.gmane.org with esmtp (Exim 4.50) id 1Ji8aL-0006dO-2c for ged-emacs-devel@m.gmane.org; Sat, 05 Apr 2008 15:37:33 +0200 Original-Received: from localhost ([127.0.0.1] helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1Ji8Zi-0007O0-2L for ged-emacs-devel@m.gmane.org; Sat, 05 Apr 2008 09:36:54 -0400 Original-Received: from mailman by lists.gnu.org with tmda-scanned (Exim 4.43) id 1Ji8ZK-0007AI-23 for emacs-devel@gnu.org; Sat, 05 Apr 2008 09:36:30 -0400 Original-Received: from exim by lists.gnu.org with spam-scanned (Exim 4.43) id 1Ji8ZJ-00079f-D2 for emacs-devel@gnu.org; Sat, 05 Apr 2008 09:36:29 -0400 Original-Received: from [199.232.76.173] (helo=monty-python.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1Ji8ZJ-00079Z-7Q for emacs-devel@gnu.org; Sat, 05 Apr 2008 09:36:29 -0400 Original-Received: from py-out-1112.google.com ([64.233.166.181]) by monty-python.gnu.org with esmtp (Exim 4.60) (envelope-from ) id 1Ji8ZI-0004Bi-FF for emacs-devel@gnu.org; Sat, 05 Apr 2008 09:36:29 -0400 Original-Received: by py-out-1112.google.com with SMTP id u52so612007pyb.1 for ; Sat, 05 Apr 2008 06:36:27 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=gamma; h=domainkey-signature:received:received:message-id:from:to:in-reply-to:content-type:mime-version:subject:date:references:x-mailer:sender; bh=2Y09HEh/vvKeWDDxb3AcC+kC/aSkUl/4SoVq3SOHTjA=; b=c1FK21MGzDbmKrsAH+pwe2jHLMs6AuSeJQu4hqvqo+V3MqaTpkLiYoVpUz89ptAFC9/oCNSYFUZFv5glZg8znZvbemQHi1D3KHnjl/xdjU3abntKMK/J11TsYWTmzKZqeprEaCF9pc6+0Ipt9muVkKqRf8tNFMb0modl+lzUWKI= DomainKey-Signature: a=rsa-sha1; c=nofws; d=gmail.com; s=gamma; h=message-id:from:to:in-reply-to:content-type:mime-version:subject:date:references:x-mailer:sender; b=yG/Mqtvv4LScXEWhkIHnQCOptZkB39d+2QcCA6HPVJbTYdQXrNyKLaSBg33yIZiU0N7tnSZWmwid1l7ZoECPMfQgxRXl0pqCuXHvDH6XW3lm+sdHzeze/e4DOD1g71+KLkLOzTQoeyKxMf/Bz8N9PNTPbIMQWDIio8uRVsXJpco= Original-Received: by 10.64.27.13 with SMTP id a13mr4298172qba.78.1207402587495; Sat, 05 Apr 2008 06:36:27 -0700 (PDT) Original-Received: from scarlett.lan ( [89.241.128.168]) by mx.google.com with ESMTPS id d25sm10022578nfh.33.2008.04.05.06.36.24 (version=TLSv1/SSLv3 cipher=OTHER); Sat, 05 Apr 2008 06:36:25 -0700 (PDT) In-Reply-To: X-Mailer: Apple Mail (2.919.2) X-detected-kernel: by monty-python.gnu.org: Linux 2.6 (newer, 2) X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.5 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:94406 Archived-At: --Apple-Mail-70--685367013 Content-Type: text/plain; charset=US-ASCII; format=flowed; delsp=yes Content-Transfer-Encoding: 7bit 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? --Apple-Mail-70--685367013 Content-Disposition: attachment; filename=toolbar-png.patch Content-Type: application/octet-stream; x-mac-creator=454D4178; x-unix-mode=0644; name="toolbar-png.patch" Content-Transfer-Encoding: 7bit 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 --Apple-Mail-70--685367013 Content-Type: text/plain; charset=US-ASCII; format=flowed Content-Transfer-Encoding: 7bit --Apple-Mail-70--685367013--