1 ;;; tool-bar.el --- setting up the tool bar
3 ;; Copyright (C) 2000, 2001, 2002, 2003, 2004,
4 ;; 2005 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 2, or (at your option)
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; 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.
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'.
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'
40 ;; Todo: Somehow make tool bars easily customizable by the naive?
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 (let ((lines (if tool-bar-mode
1 0)))
57 ;; Alter existing frames...
59 (modify-frame-parameters frame
60 (list (cons 'tool-bar-lines lines
))))
62 ;; ...and future ones.
63 (let ((elt (assq 'tool-bar-lines default-frame-alist
)))
66 (add-to-list 'default-frame-alist
(cons 'tool-bar-lines lines
)))))
67 (if (and tool-bar-mode
69 (= 1 (length (default-value 'tool-bar-map
)))) ; not yet setup
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 lc-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 lc-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
(concat "lc-" icon
".xpm"))))
128 (pbm-spec (append (list :type
'pbm
:file
(concat icon
".pbm")) colors
))
129 (xbm-spec (append (list :type
'xbm
:file
(concat icon
".xbm")) colors
))
131 (if (display-color-p)
132 (list xpm-lo-spec xpm-spec pbm-spec xbm-spec
)
133 (list pbm-spec xbm-spec xpm-lo-spec xpm-spec
)))))
135 (when (and (display-images-p) image
)
136 (unless (image-mask-p image
)
137 (setq image
(append image
'(:mask heuristic
))))
138 (define-key-after map
(vector key
)
139 `(menu-item ,(symbol-name key
) ,def
:image
,image
,@props
)))))
142 (defun tool-bar-add-item-from-menu (command icon
&optional map
&rest props
)
143 "Define tool bar binding for COMMAND using the given ICON in keymap MAP.
144 This makes a binding for COMMAND in `tool-bar-map', copying its
145 binding from the menu bar in MAP (which defaults to `global-map'), but
146 modifies the binding by adding an image specification for ICON. It
147 finds ICON just like `tool-bar-add-item'. PROPS are additional
148 properties to add to the binding.
150 MAP must contain appropriate binding for `[menu-bar]' which holds a keymap.
152 Use this function only to make bindings in the global value of `tool-bar-map'.
153 To define items in any other map, use `tool-bar-local-item'."
154 (apply 'tool-bar-local-item-from-menu command icon
155 (default-value 'tool-bar-map
) map props
))
158 (defun tool-bar-local-item-from-menu (command icon in-map
&optional from-map
&rest props
)
159 "Define tool bar binding for COMMAND using the given ICON in keymap MAP.
160 This makes a binding for COMMAND in IN-MAP, copying its binding from
161 the menu bar in FROM-MAP (which defaults to `global-map'), but
162 modifies the binding by adding an image specification for ICON. It
163 finds ICON just like `tool-bar-add-item'. PROPS are additional
164 properties to add to the binding.
166 MAP must contain appropriate binding for `[menu-bar]' which holds a keymap."
168 (setq from-map global-map
))
169 (let* ((menu-bar-map (lookup-key from-map
[menu-bar
]))
170 (keys (where-is-internal command menu-bar-map
))
171 (fg (face-attribute 'tool-bar
:foreground
))
172 (bg (face-attribute 'tool-bar
:background
))
173 (colors (nconc (if (eq fg
'unspecified
) nil
(list :foreground fg
))
174 (if (eq bg
'unspecified
) nil
(list :background bg
))))
175 (xpm-spec (list :type
'xpm
:file
(concat icon
".xpm")))
176 (xpm-lo-spec (if (> (display-color-cells) 256)
178 (list :type
'xpm
:file
(concat "lc-" icon
".xpm"))))
179 (pbm-spec (append (list :type
'pbm
:file
(concat icon
".pbm")) colors
))
180 (xbm-spec (append (list :type
'xbm
:file
(concat icon
".xbm")) colors
))
181 (spec (if (display-color-p)
182 (list xpm-lo-spec xpm-spec pbm-spec xbm-spec
)
183 (list pbm-spec xbm-spec xpm-lo-spec xpm-spec
)))
184 (image (find-image spec
))
186 (when (and (display-images-p) image
)
187 ;; We'll pick up the last valid entry in the list of keys if
188 ;; there's more than one.
190 ;; We're looking for a binding of the command in a submap of
191 ;; the menu bar map, so the key sequence must be two or more
195 (let ((m (lookup-key menu-bar-map
(substring k
0 -
1)))
196 ;; Last element in the bound key sequence:
197 (kk (aref k
(1- (length k
)))))
202 (when (and (symbolp submap
) (boundp submap
))
203 (setq submap
(eval submap
)))
204 (unless (image-mask-p image
)
205 (setq image
(append image
'(:mask heuristic
))))
206 (let ((defn (assq key
(cdr submap
))))
207 (if (eq (cadr defn
) 'menu-item
)
208 (define-key-after in-map
(vector key
)
209 (append (cdr defn
) (list :image image
) props
))
210 (setq defn
(cdr defn
))
211 (define-key-after in-map
(vector key
)
212 (let ((rest (cdr defn
)))
213 ;; If the rest of the definition starts
214 ;; with a list of menu cache info, get rid of that.
215 (if (and (consp rest
) (consp (car rest
)))
216 (setq rest
(cdr rest
)))
217 (append `(menu-item ,(car defn
) ,rest
)
218 (list :image image
) props
))))))))
220 ;;; Set up some global items. Additions/deletions up for grabs.
222 (defun tool-bar-setup ()
223 ;; People say it's bad to have EXIT on the tool bar, since users
224 ;; might inadvertently click that button.
225 ;;(tool-bar-add-item-from-menu 'save-buffers-kill-emacs "exit")
226 (tool-bar-add-item-from-menu 'find-file
"new")
227 (tool-bar-add-item-from-menu 'find-file-existing
"open")
228 (tool-bar-add-item-from-menu 'dired
"diropen")
229 (tool-bar-add-item-from-menu 'kill-this-buffer
"close")
230 (tool-bar-add-item-from-menu 'save-buffer
"save" nil
231 :visible
'(or buffer-file-name
235 (tool-bar-add-item-from-menu 'write-file
"saveas" nil
236 :visible
'(or buffer-file-name
240 (tool-bar-add-item-from-menu 'undo
"undo" nil
241 :visible
'(not (eq 'special
(get major-mode
243 (tool-bar-add-item-from-menu (lookup-key menu-bar-edit-menu
[cut])
245 :visible '(not (eq 'special (get major-mode
247 (tool-bar-add-item-from-menu (lookup-key menu-bar-edit-menu [copy])
249 (tool-bar-add-item-from-menu (lookup-key menu-bar-edit-menu [paste])
251 :visible '(not (eq 'special (get major-mode
253 (tool-bar-add-item-from-menu 'nonincremental-search-forward "search")
254 ;;(tool-bar-add-item-from-menu 'ispell-buffer "spell")
256 ;; There's no icon appropriate for News and we need a command rather
257 ;; than a lambda for Read Mail.
258 ;;(tool-bar-add-item-from-menu 'compose-mail "mail_compose")
260 (tool-bar-add-item-from-menu 'print-buffer "print")
261 (tool-bar-add-item "preferences" 'customize 'customize
262 :help "Edit preferences (customize)")
264 (tool-bar-add-item "help" (lambda ()
266 (popup-menu menu-bar-help-menu))
268 :help "Pop up the Help menu")
273 ;;; arch-tag: 15f30f0a-d0d7-4d50-bbb7-f48fd0c8582f
274 ;;; tool-bar.el ends here