1 ;;; tool-bar.el --- setting up the tool bar
3 ;; Copyright (C) 2000, 2001, 2002 Free Software Foundation, Inc.
5 ;; Author: Dave Love <fx@gnu.org>
6 ;; Keywords: mouse frames
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
27 ;; Provides `tool-bar-mode' to control display of the tool -bar and
28 ;; bindings for the global tool bar with convenience functions
29 ;; `tool-bar-add-item' and `tool-bar-add-item-from-menu'.
31 ;; The normal global binding for [tool-bar] (below) uses the value of
32 ;; `tool-bar-map' as the actual keymap to define the tool bar. Modes
33 ;; may either bind items under the [tool-bar] prefix key of the local
34 ;; map to add to the global bar or may set `tool-bar-map'
35 ;; buffer-locally to override it. (Some items are removed from the
36 ;; global bar in modes which have `special' as their `mode-class'
39 ;; Todo: Somehow make tool bars easily customizable by the naive?
44 (define-minor-mode tool-bar-mode
45 "Toggle use of the tool bar.
46 With numeric ARG, display the tool bar if and only if ARG is positive.
48 See `tool-bar-add-item' and `tool-bar-add-item-from-menu' for
49 conveniently adding tool bar items."
54 (and (display-images-p)
55 (let ((lines (if tool-bar-mode 1 0)))
56 ;; Alter existing frames...
58 (modify-frame-parameters frame
59 (list (cons 'tool-bar-lines lines))))
61 ;; ...and future ones.
62 (let ((elt (assq 'tool-bar-lines default-frame-alist)))
65 (add-to-list 'default-frame-alist (cons 'tool-bar-lines lines)))))
66 (if (and tool-bar-mode
68 (= 1 (length (default-value 'tool-bar-map)))) ; not yet setup
72 ;; We want to pretend the toolbar by standard is on, as this will make
73 ;; customize consider disabling the toolbar a customization, and save
74 ;; that. We could do this for real by setting :init-value above, but
75 ;; that would turn on the toolbar in MS Windows where it is currently
76 ;; useless, and it would overwrite disabling the tool bar from X
77 ;; resources. If anyone want to implement this in a cleaner way,
79 ;; -- Per Abrahamsen <abraham@dina.kvl.dk> 2002-02-21.
80 (put 'tool-bar-mode 'standard-value '(t))
82 (defvar tool-bar-map (make-sparse-keymap)
83 "Keymap for the tool bar.
84 Define this locally to override the global tool bar.")
86 (global-set-key [tool-bar]
87 '(menu-item "tool bar" ignore
88 :filter (lambda (ignore) tool-bar-map)))
91 (defun tool-bar-add-item (icon def key &rest props)
92 "Add an item to the tool bar.
93 ICON names the image, DEF is the key definition and KEY is a symbol
94 for the fake function key in the menu keymap. Remaining arguments
95 PROPS are additional items to add to the menu item specification. See
96 Info node `(elisp)Tool Bar'. Items are added from left to right.
98 ICON is the base name of a file containing the image to use. The
99 function will first try to use ICON.xpm, then ICON.pbm, and finally
100 ICON.xbm, using `find-image'.
102 Keybindings are made in the map `tool-bar-map'. To define items in
103 some local map, bind `tool-bar-map' with `let' around calls of this
105 (let* ((fg (face-attribute 'tool-bar :foreground))
106 (bg (face-attribute 'tool-bar :background))
107 (colors (nconc (if (eq fg 'unspecified) nil (list :foreground fg))
108 (if (eq bg 'unspecified) nil (list :background bg))))
110 (if (display-color-p)
111 (list (list :type 'xpm :file (concat icon ".xpm"))
112 (append (list :type 'pbm :file (concat icon ".pbm"))
114 (append (list :type 'xbm :file (concat icon ".xbm"))
116 (list (append (list :type 'pbm :file (concat icon ".pbm"))
118 (append (list :type 'xbm :file (concat icon ".xbm"))
120 (list :type 'xpm :file (concat icon ".xpm")))))))
121 (when (and (display-images-p) image)
122 (unless (image-mask-p image)
123 (setq image (append image '(:mask heuristic))))
124 (define-key-after tool-bar-map (vector key)
125 `(menu-item ,(symbol-name key) ,def :image ,image ,@props)))))
128 (defun tool-bar-add-item-from-menu (command icon &optional map &rest props)
129 "Define tool bar binding for COMMAND using the given ICON in keymap MAP.
130 The binding of COMMAND is looked up in the menu bar in MAP (default
131 `global-map') and modified to add an image specification for ICON, which
132 is looked for as by `tool-bar-add-item'.
133 MAP must contain an appropriate keymap bound to `[menu-bar]'.
134 PROPS is a list of additional properties to add to the binding.
136 Keybindings are made in the map `tool-bar-map'. To define items in
137 some local map, bind `tool-bar-map' with `let' around calls of this
140 (setq map global-map))
141 (let* ((menu-bar-map (lookup-key map [menu-bar]))
142 (keys (where-is-internal command menu-bar-map))
143 (fg (face-attribute 'tool-bar :foreground))
144 (bg (face-attribute 'tool-bar :background))
145 (colors (nconc (if (eq fg 'unspecified) nil (list :foreground fg))
146 (if (eq bg 'unspecified) nil (list :background bg))))
147 (spec (if (display-color-p)
148 (list (list :type 'xpm :file (concat icon ".xpm"))
149 (append (list :type 'pbm :file (concat icon ".pbm"))
151 (append (list :type 'xbm :file (concat icon ".xbm"))
153 (list (append (list :type 'pbm :file (concat icon ".pbm"))
155 (append (list :type 'xbm :file (concat icon ".xbm"))
157 (list :type 'xpm :file (concat icon ".xpm")))))
158 (image (find-image spec))
160 (when (and (display-images-p) image)
161 ;; We'll pick up the last valid entry in the list of keys if
162 ;; there's more than one.
164 ;; We're looking for a binding of the command in a submap of
165 ;; the menu bar map, so the key sequence must be two or more
169 (let ((m (lookup-key menu-bar-map (substring k 0 -1)))
170 ;; Last element in the bound key sequence:
171 (kk (aref k (1- (length k)))))
176 (when (and (symbolp submap) (boundp submap))
177 (setq submap (eval submap)))
178 (unless (image-mask-p image)
179 (setq image (append image '(:mask heuristic))))
180 (let ((defn (assq key (cdr submap))))
181 (if (eq (cadr defn) 'menu-item)
182 (define-key-after tool-bar-map (vector key)
183 (append (cdr defn) (list :image image) props))
184 (setq defn (cdr defn))
185 (define-key-after tool-bar-map (vector key)
186 (append `(menu-item ,(car defn) ,(cddr defn))
187 (list :image image) props)))))))
189 ;;; Set up some global items. Additions/deletions up for grabs.
191 (defun tool-bar-setup ()
192 ;; People say it's bad to have EXIT on the tool bar, since users
193 ;; might inadvertently click that button.
194 ;;(tool-bar-add-item-from-menu 'save-buffers-kill-emacs "exit")
195 (tool-bar-add-item-from-menu 'find-file "new")
196 (tool-bar-add-item-from-menu 'dired "open")
197 (tool-bar-add-item-from-menu 'kill-this-buffer "close")
198 (tool-bar-add-item-from-menu 'save-buffer "save" nil
199 :visible '(or buffer-file-name
203 (tool-bar-add-item-from-menu 'write-file "saveas" nil
204 :visible '(or buffer-file-name
208 (tool-bar-add-item-from-menu 'undo "undo" nil
209 :visible '(not (eq 'special (get major-mode
211 (tool-bar-add-item-from-menu 'kill-region "cut" nil
212 :visible '(not (eq 'special (get major-mode
214 (tool-bar-add-item-from-menu 'menu-bar-kill-ring-save "copy")
215 (tool-bar-add-item-from-menu 'yank "paste" nil
216 :visible '(not (eq 'special (get major-mode
218 (tool-bar-add-item-from-menu 'nonincremental-search-forward "search")
219 ;;(tool-bar-add-item-from-menu 'ispell-buffer "spell")
221 ;; There's no icon appropriate for News and we need a command rather
222 ;; than a lambda for Read Mail.
223 ;;(tool-bar-add-item-from-menu 'compose-mail "mail_compose")
225 (tool-bar-add-item-from-menu 'print-buffer "print")
226 (tool-bar-add-item "preferences" 'customize 'customize
227 :help "Edit preferences (customize)")
229 (tool-bar-add-item "help" (lambda ()
231 (popup-menu menu-bar-help-menu))
233 :help "Pop up the Help menu")
238 ;;; tool-bar.el ends here