Commit | Line | Data |
---|---|---|
e8af40ee | 1 | ;;; tool-bar.el --- setting up the tool bar |
ec7f4585 | 2 | ;; |
5fd6d89f | 3 | ;; Copyright (C) 2000, 2001, 2002, 2003, 2004, |
409cc4a3 | 4 | ;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. |
ec7f4585 DL |
5 | ;; |
6 | ;; Author: Dave Love <fx@gnu.org> | |
7 | ;; Keywords: mouse frames | |
8 | ||
9 | ;; This file is part of GNU Emacs. | |
10 | ||
eb3fa2cf | 11 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
ec7f4585 | 12 | ;; it under the terms of the GNU General Public License as published by |
eb3fa2cf GM |
13 | ;; the Free Software Foundation, either version 3 of the License, or |
14 | ;; (at your option) any later version. | |
ec7f4585 DL |
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 | |
eb3fa2cf | 22 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
ec7f4585 DL |
23 | |
24 | ;;; Commentary: | |
25 | ||
02d709c0 | 26 | ;; Provides `tool-bar-mode' to control display of the tool-bar and |
ec7f4585 DL |
27 | ;; bindings for the global tool bar with convenience functions |
28 | ;; `tool-bar-add-item' and `tool-bar-add-item-from-menu'. | |
29 | ||
9a4b8870 | 30 | ;; The normal global binding for [tool-bar] (below) uses the value of |
c129b5ef DL |
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' | |
b28e72df | 34 | ;; buffer-locally to override it. (Some items are removed from the |
9a4b8870 | 35 | ;; global bar in modes which have `special' as their `mode-class' |
b011dcb0 | 36 | ;; property.) |
9a4b8870 | 37 | |
adf7d3a8 DL |
38 | ;; Todo: Somehow make tool bars easily customizable by the naive? |
39 | ||
ec7f4585 DL |
40 | ;;; Code: |
41 | ||
646cb69e RS |
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. | |
ec7f4585 DL |
45 | (define-minor-mode tool-bar-mode |
46 | "Toggle use of the tool bar. | |
a81fc510 | 47 | With numeric ARG, display the tool bar if and only if ARG is positive. |
ec7f4585 DL |
48 | |
49 | See `tool-bar-add-item' and `tool-bar-add-item-from-menu' for | |
50 | conveniently adding tool bar items." | |
929e8487 | 51 | :init-value nil |
ec7f4585 DL |
52 | :global t |
53 | :group 'mouse | |
54 | :group 'frames | |
f3af39b8 CY |
55 | (if tool-bar-mode |
56 | (progn | |
57 | (dolist (frame (frame-list)) | |
58 | (if (display-graphic-p frame) | |
59 | (set-frame-parameter frame 'tool-bar-lines 1))) | |
60 | (tool-bar-setup)) | |
61 | (modify-all-frames-parameters (list (cons 'tool-bar-lines 0))))) | |
ec7f4585 | 62 | |
929e8487 | 63 | ;;;###autoload |
6a5af08f KL |
64 | ;; Used in the Show/Hide menu, to have the toggle reflect the current frame. |
65 | (defun toggle-tool-bar-mode-from-frame (&optional arg) | |
66 | "Toggle tool bar on or off, based on the status of the current frame. | |
67 | See `tool-bar-mode' for more information." | |
68 | (interactive (list (or current-prefix-arg 'toggle))) | |
69 | (if (eq arg 'toggle) | |
70 | (tool-bar-mode (if (> (frame-parameter nil 'tool-bar-lines) 0) 0 1)) | |
71 | (tool-bar-mode arg))) | |
72 | ||
73 | ;;;###autoload | |
929e8487 PA |
74 | ;; We want to pretend the toolbar by standard is on, as this will make |
75 | ;; customize consider disabling the toolbar a customization, and save | |
76 | ;; that. We could do this for real by setting :init-value above, but | |
77 | ;; that would turn on the toolbar in MS Windows where it is currently | |
78 | ;; useless, and it would overwrite disabling the tool bar from X | |
79 | ;; resources. If anyone want to implement this in a cleaner way, | |
80 | ;; please do so. | |
81 | ;; -- Per Abrahamsen <abraham@dina.kvl.dk> 2002-02-21. | |
82 | (put 'tool-bar-mode 'standard-value '(t)) | |
83 | ||
9a4b8870 DL |
84 | (defvar tool-bar-map (make-sparse-keymap) |
85 | "Keymap for the tool bar. | |
86 | Define this locally to override the global tool bar.") | |
87 | ||
88 | (global-set-key [tool-bar] | |
89 | '(menu-item "tool bar" ignore | |
c8fcd943 SM |
90 | :filter tool-bar-make-keymap)) |
91 | ||
aa360da1 GM |
92 | (declare-function image-mask-p "image.c" (spec &optional frame)) |
93 | ||
c8fcd943 SM |
94 | (defun tool-bar-make-keymap (&optional ignore) |
95 | "Generate an actual keymap from `tool-bar-map'. | |
96 | Its main job is to figure out which images to use based on the display's | |
97 | color capability and based on the available image libraries." | |
98 | (mapcar (lambda (bind) | |
71928058 | 99 | (let (image-exp plist) |
c8fcd943 | 100 | (when (and (eq (car-safe (cdr-safe bind)) 'menu-item) |
71928058 CY |
101 | ;; For the format of menu-items, see node |
102 | ;; `Extended Menu Items' in the Elisp manual. | |
103 | (setq plist (nthcdr (if (consp (nth 4 bind)) 5 4) | |
104 | bind)) | |
105 | (setq image-exp (plist-get plist :image)) | |
106 | (consp image-exp) | |
107 | (not (eq (car image-exp) 'image)) | |
108 | (fboundp (car image-exp))) | |
109 | (if (not (display-images-p)) | |
110 | (setq bind nil) | |
111 | (let ((image (eval image-exp))) | |
6a9cbb85 | 112 | (unless (and image (image-mask-p image)) |
71928058 CY |
113 | (setq image (append image '(:mask heuristic)))) |
114 | (setq bind (copy-sequence bind) | |
115 | plist (nthcdr (if (consp (nth 4 bind)) 5 4) | |
116 | bind)) | |
117 | (plist-put plist :image image)))) | |
118 | bind)) | |
c8fcd943 SM |
119 | tool-bar-map)) |
120 | ||
121 | (defconst tool-bar-find-image-cache (make-hash-table :weakness t :test 'equal)) | |
122 | ||
123 | (defun tool-bar-find-image (specs) | |
124 | "Like `find-image' but with caching." | |
125 | (or (gethash specs tool-bar-find-image-cache) | |
126 | (puthash specs (find-image specs) tool-bar-find-image-cache))) | |
ec7f4585 DL |
127 | |
128 | ;;;###autoload | |
9a4b8870 | 129 | (defun tool-bar-add-item (icon def key &rest props) |
ec7f4585 DL |
130 | "Add an item to the tool bar. |
131 | ICON names the image, DEF is the key definition and KEY is a symbol | |
9a4b8870 DL |
132 | for the fake function key in the menu keymap. Remaining arguments |
133 | PROPS are additional items to add to the menu item specification. See | |
134 | Info node `(elisp)Tool Bar'. Items are added from left to right. | |
ec7f4585 | 135 | |
cb4aae04 | 136 | ICON is the base name of a file containing the image to use. The |
d36b11e2 | 137 | function will first try to use low-color/ICON.xpm if `display-color-cells' |
968d6127 | 138 | is less or equal to 256, then ICON.xpm, then ICON.pbm, and finally |
cb4aae04 | 139 | ICON.xbm, using `find-image'. |
9a4b8870 | 140 | |
ca1b34c8 RS |
141 | Use this function only to make bindings in the global value of `tool-bar-map'. |
142 | To define items in any other map, use `tool-bar-local-item'." | |
143 | (apply 'tool-bar-local-item icon def key tool-bar-map props)) | |
144 | ||
145 | ;;;###autoload | |
146 | (defun tool-bar-local-item (icon def key map &rest props) | |
147 | "Add an item to the tool bar in map MAP. | |
148 | ICON names the image, DEF is the key definition and KEY is a symbol | |
149 | for the fake function key in the menu keymap. Remaining arguments | |
150 | PROPS are additional items to add to the menu item specification. See | |
151 | Info node `(elisp)Tool Bar'. Items are added from left to right. | |
152 | ||
153 | ICON is the base name of a file containing the image to use. The | |
c8fcd943 | 154 | function will first try to use low-color/ICON.xpm if `display-color-cells' |
968d6127 | 155 | is less or equal to 256, then ICON.xpm, then ICON.pbm, and finally |
ca1b34c8 | 156 | ICON.xbm, using `find-image'." |
3fae165c GM |
157 | (let* ((fg (face-attribute 'tool-bar :foreground)) |
158 | (bg (face-attribute 'tool-bar :background)) | |
159 | (colors (nconc (if (eq fg 'unspecified) nil (list :foreground fg)) | |
160 | (if (eq bg 'unspecified) nil (list :background bg)))) | |
cf545823 | 161 | (xpm-spec (list :type 'xpm :file (concat icon ".xpm"))) |
afb465eb CY |
162 | (xpm-lo-spec (list :type 'xpm :file |
163 | (concat "low-color/" icon ".xpm"))) | |
ffda926c BW |
164 | (pbm-spec (append (list :type 'pbm :file |
165 | (concat icon ".pbm")) colors)) | |
166 | (xbm-spec (append (list :type 'xbm :file | |
167 | (concat icon ".xbm")) colors)) | |
c8fcd943 | 168 | (image-exp `(tool-bar-find-image |
afb465eb CY |
169 | (cond ((not (display-color-p)) |
170 | ',(list pbm-spec xbm-spec xpm-lo-spec xpm-spec)) | |
171 | ((< (display-color-cells) 256) | |
172 | ',(list xpm-lo-spec xpm-spec pbm-spec xbm-spec)) | |
173 | (t | |
174 | ',(list xpm-spec pbm-spec xbm-spec)))))) | |
c8fcd943 SM |
175 | (define-key-after map (vector key) |
176 | `(menu-item ,(symbol-name key) ,def :image ,image-exp ,@props)))) | |
ec7f4585 | 177 | |
c2156508 | 178 | ;;;###autoload |
ec7f4585 | 179 | (defun tool-bar-add-item-from-menu (command icon &optional map &rest props) |
7c064859 | 180 | "Define tool bar binding for COMMAND in keymap MAP using the given ICON. |
ca1b34c8 RS |
181 | This makes a binding for COMMAND in `tool-bar-map', copying its |
182 | binding from the menu bar in MAP (which defaults to `global-map'), but | |
183 | modifies the binding by adding an image specification for ICON. It | |
184 | finds ICON just like `tool-bar-add-item'. PROPS are additional | |
185 | properties to add to the binding. | |
186 | ||
187 | MAP must contain appropriate binding for `[menu-bar]' which holds a keymap. | |
188 | ||
189 | Use this function only to make bindings in the global value of `tool-bar-map'. | |
7c064859 | 190 | To define items in any other map, use `tool-bar-local-item-from-menu'." |
03a8bf7d SM |
191 | (apply 'tool-bar-local-item-from-menu command icon |
192 | (default-value 'tool-bar-map) map props)) | |
ca1b34c8 RS |
193 | |
194 | ;;;###autoload | |
195 | (defun tool-bar-local-item-from-menu (command icon in-map &optional from-map &rest props) | |
7c064859 | 196 | "Define local tool bar binding for COMMAND using the given ICON. |
ca1b34c8 RS |
197 | This makes a binding for COMMAND in IN-MAP, copying its binding from |
198 | the menu bar in FROM-MAP (which defaults to `global-map'), but | |
199 | modifies the binding by adding an image specification for ICON. It | |
200 | finds ICON just like `tool-bar-add-item'. PROPS are additional | |
201 | properties to add to the binding. | |
202 | ||
7c064859 NR |
203 | FROM-MAP must contain appropriate binding for `[menu-bar]' which |
204 | holds a keymap." | |
ca1b34c8 RS |
205 | (unless from-map |
206 | (setq from-map global-map)) | |
207 | (let* ((menu-bar-map (lookup-key from-map [menu-bar])) | |
ec7f4585 | 208 | (keys (where-is-internal command menu-bar-map)) |
3fae165c GM |
209 | (fg (face-attribute 'tool-bar :foreground)) |
210 | (bg (face-attribute 'tool-bar :background)) | |
211 | (colors (nconc (if (eq fg 'unspecified) nil (list :foreground fg)) | |
212 | (if (eq bg 'unspecified) nil (list :background bg)))) | |
cf545823 | 213 | (xpm-spec (list :type 'xpm :file (concat icon ".xpm"))) |
afb465eb CY |
214 | (xpm-lo-spec (list :type 'xpm :file |
215 | (concat "low-color/" icon ".xpm"))) | |
ffda926c BW |
216 | (pbm-spec (append (list :type 'pbm :file |
217 | (concat icon ".pbm")) colors)) | |
218 | (xbm-spec (append (list :type 'xbm :file | |
219 | (concat icon ".xbm")) colors)) | |
c8fcd943 | 220 | (image-exp `(tool-bar-find-image |
afb465eb CY |
221 | (cond ((not (display-color-p)) |
222 | ',(list pbm-spec xbm-spec xpm-lo-spec xpm-spec)) | |
223 | ((< (display-color-cells) 256) | |
224 | ',(list xpm-lo-spec xpm-spec pbm-spec xbm-spec)) | |
225 | (t | |
226 | ',(list xpm-spec pbm-spec xbm-spec))))) | |
ec7f4585 | 227 | submap key) |
c8fcd943 SM |
228 | ;; We'll pick up the last valid entry in the list of keys if |
229 | ;; there's more than one. | |
230 | (dolist (k keys) | |
231 | ;; We're looking for a binding of the command in a submap of | |
232 | ;; the menu bar map, so the key sequence must be two or more | |
233 | ;; long. | |
234 | (if (and (vectorp k) | |
235 | (> (length k) 1)) | |
236 | (let ((m (lookup-key menu-bar-map (substring k 0 -1))) | |
237 | ;; Last element in the bound key sequence: | |
238 | (kk (aref k (1- (length k))))) | |
239 | (if (and (keymapp m) | |
240 | (symbolp kk)) | |
241 | (setq submap m | |
242 | key kk))))) | |
243 | (when (and (symbolp submap) (boundp submap)) | |
244 | (setq submap (eval submap))) | |
245 | (let ((defn (assq key (cdr submap)))) | |
246 | (if (eq (cadr defn) 'menu-item) | |
247 | (define-key-after in-map (vector key) | |
248 | (append (cdr defn) (list :image image-exp) props)) | |
249 | (setq defn (cdr defn)) | |
250 | (define-key-after in-map (vector key) | |
251 | (let ((rest (cdr defn))) | |
252 | ;; If the rest of the definition starts | |
253 | ;; with a list of menu cache info, get rid of that. | |
254 | (if (and (consp rest) (consp (car rest))) | |
255 | (setq rest (cdr rest))) | |
256 | (append `(menu-item ,(car defn) ,rest) | |
257 | (list :image image-exp) props))))))) | |
ec7f4585 DL |
258 | |
259 | ;;; Set up some global items. Additions/deletions up for grabs. | |
260 | ||
095fe281 | 261 | (defvar tool-bar-setup nil |
f3af39b8 | 262 | "Non-nil if the tool-bar has been set up by `tool-bar-setup'.") |
095fe281 KL |
263 | |
264 | (defun tool-bar-setup (&optional frame) | |
f3af39b8 | 265 | (unless (or tool-bar-setup |
afb465eb | 266 | (null tool-bar-mode)) |
095fe281 KL |
267 | (with-selected-frame (or frame (selected-frame)) |
268 | ;; People say it's bad to have EXIT on the tool bar, since users | |
269 | ;; might inadvertently click that button. | |
270 | ;;(tool-bar-add-item-from-menu 'save-buffers-kill-emacs "exit") | |
271 | (tool-bar-add-item-from-menu 'find-file "new") | |
272 | (tool-bar-add-item-from-menu 'menu-find-file-existing "open") | |
273 | (tool-bar-add-item-from-menu 'dired "diropen") | |
274 | (tool-bar-add-item-from-menu 'kill-this-buffer "close") | |
275 | (tool-bar-add-item-from-menu 'save-buffer "save" nil | |
276 | :visible '(or buffer-file-name | |
277 | (not (eq 'special | |
278 | (get major-mode | |
279 | 'mode-class))))) | |
280 | (tool-bar-add-item-from-menu 'write-file "saveas" nil | |
281 | :visible '(or buffer-file-name | |
282 | (not (eq 'special | |
283 | (get major-mode | |
284 | 'mode-class))))) | |
285 | (tool-bar-add-item-from-menu 'undo "undo" nil | |
286 | :visible '(not (eq 'special (get major-mode | |
287 | 'mode-class)))) | |
288 | (tool-bar-add-item-from-menu (lookup-key menu-bar-edit-menu [cut]) | |
289 | "cut" nil | |
290 | :visible '(not (eq 'special (get major-mode | |
291 | 'mode-class)))) | |
292 | (tool-bar-add-item-from-menu (lookup-key menu-bar-edit-menu [copy]) | |
293 | "copy") | |
294 | (tool-bar-add-item-from-menu (lookup-key menu-bar-edit-menu [paste]) | |
295 | "paste" nil | |
296 | :visible '(not (eq 'special (get major-mode | |
297 | 'mode-class)))) | |
298 | (tool-bar-add-item-from-menu 'nonincremental-search-forward "search") | |
299 | ;;(tool-bar-add-item-from-menu 'ispell-buffer "spell") | |
300 | ||
301 | ;; There's no icon appropriate for News and we need a command rather | |
302 | ;; than a lambda for Read Mail. | |
c8fcd943 | 303 | ;;(tool-bar-add-item-from-menu 'compose-mail "mail/compose") |
095fe281 | 304 | |
c8fcd943 | 305 | (tool-bar-add-item-from-menu 'print-buffer "print") |
095fe281 | 306 | |
c8fcd943 SM |
307 | ;; tool-bar-add-item-from-menu itself operates on |
308 | ;; (default-value 'tool-bar-map), but when we don't use that function, | |
309 | ;; we must explicitly operate on the default value. | |
095fe281 | 310 | |
c8fcd943 SM |
311 | (let ((tool-bar-map (default-value 'tool-bar-map))) |
312 | (tool-bar-add-item "preferences" 'customize 'customize | |
313 | :help "Edit preferences (customize)") | |
bc2fa80d | 314 | |
c8fcd943 SM |
315 | (tool-bar-add-item "help" (lambda () |
316 | (interactive) | |
317 | (popup-menu menu-bar-help-menu)) | |
318 | 'help | |
319 | :help "Pop up the Help menu")) | |
320 | (setq tool-bar-setup t)))) | |
ec7f4585 | 321 | |
ec7f4585 | 322 | |
c044516d | 323 | (provide 'tool-bar) |
cbee283d | 324 | ;; arch-tag: 15f30f0a-d0d7-4d50-bbb7-f48fd0c8582f |
ec7f4585 | 325 | ;;; tool-bar.el ends here |