X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/f49d1f52b2e368ef67dcfececd426de958548f4e..dcefd2bbc0e404c26f1e5b68c910404355f488fb:/lisp/tool-bar.el diff --git a/lisp/tool-bar.el b/lisp/tool-bar.el index a3292c4204..f0dfee25b4 100644 --- a/lisp/tool-bar.el +++ b/lisp/tool-bar.el @@ -1,7 +1,6 @@ ;;; tool-bar.el --- setting up the tool bar -;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, -;; 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 2000-2016 Free Software Foundation, Inc. ;; Author: Dave Love ;; Keywords: mouse frames @@ -44,8 +43,10 @@ ;; Deleting it means invoking this command won't work ;; when you are on a tty. I hope that won't cause too much trouble -- rms. (define-minor-mode tool-bar-mode - "Toggle use of the tool bar. -With numeric ARG, display the tool bar if and only if ARG is positive. + "Toggle the tool bar in all graphical frames (Tool Bar mode). +With a prefix argument ARG, enable Tool Bar mode if ARG is +positive, and disable it otherwise. If called from Lisp, enable +Tool Bar mode if ARG is omitted or nil. See `tool-bar-add-item' and `tool-bar-add-item-from-menu' for conveniently adding tool bar items." @@ -89,7 +90,7 @@ Define this locally to override the global tool bar.") (defconst tool-bar-keymap-cache (make-hash-table :weakness t :test 'equal)) -(defun tool-bar-make-keymap (&optional ignore) +(defun tool-bar-make-keymap (&optional _ignore) "Generate an actual keymap from `tool-bar-map'. Its main job is to figure out which images to use based on the display's color capability and based on the available image libraries." @@ -139,6 +140,26 @@ Use this function only to make bindings in the global value of `tool-bar-map'. To define items in any other map, use `tool-bar-local-item'." (apply 'tool-bar-local-item icon def key tool-bar-map props)) +(defun tool-bar--image-expression (icon) + "Return an expression that evaluates to an image spec for 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 (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))) + `(find-image (cond ((not (display-color-p)) + ',(list pbm-spec xbm-spec xpm-lo-spec xpm-spec)) + ((< (display-color-cells) 256) + ',(list xpm-lo-spec xpm-spec pbm-spec xbm-spec)) + (t + ',(list xpm-spec pbm-spec xbm-spec)))))) + ;;;###autoload (defun tool-bar-local-item (icon def key map &rest props) "Add an item to the tool bar in map MAP. @@ -151,26 +172,10 @@ 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 (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-exp `(find-image - (cond ((not (display-color-p)) - ',(list pbm-spec xbm-spec xpm-lo-spec xpm-spec)) - ((< (display-color-cells) 256) - ',(list xpm-lo-spec xpm-spec pbm-spec xbm-spec)) - (t - ',(list xpm-spec pbm-spec xbm-spec)))))) + (let* ((image-exp (tool-bar--image-expression icon))) (define-key-after map (vector key) - `(menu-item ,(symbol-name key) ,def :image ,image-exp ,@props)))) + `(menu-item ,(symbol-name key) ,def :image ,image-exp ,@props)) + (force-mode-line-update))) ;;;###autoload (defun tool-bar-add-item-from-menu (command icon &optional map &rest props) @@ -203,24 +208,7 @@ holds a keymap." (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 (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-exp `(find-image - (cond ((not (display-color-p)) - ',(list pbm-spec xbm-spec xpm-lo-spec xpm-spec)) - ((< (display-color-cells) 256) - ',(list xpm-lo-spec xpm-spec pbm-spec xbm-spec)) - (t - ',(list xpm-spec pbm-spec xbm-spec))))) + (image-exp (tool-bar--image-expression icon)) submap key) ;; We'll pick up the last valid entry in the list of keys if ;; there's more than one. @@ -252,57 +240,48 @@ holds a keymap." (if (and (consp rest) (consp (car rest))) (setq rest (cdr rest))) (append `(menu-item ,(car defn) ,rest) - (list :image image-exp) props))))))) + (list :image image-exp) props)))) + (force-mode-line-update)))) ;;; Set up some global items. Additions/deletions up for grabs. (defun tool-bar-setup () - ;; 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") + (setq tool-bar-separator-image-expression + (tool-bar--image-expression "separator")) (tool-bar-add-item-from-menu 'find-file "new" nil :label "New File" :vert-only t) (tool-bar-add-item-from-menu 'menu-find-file-existing "open" nil - :vert-only t) + :label "Open" :vert-only t) (tool-bar-add-item-from-menu 'dired "diropen" nil :vert-only t) (tool-bar-add-item-from-menu 'kill-this-buffer "close" nil :vert-only t) - (tool-bar-add-item-from-menu 'save-buffer "save" nil :vert-only t - :visible '(or buffer-file-name - (not (eq 'special - (get major-mode - 'mode-class))))) - (tool-bar-add-item-from-menu 'undo "undo" nil :vert-only t - :visible '(not (eq 'special (get major-mode - 'mode-class)))) + (tool-bar-add-item-from-menu 'save-buffer "save" nil + :label "Save") + (define-key-after (default-value 'tool-bar-map) [separator-1] menu-bar-separator) + (tool-bar-add-item-from-menu 'undo "undo" nil) + (define-key-after (default-value 'tool-bar-map) [separator-2] menu-bar-separator) (tool-bar-add-item-from-menu (lookup-key menu-bar-edit-menu [cut]) - "cut" nil :vert-only t - :visible '(not (eq 'special (get major-mode - 'mode-class)))) + "cut" nil :vert-only t) (tool-bar-add-item-from-menu (lookup-key menu-bar-edit-menu [copy]) "copy" nil :vert-only t) (tool-bar-add-item-from-menu (lookup-key menu-bar-edit-menu [paste]) - "paste" nil :vert-only t - :visible '(not (eq 'special (get major-mode - 'mode-class)))) - (tool-bar-add-item-from-menu 'nonincremental-search-forward "search" - nil :label "Search") + "paste" nil :vert-only t) + (define-key-after (default-value 'tool-bar-map) [separator-3] menu-bar-separator) + (tool-bar-add-item-from-menu 'isearch-forward "search" + nil :label "Search" :vert-only t) ;;(tool-bar-add-item-from-menu 'ispell-buffer "spell") ;; There's no icon appropriate for News and we need a command rather ;; than a lambda for Read Mail. ;;(tool-bar-add-item-from-menu 'compose-mail "mail/compose") - - ;; tool-bar-add-item-from-menu itself operates on - ;; (default-value 'tool-bar-map), but when we don't use that function, - ;; we must explicitly operate on the default value. - - (let ((tool-bar-map (default-value 'tool-bar-map))) - (tool-bar-add-item "help" (lambda () - (interactive) - (popup-menu menu-bar-help-menu)) - 'help - :help "Pop up the Help menu"))) + ;; Help button on a tool bar is rather non-standard... + ;; (let ((tool-bar-map (default-value 'tool-bar-map))) + ;; (tool-bar-add-item "help" (lambda () + ;; (interactive) + ;; (popup-menu menu-bar-help-menu)) + ;; 'help + ;; :help "Pop up the Help menu")) +) (if (featurep 'move-toolbar) (defcustom tool-bar-position 'top @@ -310,6 +289,7 @@ holds a keymap." Possible values are `top' (tool bar on top), `bottom' (tool bar at bottom), `left' (tool bar on left) and `right' (tool bar on right). Customize `tool-bar-mode' if you want to show or hide the tool bar." + :version "24.1" :type '(choice (const top) (const bottom) (const left)