Commit | Line | Data |
---|---|---|
e8af40ee | 1 | ;;; tool-bar.el --- setting up the tool bar |
ec7f4585 | 2 | ;; |
5fd6d89f TTN |
3 | ;; Copyright (C) 2000, 2001, 2002, 2003, 2004, |
4 | ;; 2005 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 | ||
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 | |
086add15 LK |
23 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
24 | ;; Boston, MA 02110-1301, USA. | |
ec7f4585 DL |
25 | |
26 | ;;; Commentary: | |
27 | ||
02d709c0 | 28 | ;; Provides `tool-bar-mode' to control display of the tool-bar and |
ec7f4585 DL |
29 | ;; bindings for the global tool bar with convenience functions |
30 | ;; `tool-bar-add-item' and `tool-bar-add-item-from-menu'. | |
31 | ||
9a4b8870 | 32 | ;; The normal global binding for [tool-bar] (below) uses the value of |
c129b5ef DL |
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' | |
b28e72df | 36 | ;; buffer-locally to override it. (Some items are removed from the |
9a4b8870 | 37 | ;; global bar in modes which have `special' as their `mode-class' |
b011dcb0 | 38 | ;; property.) |
9a4b8870 | 39 | |
adf7d3a8 DL |
40 | ;; Todo: Somehow make tool bars easily customizable by the naive? |
41 | ||
ec7f4585 DL |
42 | ;;; Code: |
43 | ||
646cb69e RS |
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. | |
ec7f4585 DL |
47 | (define-minor-mode tool-bar-mode |
48 | "Toggle use of the tool bar. | |
a81fc510 | 49 | With numeric ARG, display the tool bar if and only if ARG is positive. |
ec7f4585 DL |
50 | |
51 | See `tool-bar-add-item' and `tool-bar-add-item-from-menu' for | |
52 | conveniently adding tool bar items." | |
929e8487 | 53 | :init-value nil |
ec7f4585 DL |
54 | :global t |
55 | :group 'mouse | |
56 | :group 'frames | |
ef32aa02 EZ |
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)))) | |
ec7f4585 | 73 | |
929e8487 PA |
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 | ||
9a4b8870 DL |
85 | (defvar tool-bar-map (make-sparse-keymap) |
86 | "Keymap for the tool bar. | |
87 | Define 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))) | |
ec7f4585 DL |
92 | |
93 | ;;;###autoload | |
9a4b8870 | 94 | (defun tool-bar-add-item (icon def key &rest props) |
ec7f4585 DL |
95 | "Add an item to the tool bar. |
96 | ICON names the image, DEF is the key definition and KEY is a symbol | |
9a4b8870 DL |
97 | for the fake function key in the menu keymap. Remaining arguments |
98 | PROPS are additional items to add to the menu item specification. See | |
99 | Info node `(elisp)Tool Bar'. Items are added from left to right. | |
ec7f4585 | 100 | |
cb4aae04 | 101 | ICON is the base name of a file containing the image to use. The |
ffda926c | 102 | function will first try to use low-color/ICON.xpm if display-color-cells |
968d6127 | 103 | is less or equal to 256, then ICON.xpm, then ICON.pbm, and finally |
cb4aae04 | 104 | ICON.xbm, using `find-image'. |
9a4b8870 | 105 | |
ca1b34c8 RS |
106 | Use this function only to make bindings in the global value of `tool-bar-map'. |
107 | To 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. | |
113 | ICON names the image, DEF is the key definition and KEY is a symbol | |
114 | for the fake function key in the menu keymap. Remaining arguments | |
115 | PROPS are additional items to add to the menu item specification. See | |
116 | Info node `(elisp)Tool Bar'. Items are added from left to right. | |
117 | ||
118 | ICON is the base name of a file containing the image to use. The | |
ffda926c | 119 | function will first try to use low-color/ICON.xpm if display-color-cells |
968d6127 | 120 | is less or equal to 256, then ICON.xpm, then ICON.pbm, and finally |
ca1b34c8 | 121 | ICON.xbm, using `find-image'." |
3fae165c GM |
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)))) | |
cf545823 JD |
126 | (xpm-spec (list :type 'xpm :file (concat icon ".xpm"))) |
127 | (xpm-lo-spec (if (> (display-color-cells) 256) | |
128 | nil | |
ffda926c BW |
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)) | |
3b6d80f1 | 135 | (image (find-image |
34e86ea3 | 136 | (if (display-color-p) |
cf545823 JD |
137 | (list xpm-lo-spec xpm-spec pbm-spec xbm-spec) |
138 | (list pbm-spec xbm-spec xpm-lo-spec xpm-spec))))) | |
139 | ||
196de866 | 140 | (when (and (display-images-p) image) |
ec7f4585 DL |
141 | (unless (image-mask-p image) |
142 | (setq image (append image '(:mask heuristic)))) | |
ca1b34c8 | 143 | (define-key-after map (vector key) |
ec7f4585 DL |
144 | `(menu-item ,(symbol-name key) ,def :image ,image ,@props))))) |
145 | ||
c2156508 | 146 | ;;;###autoload |
ec7f4585 DL |
147 | (defun tool-bar-add-item-from-menu (command icon &optional map &rest props) |
148 | "Define tool bar binding for COMMAND using the given ICON in keymap MAP. | |
ca1b34c8 RS |
149 | This makes a binding for COMMAND in `tool-bar-map', copying its |
150 | binding from the menu bar in MAP (which defaults to `global-map'), but | |
151 | modifies the binding by adding an image specification for ICON. It | |
152 | finds ICON just like `tool-bar-add-item'. PROPS are additional | |
153 | properties to add to the binding. | |
154 | ||
155 | MAP must contain appropriate binding for `[menu-bar]' which holds a keymap. | |
156 | ||
157 | Use this function only to make bindings in the global value of `tool-bar-map'. | |
158 | To define items in any other map, use `tool-bar-local-item'." | |
03a8bf7d SM |
159 | (apply 'tool-bar-local-item-from-menu command icon |
160 | (default-value 'tool-bar-map) map props)) | |
ca1b34c8 RS |
161 | |
162 | ;;;###autoload | |
163 | (defun tool-bar-local-item-from-menu (command icon in-map &optional from-map &rest props) | |
164 | "Define tool bar binding for COMMAND using the given ICON in keymap MAP. | |
165 | This makes a binding for COMMAND in IN-MAP, copying its binding from | |
166 | the menu bar in FROM-MAP (which defaults to `global-map'), but | |
167 | modifies the binding by adding an image specification for ICON. It | |
168 | finds ICON just like `tool-bar-add-item'. PROPS are additional | |
169 | properties to add to the binding. | |
170 | ||
171 | MAP must contain appropriate binding for `[menu-bar]' which holds a keymap." | |
172 | (unless from-map | |
173 | (setq from-map global-map)) | |
174 | (let* ((menu-bar-map (lookup-key from-map [menu-bar])) | |
ec7f4585 | 175 | (keys (where-is-internal command menu-bar-map)) |
3fae165c GM |
176 | (fg (face-attribute 'tool-bar :foreground)) |
177 | (bg (face-attribute 'tool-bar :background)) | |
178 | (colors (nconc (if (eq fg 'unspecified) nil (list :foreground fg)) | |
179 | (if (eq bg 'unspecified) nil (list :background bg)))) | |
cf545823 JD |
180 | (xpm-spec (list :type 'xpm :file (concat icon ".xpm"))) |
181 | (xpm-lo-spec (if (> (display-color-cells) 256) | |
182 | nil | |
ffda926c BW |
183 | (list :type 'xpm :file |
184 | (concat "low-color/" icon ".xpm")))) | |
185 | (pbm-spec (append (list :type 'pbm :file | |
186 | (concat icon ".pbm")) colors)) | |
187 | (xbm-spec (append (list :type 'xbm :file | |
188 | (concat icon ".xbm")) colors)) | |
7e636904 | 189 | (spec (if (display-color-p) |
cf545823 JD |
190 | (list xpm-lo-spec xpm-spec pbm-spec xbm-spec) |
191 | (list pbm-spec xbm-spec xpm-lo-spec xpm-spec))) | |
7e636904 | 192 | (image (find-image spec)) |
ec7f4585 | 193 | submap key) |
196de866 | 194 | (when (and (display-images-p) image) |
ec7f4585 DL |
195 | ;; We'll pick up the last valid entry in the list of keys if |
196 | ;; there's more than one. | |
197 | (dolist (k keys) | |
198 | ;; We're looking for a binding of the command in a submap of | |
199 | ;; the menu bar map, so the key sequence must be two or more | |
200 | ;; long. | |
201 | (if (and (vectorp k) | |
202 | (> (length k) 1)) | |
203 | (let ((m (lookup-key menu-bar-map (substring k 0 -1))) | |
204 | ;; Last element in the bound key sequence: | |
205 | (kk (aref k (1- (length k))))) | |
206 | (if (and (keymapp m) | |
207 | (symbolp kk)) | |
208 | (setq submap m | |
209 | key kk))))) | |
210 | (when (and (symbolp submap) (boundp submap)) | |
211 | (setq submap (eval submap))) | |
ddba99ad MB |
212 | (unless (image-mask-p image) |
213 | (setq image (append image '(:mask heuristic)))) | |
98a8938c GM |
214 | (let ((defn (assq key (cdr submap)))) |
215 | (if (eq (cadr defn) 'menu-item) | |
ca1b34c8 | 216 | (define-key-after in-map (vector key) |
98a8938c GM |
217 | (append (cdr defn) (list :image image) props)) |
218 | (setq defn (cdr defn)) | |
ca1b34c8 | 219 | (define-key-after in-map (vector key) |
2fab4328 RS |
220 | (let ((rest (cdr defn))) |
221 | ;; If the rest of the definition starts | |
222 | ;; with a list of menu cache info, get rid of that. | |
223 | (if (and (consp rest) (consp (car rest))) | |
224 | (setq rest (cdr rest))) | |
225 | (append `(menu-item ,(car defn) ,rest) | |
226 | (list :image image) props)))))))) | |
ec7f4585 DL |
227 | |
228 | ;;; Set up some global items. Additions/deletions up for grabs. | |
229 | ||
ebd4825d | 230 | (defun tool-bar-setup () |
7a03d9cd EZ |
231 | ;; People say it's bad to have EXIT on the tool bar, since users |
232 | ;; might inadvertently click that button. | |
233 | ;;(tool-bar-add-item-from-menu 'save-buffers-kill-emacs "exit") | |
ebd4825d | 234 | (tool-bar-add-item-from-menu 'find-file "new") |
95ec60bc JD |
235 | (tool-bar-add-item-from-menu 'find-file-existing "open") |
236 | (tool-bar-add-item-from-menu 'dired "diropen") | |
ebd4825d DL |
237 | (tool-bar-add-item-from-menu 'kill-this-buffer "close") |
238 | (tool-bar-add-item-from-menu 'save-buffer "save" nil | |
5ec17636 DL |
239 | :visible '(or buffer-file-name |
240 | (not (eq 'special | |
241 | (get major-mode | |
242 | 'mode-class))))) | |
ebd4825d | 243 | (tool-bar-add-item-from-menu 'write-file "saveas" nil |
5ec17636 DL |
244 | :visible '(or buffer-file-name |
245 | (not (eq 'special | |
246 | (get major-mode | |
247 | 'mode-class))))) | |
ebd4825d DL |
248 | (tool-bar-add-item-from-menu 'undo "undo" nil |
249 | :visible '(not (eq 'special (get major-mode | |
250 | 'mode-class)))) | |
0928a1d8 JD |
251 | (tool-bar-add-item-from-menu (lookup-key menu-bar-edit-menu [cut]) |
252 | "cut" nil | |
ebd4825d DL |
253 | :visible '(not (eq 'special (get major-mode |
254 | 'mode-class)))) | |
0928a1d8 JD |
255 | (tool-bar-add-item-from-menu (lookup-key menu-bar-edit-menu [copy]) |
256 | "copy") | |
257 | (tool-bar-add-item-from-menu (lookup-key menu-bar-edit-menu [paste]) | |
258 | "paste" nil | |
ebd4825d DL |
259 | :visible '(not (eq 'special (get major-mode |
260 | 'mode-class)))) | |
261 | (tool-bar-add-item-from-menu 'nonincremental-search-forward "search") | |
262 | ;;(tool-bar-add-item-from-menu 'ispell-buffer "spell") | |
263 | ||
264 | ;; There's no icon appropriate for News and we need a command rather | |
265 | ;; than a lambda for Read Mail. | |
ffda926c | 266 | ;;(tool-bar-add-item-from-menu 'compose-mail "mail/compose") |
ebd4825d DL |
267 | |
268 | (tool-bar-add-item-from-menu 'print-buffer "print") | |
9a4b8870 | 269 | (tool-bar-add-item "preferences" 'customize 'customize |
ebd4825d DL |
270 | :help "Edit preferences (customize)") |
271 | ||
9a4b8870 DL |
272 | (tool-bar-add-item "help" (lambda () |
273 | (interactive) | |
274 | (popup-menu menu-bar-help-menu)) | |
275 | 'help | |
276 | :help "Pop up the Help menu") | |
ebd4825d | 277 | ) |
ec7f4585 DL |
278 | |
279 | (provide 'tool-bar) | |
280 | ||
ab5796a9 | 281 | ;;; arch-tag: 15f30f0a-d0d7-4d50-bbb7-f48fd0c8582f |
ec7f4585 | 282 | ;;; tool-bar.el ends here |