1;;; tool-bar.el --- setting up the tool bar 2;; 3;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 4;; 2005, 2006, 2007 Free Software Foundation, Inc. 5;; 6;; Author: Dave Love <fx@gnu.org> 7;; Keywords: mouse frames 8 9;; This file is part of GNU Emacs. 10 11;; GNU Emacs is free software; you can redistribute it and/or modify 12;; it under the terms of the GNU General Public License as published by 13;; the Free Software Foundation; either version 2, or (at your option) 14;; any later version. 15 16;; GNU Emacs is distributed in the hope that it will be useful, 17;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19;; GNU General Public License for more details. 20 21;; You should have received a copy of the GNU General Public License 22;; along with GNU Emacs; see the file COPYING. If not, write to the 23;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 24;; Boston, MA 02110-1301, USA. 25 26;;; Commentary: 27 28;; Provides `tool-bar-mode' to control display of the tool-bar and 29;; bindings for the global tool bar with convenience functions 30;; `tool-bar-add-item' and `tool-bar-add-item-from-menu'. 31 32;; The normal global binding for [tool-bar] (below) uses the value of 33;; `tool-bar-map' as the actual keymap to define the tool bar. Modes 34;; may either bind items under the [tool-bar] prefix key of the local 35;; map to add to the global bar or may set `tool-bar-map' 36;; buffer-locally to override it. (Some items are removed from the 37;; global bar in modes which have `special' as their `mode-class' 38;; property.) 39 40;; Todo: Somehow make tool bars easily customizable by the naive? 41 42;;; Code: 43 44;; The autoload cookie doesn't work when preloading. 45;; Deleting it means invoking this command won't work 46;; when you are on a tty. I hope that won't cause too much trouble -- rms. 47(define-minor-mode tool-bar-mode 48 "Toggle use of the tool bar. 49With numeric ARG, display the tool bar if and only if ARG is positive. 50 51See `tool-bar-add-item' and `tool-bar-add-item-from-menu' for 52conveniently adding tool bar items." 53 :init-value nil 54 :global t 55 :group 'mouse 56 :group 'frames 57 (and (display-images-p) 58 (let ((lines (if tool-bar-mode 1 0))) 59 ;; Alter existing frames... 60 (mapc (lambda (frame) 61 (modify-frame-parameters frame 62 (list (cons 'tool-bar-lines lines)))) 63 (frame-list)) 64 ;; ...and future ones. 65 (let ((elt (assq 'tool-bar-lines default-frame-alist))) 66 (if elt 67 (setcdr elt lines) 68 (add-to-list 'default-frame-alist (cons 'tool-bar-lines lines))))) 69 (if (and tool-bar-mode 70 (display-graphic-p) 71 (= 1 (length (default-value 'tool-bar-map)))) ; not yet setup 72 (tool-bar-setup)))) 73 74;;;###autoload 75;; We want to pretend the toolbar by standard is on, as this will make 76;; customize consider disabling the toolbar a customization, and save 77;; that. We could do this for real by setting :init-value above, but 78;; that would turn on the toolbar in MS Windows where it is currently 79;; useless, and it would overwrite disabling the tool bar from X 80;; resources. If anyone want to implement this in a cleaner way, 81;; please do so. 82;; -- Per Abrahamsen <abraham@dina.kvl.dk> 2002-02-21. 83(put 'tool-bar-mode 'standard-value '(t)) 84 85(defvar tool-bar-map (make-sparse-keymap) 86 "Keymap for the tool bar. 87Define this locally to override the global tool bar.") 88 89(global-set-key [tool-bar] 90 '(menu-item "tool bar" ignore 91 :filter (lambda (ignore) tool-bar-map))) 92 93;;;###autoload 94(defun tool-bar-add-item (icon def key &rest props) 95 "Add an item to the tool bar. 96ICON names the image, DEF is the key definition and KEY is a symbol 97for the fake function key in the menu keymap. Remaining arguments 98PROPS are additional items to add to the menu item specification. See 99Info node `(elisp)Tool Bar'. Items are added from left to right. 100 101ICON is the base name of a file containing the image to use. The 102function will first try to use low-color/ICON.xpm if display-color-cells 103is less or equal to 256, then ICON.xpm, then ICON.pbm, and finally 104ICON.xbm, using `find-image'. 105 106Use this function only to make bindings in the global value of `tool-bar-map'. 107To define items in any other map, use `tool-bar-local-item'." 108 (apply 'tool-bar-local-item icon def key tool-bar-map props)) 109 110;;;###autoload 111(defun tool-bar-local-item (icon def key map &rest props) 112 "Add an item to the tool bar in map MAP. 113ICON names the image, DEF is the key definition and KEY is a symbol 114for the fake function key in the menu keymap. Remaining arguments 115PROPS are additional items to add to the menu item specification. See 116Info node `(elisp)Tool Bar'. Items are added from left to right. 117 118ICON is the base name of a file containing the image to use. The 119function will first try to use low-color/ICON.xpm if display-color-cells 120is less or equal to 256, then ICON.xpm, then ICON.pbm, and finally 121ICON.xbm, using `find-image'." 122 (let* ((fg (face-attribute 'tool-bar :foreground)) 123 (bg (face-attribute 'tool-bar :background)) 124 (colors (nconc (if (eq fg 'unspecified) nil (list :foreground fg)) 125 (if (eq bg 'unspecified) nil (list :background bg)))) 126 (xpm-spec (list :type 'xpm :file (concat icon ".xpm"))) 127 (xpm-lo-spec (if (> (display-color-cells) 256) 128 nil 129 (list :type 'xpm :file 130 (concat "low-color/" icon ".xpm")))) 131 (pbm-spec (append (list :type 'pbm :file 132 (concat icon ".pbm")) colors)) 133 (xbm-spec (append (list :type 'xbm :file 134 (concat icon ".xbm")) colors)) 135 (image (find-image 136 (if (display-color-p) 137 (list xpm-lo-spec xpm-spec pbm-spec xbm-spec) 138 (list pbm-spec xbm-spec xpm-lo-spec xpm-spec))))) 139 140 (when (and (display-images-p) image) 141 (unless (image-mask-p image) 142 (setq image (append image '(:mask heuristic)))) 143 (define-key-after map (vector key) 144 `(menu-item ,(symbol-name key) ,def :image ,image ,@props))))) 145 146;;;###autoload 147(defun tool-bar-add-item-from-menu (command icon &optional map &rest props) 148 "Define tool bar binding for COMMAND in keymap MAP using the given ICON. 149This makes a binding for COMMAND in `tool-bar-map', copying its 150binding from the menu bar in MAP (which defaults to `global-map'), but 151modifies the binding by adding an image specification for ICON. It 152finds ICON just like `tool-bar-add-item'. PROPS are additional 153properties to add to the binding. 154 155MAP must contain appropriate binding for `[menu-bar]' which holds a keymap. 156 157Use this function only to make bindings in the global value of `tool-bar-map'. 158To define items in any other map, use `tool-bar-local-item-from-menu'." 159 (apply 'tool-bar-local-item-from-menu command icon 160 (default-value 'tool-bar-map) map props)) 161 162;;;###autoload 163(defun tool-bar-local-item-from-menu (command icon in-map &optional from-map &rest props) 164 "Define local tool bar binding for COMMAND using the given ICON. 165This makes a binding for COMMAND in IN-MAP, copying its binding from 166the menu bar in FROM-MAP (which defaults to `global-map'), but 167modifies the binding by adding an image specification for ICON. It 168finds ICON just like `tool-bar-add-item'. PROPS are additional 169properties to add to the binding. 170 171FROM-MAP must contain appropriate binding for `[menu-bar]' which 172holds a keymap." 173 (unless from-map 174 (setq from-map global-map)) 175 (let* ((menu-bar-map (lookup-key from-map [menu-bar])) 176 (keys (where-is-internal command menu-bar-map)) 177 (fg (face-attribute 'tool-bar :foreground)) 178 (bg (face-attribute 'tool-bar :background)) 179 (colors (nconc (if (eq fg 'unspecified) nil (list :foreground fg)) 180 (if (eq bg 'unspecified) nil (list :background bg)))) 181 (xpm-spec (list :type 'xpm :file (concat icon ".xpm"))) 182 (xpm-lo-spec (if (> (display-color-cells) 256) 183 nil 184 (list :type 'xpm :file 185 (concat "low-color/" icon ".xpm")))) 186 (pbm-spec (append (list :type 'pbm :file 187 (concat icon ".pbm")) colors)) 188 (xbm-spec (append (list :type 'xbm :file 189 (concat icon ".xbm")) colors)) 190 (spec (if (display-color-p) 191 (list xpm-lo-spec xpm-spec pbm-spec xbm-spec) 192 (list pbm-spec xbm-spec xpm-lo-spec xpm-spec))) 193 (image (find-image spec)) 194 submap key) 195 (when (and (display-images-p) image) 196 ;; We'll pick up the last valid entry in the list of keys if 197 ;; there's more than one. 198 (dolist (k keys) 199 ;; We're looking for a binding of the command in a submap of 200 ;; the menu bar map, so the key sequence must be two or more 201 ;; long. 202 (if (and (vectorp k) 203 (> (length k) 1)) 204 (let ((m (lookup-key menu-bar-map (substring k 0 -1))) 205 ;; Last element in the bound key sequence: 206 (kk (aref k (1- (length k))))) 207 (if (and (keymapp m) 208 (symbolp kk)) 209 (setq submap m 210 key kk))))) 211 (when (and (symbolp submap) (boundp submap)) 212 (setq submap (eval submap))) 213 (unless (image-mask-p image) 214 (setq image (append image '(:mask heuristic)))) 215 (let ((defn (assq key (cdr submap)))) 216 (if (eq (cadr defn) 'menu-item) 217 (define-key-after in-map (vector key) 218 (append (cdr defn) (list :image image) props)) 219 (setq defn (cdr defn)) 220 (define-key-after in-map (vector key) 221 (let ((rest (cdr defn))) 222 ;; If the rest of the definition starts 223 ;; with a list of menu cache info, get rid of that. 224 (if (and (consp rest) (consp (car rest))) 225 (setq rest (cdr rest))) 226 (append `(menu-item ,(car defn) ,rest) 227 (list :image image) props)))))))) 228 229;;; Set up some global items. Additions/deletions up for grabs. 230 231(defun tool-bar-setup () 232 ;; People say it's bad to have EXIT on the tool bar, since users 233 ;; might inadvertently click that button. 234 ;;(tool-bar-add-item-from-menu 'save-buffers-kill-emacs "exit") 235 (tool-bar-add-item-from-menu 'find-file "new") 236 (tool-bar-add-item-from-menu 'menu-find-file-existing "open") 237 (tool-bar-add-item-from-menu 'dired "diropen") 238 (tool-bar-add-item-from-menu 'kill-this-buffer "close") 239 (tool-bar-add-item-from-menu 'save-buffer "save" nil 240 :visible '(or buffer-file-name 241 (not (eq 'special 242 (get major-mode 243 'mode-class))))) 244 (tool-bar-add-item-from-menu 'write-file "saveas" nil 245 :visible '(or buffer-file-name 246 (not (eq 'special 247 (get major-mode 248 'mode-class))))) 249 (tool-bar-add-item-from-menu 'undo "undo" nil 250 :visible '(not (eq 'special (get major-mode 251 'mode-class)))) 252 (tool-bar-add-item-from-menu (lookup-key menu-bar-edit-menu [cut]) 253 "cut" nil 254 :visible '(not (eq 'special (get major-mode 255 'mode-class)))) 256 (tool-bar-add-item-from-menu (lookup-key menu-bar-edit-menu [copy]) 257 "copy") 258 (tool-bar-add-item-from-menu (lookup-key menu-bar-edit-menu [paste]) 259 "paste" nil 260 :visible '(not (eq 'special (get major-mode 261 'mode-class)))) 262 (tool-bar-add-item-from-menu 'nonincremental-search-forward "search") 263 ;;(tool-bar-add-item-from-menu 'ispell-buffer "spell") 264 265 ;; There's no icon appropriate for News and we need a command rather 266 ;; than a lambda for Read Mail. 267 ;;(tool-bar-add-item-from-menu 'compose-mail "mail/compose") 268 269 (tool-bar-add-item-from-menu 'print-buffer "print") 270 271 ;; tool-bar-add-item-from-menu itself operates on 272 ;; (default-value 'tool-bar-map), but when we don't use that function, 273 ;; we must explicitly operate on the default value. 274 275 (let ((tool-bar-map (default-value 'tool-bar-map))) 276 (tool-bar-add-item "preferences" 'customize 'customize 277 :help "Edit preferences (customize)") 278 279 (tool-bar-add-item "help" (lambda () 280 (interactive) 281 (popup-menu menu-bar-help-menu)) 282 'help 283 :help "Pop up the Help menu")) 284 ) 285 286(provide 'tool-bar) 287 288;;; arch-tag: 15f30f0a-d0d7-4d50-bbb7-f48fd0c8582f 289;;; tool-bar.el ends here 290