1 ;;; tool-bar.el --- setting up the tool bar
3 ;; Copyright (C) 2000, 2001, 2002, 2003, 2004,
4 ;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
6 ;; Author: Dave Love <fx@gnu.org>
7 ;; Keywords: mouse frames
9 ;; This file is part of GNU Emacs.
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 3 of the License, or
14 ;; (at your option) any later version.
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.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
26 ;; Provides `tool-bar-mode' to control display of the tool-bar and
27 ;; bindings for the global tool bar with convenience functions
28 ;; `tool-bar-add-item' and `tool-bar-add-item-from-menu'.
30 ;; The normal global binding for [tool-bar] (below) uses the value of
31 ;; `tool-bar-map' as the actual keymap to define the tool bar. Modes
32 ;; may either bind items under the [tool-bar] prefix key of the local
33 ;; map to add to the global bar or may set `tool-bar-map'
34 ;; buffer-locally to override it. (Some items are removed from the
35 ;; global bar in modes which have `special' as their `mode-class'
38 ;; Todo: Somehow make tool bars easily customizable by the naive?
42 ;; The autoload cookie doesn't work when preloading.
43 ;; Deleting it means invoking this command won't work
44 ;; when you are on a tty. I hope that won't cause too much trouble -- rms.
45 (define-minor-mode tool-bar-mode
46 "Toggle use of the tool bar.
47 With numeric ARG, display the tool bar if and only if ARG is positive.
49 See `tool-bar-add-item' and `tool-bar-add-item-from-menu' for
50 conveniently adding tool bar items."
55 (and (display-images-p)
56 (modify-all-frames-parameters (list (cons 'tool-bar-lines
57 (if tool-bar-mode
1 0))))
58 (if (and tool-bar-mode
63 ;; Used in the Show/Hide menu, to have the toggle reflect the current frame.
64 (defun toggle-tool-bar-mode-from-frame (&optional arg
)
65 "Toggle tool bar on or off, based on the status of the current frame.
66 See `tool-bar-mode' for more information."
67 (interactive (list (or current-prefix-arg
'toggle
)))
69 (tool-bar-mode (if (> (frame-parameter nil
'tool-bar-lines
) 0) 0 1))
73 ;; We want to pretend the toolbar by standard is on, as this will make
74 ;; customize consider disabling the toolbar a customization, and save
75 ;; that. We could do this for real by setting :init-value above, but
76 ;; that would turn on the toolbar in MS Windows where it is currently
77 ;; useless, and it would overwrite disabling the tool bar from X
78 ;; resources. If anyone want to implement this in a cleaner way,
80 ;; -- Per Abrahamsen <abraham@dina.kvl.dk> 2002-02-21.
81 (put 'tool-bar-mode
'standard-value
'(t))
83 (defvar tool-bar-map
(make-sparse-keymap)
84 "Keymap for the tool bar.
85 Define this locally to override the global tool bar.")
87 (global-set-key [tool-bar
]
88 '(menu-item "tool bar" ignore
89 :filter
(lambda (ignore) tool-bar-map
)))
92 (defun tool-bar-add-item (icon def key
&rest props
)
93 "Add an item to the tool bar.
94 ICON names the image, DEF is the key definition and KEY is a symbol
95 for the fake function key in the menu keymap. Remaining arguments
96 PROPS are additional items to add to the menu item specification. See
97 Info node `(elisp)Tool Bar'. Items are added from left to right.
99 ICON is the base name of a file containing the image to use. The
100 function will first try to use low-color/ICON.xpm if display-color-cells
101 is less or equal to 256, then ICON.xpm, then ICON.pbm, and finally
102 ICON.xbm, using `find-image'.
104 Use this function only to make bindings in the global value of `tool-bar-map'.
105 To define items in any other map, use `tool-bar-local-item'."
106 (apply 'tool-bar-local-item icon def key tool-bar-map props
))
109 (defun tool-bar-local-item (icon def key map
&rest props
)
110 "Add an item to the tool bar in map MAP.
111 ICON names the image, DEF is the key definition and KEY is a symbol
112 for the fake function key in the menu keymap. Remaining arguments
113 PROPS are additional items to add to the menu item specification. See
114 Info node `(elisp)Tool Bar'. Items are added from left to right.
116 ICON is the base name of a file containing the image to use. The
117 function will first try to use low-color/ICON.xpm if display-color-cells
118 is less or equal to 256, then ICON.xpm, then ICON.pbm, and finally
119 ICON.xbm, using `find-image'."
120 (let* ((fg (face-attribute 'tool-bar
:foreground
))
121 (bg (face-attribute 'tool-bar
:background
))
122 (colors (nconc (if (eq fg
'unspecified
) nil
(list :foreground fg
))
123 (if (eq bg
'unspecified
) nil
(list :background bg
))))
124 (xpm-spec (list :type
'xpm
:file
(concat icon
".xpm")))
125 (xpm-lo-spec (if (> (display-color-cells) 256)
127 (list :type
'xpm
:file
128 (concat "low-color/" icon
".xpm"))))
129 (pbm-spec (append (list :type
'pbm
:file
130 (concat icon
".pbm")) colors
))
131 (xbm-spec (append (list :type
'xbm
:file
132 (concat icon
".xbm")) colors
))
134 (if (display-color-p)
135 (list xpm-lo-spec xpm-spec pbm-spec xbm-spec
)
136 (list pbm-spec xbm-spec xpm-lo-spec xpm-spec
)))))
138 (when (and (display-images-p) image
)
139 (unless (image-mask-p image
)
140 (setq image
(append image
'(:mask heuristic
))))
141 (define-key-after map
(vector key
)
142 `(menu-item ,(symbol-name key
) ,def
:image
,image
,@props
)))))
145 (defun tool-bar-add-item-from-menu (command icon
&optional map
&rest props
)
146 "Define tool bar binding for COMMAND in keymap MAP using the given ICON.
147 This makes a binding for COMMAND in `tool-bar-map', copying its
148 binding from the menu bar in MAP (which defaults to `global-map'), but
149 modifies the binding by adding an image specification for ICON. It
150 finds ICON just like `tool-bar-add-item'. PROPS are additional
151 properties to add to the binding.
153 MAP must contain appropriate binding for `[menu-bar]' which holds a keymap.
155 Use this function only to make bindings in the global value of `tool-bar-map'.
156 To define items in any other map, use `tool-bar-local-item-from-menu'."
157 (apply 'tool-bar-local-item-from-menu command icon
158 (default-value 'tool-bar-map
) map props
))
161 (defun tool-bar-local-item-from-menu (command icon in-map
&optional from-map
&rest props
)
162 "Define local tool bar binding for COMMAND using the given ICON.
163 This makes a binding for COMMAND in IN-MAP, copying its binding from
164 the menu bar in FROM-MAP (which defaults to `global-map'), but
165 modifies the binding by adding an image specification for ICON. It
166 finds ICON just like `tool-bar-add-item'. PROPS are additional
167 properties to add to the binding.
169 FROM-MAP must contain appropriate binding for `[menu-bar]' which
172 (setq from-map global-map
))
173 (let* ((menu-bar-map (lookup-key from-map
[menu-bar
]))
174 (keys (where-is-internal command menu-bar-map
))
175 (fg (face-attribute 'tool-bar
:foreground
))
176 (bg (face-attribute 'tool-bar
:background
))
177 (colors (nconc (if (eq fg
'unspecified
) nil
(list :foreground fg
))
178 (if (eq bg
'unspecified
) nil
(list :background bg
))))
179 (xpm-spec (list :type
'xpm
:file
(concat icon
".xpm")))
180 (xpm-lo-spec (if (> (display-color-cells) 256)
182 (list :type
'xpm
:file
183 (concat "low-color/" icon
".xpm"))))
184 (pbm-spec (append (list :type
'pbm
:file
185 (concat icon
".pbm")) colors
))
186 (xbm-spec (append (list :type
'xbm
:file
187 (concat icon
".xbm")) colors
))
188 (spec (if (display-color-p)
189 (list xpm-lo-spec xpm-spec pbm-spec xbm-spec
)
190 (list pbm-spec xbm-spec xpm-lo-spec xpm-spec
)))
191 (image (find-image spec
))
193 (when (and (display-images-p) image
)
194 ;; We'll pick up the last valid entry in the list of keys if
195 ;; there's more than one.
197 ;; We're looking for a binding of the command in a submap of
198 ;; the menu bar map, so the key sequence must be two or more
202 (let ((m (lookup-key menu-bar-map
(substring k
0 -
1)))
203 ;; Last element in the bound key sequence:
204 (kk (aref k
(1- (length k
)))))
209 (when (and (symbolp submap
) (boundp submap
))
210 (setq submap
(eval submap
)))
211 (unless (image-mask-p image
)
212 (setq image
(append image
'(:mask heuristic
))))
213 (let ((defn (assq key
(cdr submap
))))
214 (if (eq (cadr defn
) 'menu-item
)
215 (define-key-after in-map
(vector key
)
216 (append (cdr defn
) (list :image image
) props
))
217 (setq defn
(cdr defn
))
218 (define-key-after in-map
(vector key
)
219 (let ((rest (cdr defn
)))
220 ;; If the rest of the definition starts
221 ;; with a list of menu cache info, get rid of that.
222 (if (and (consp rest
) (consp (car rest
)))
223 (setq rest
(cdr rest
)))
224 (append `(menu-item ,(car defn
) ,rest
)
225 (list :image image
) props
))))))))
227 ;;; Set up some global items. Additions/deletions up for grabs.
229 (defvar tool-bar-setup nil
230 "Set to t if the tool-bar has been set up by `tool-bar-setup'.")
232 (defun tool-bar-setup (&optional frame
)
233 (unless tool-bar-setup
234 (with-selected-frame (or frame
(selected-frame))
235 ;; People say it's bad to have EXIT on the tool bar, since users
236 ;; might inadvertently click that button.
237 ;;(tool-bar-add-item-from-menu 'save-buffers-kill-emacs "exit")
238 (tool-bar-add-item-from-menu 'find-file
"new")
239 (tool-bar-add-item-from-menu 'menu-find-file-existing
"open")
240 (tool-bar-add-item-from-menu 'dired
"diropen")
241 (tool-bar-add-item-from-menu 'kill-this-buffer
"close")
242 (tool-bar-add-item-from-menu 'save-buffer
"save" nil
243 :visible
'(or buffer-file-name
247 (tool-bar-add-item-from-menu 'write-file
"saveas" nil
248 :visible
'(or buffer-file-name
252 (tool-bar-add-item-from-menu 'undo
"undo" nil
253 :visible
'(not (eq 'special
(get major-mode
255 (tool-bar-add-item-from-menu (lookup-key menu-bar-edit-menu
[cut])
257 :visible '(not (eq 'special (get major-mode
259 (tool-bar-add-item-from-menu (lookup-key menu-bar-edit-menu [copy])
261 (tool-bar-add-item-from-menu (lookup-key menu-bar-edit-menu [paste])
263 :visible '(not (eq 'special (get major-mode
265 (tool-bar-add-item-from-menu 'nonincremental-search-forward "search")
266 ;;(tool-bar-add-item-from-menu 'ispell-buffer "spell")
268 ;; There's no icon appropriate for News and we need a command rather
269 ;; than a lambda for Read Mail.
270 ;;(tool-bar-add-item-from-menu 'compose-mail "mail/compose")
272 (tool-bar-add-item-from-menu 'print-buffer "print")
274 ;; tool-bar-add-item-from-menu itself operates on
275 ;; (default-value 'tool-bar-map), but when we don't use that function,
276 ;; we must explicitly operate on the default value.
278 (let ((tool-bar-map (default-value 'tool-bar-map)))
279 (tool-bar-add-item "preferences" 'customize 'customize
280 :help "Edit preferences (customize)")
282 (tool-bar-add-item "help" (lambda ()
284 (popup-menu menu-bar-help-menu))
286 :help "Pop up the Help menu"))
287 (setq tool-bar-setup t))))
291 ;; arch-tag: 15f30f0a-d0d7-4d50-bbb7-f48fd0c8582f
292 ;;; tool-bar.el ends here