1 ;;; tool-bar.el --- setting up the tool bar
3 ;; Copyright (C) 2000, 2001 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."
53 (let ((lines (if tool-bar-mode
1 0)))
54 ;; Alter existing frames...
56 (modify-frame-parameters frame
57 (list (cons 'tool-bar-lines lines
))))
59 ;; ...and future ones.
60 (let ((elt (assq 'tool-bar-lines default-frame-alist
)))
63 (add-to-list 'default-frame-alist
(cons 'tool-bar-lines lines
)))))
64 (if (and tool-bar-mode
66 (= 1 (length (default-value 'tool-bar-map
)))) ; not yet setup
69 (defvar tool-bar-map
(make-sparse-keymap)
70 "Keymap for the tool bar.
71 Define this locally to override the global tool bar.")
73 (global-set-key [tool-bar
]
74 '(menu-item "tool bar" ignore
75 :filter
(lambda (ignore) tool-bar-map
)))
78 (defun tool-bar-add-item (icon def key
&rest props
)
79 "Add an item to the tool bar.
80 ICON names the image, DEF is the key definition and KEY is a symbol
81 for the fake function key in the menu keymap. Remaining arguments
82 PROPS are additional items to add to the menu item specification. See
83 Info node `(elisp)Tool Bar'. Items are added from left to right.
85 ICON is the base name of a file containing the image to use. The
86 function will first try to use ICON.xpm, then ICON.pbm, and finally
87 ICON.xbm, using `find-image'.
89 Keybindings are made in the map `tool-bar-map'. To define items in
90 some local map, bind `tool-bar-map' with `let' around calls of this
92 (let* ((fg (face-attribute 'tool-bar
:foreground
))
93 (bg (face-attribute 'tool-bar
:background
))
94 (colors (nconc (if (eq fg
'unspecified
) nil
(list :foreground fg
))
95 (if (eq bg
'unspecified
) nil
(list :background bg
))))
98 (list (list :type
'xpm
:file
(concat icon
".xpm"))
99 (append (list :type
'pbm
:file
(concat icon
".pbm"))
101 (append (list :type
'xbm
:file
(concat icon
".xbm"))
103 (list (append (list :type
'pbm
:file
(concat icon
".pbm"))
105 (append (list :type
'xbm
:file
(concat icon
".xbm"))
107 (list :type
'xpm
:file
(concat icon
".xpm")))))))
108 (when (and (display-images-p) image
)
109 (unless (image-mask-p image
)
110 (setq image
(append image
'(:mask heuristic
))))
111 (define-key-after tool-bar-map
(vector key
)
112 `(menu-item ,(symbol-name key
) ,def
:image
,image
,@props
)))))
115 (defun tool-bar-add-item-from-menu (command icon
&optional map
&rest props
)
116 "Define tool bar binding for COMMAND using the given ICON in keymap MAP.
117 The binding of COMMAND is looked up in the menu bar in MAP (default
118 `global-map') and modified to add an image specification for ICON, which
119 is looked for as by `tool-bar-add-item'.
120 MAP must contain an appropriate keymap bound to `[menu-bar]'.
121 PROPS is a list of additional properties to add to the binding.
123 Keybindings are made in the map `tool-bar-map'. To define items in
124 some local map, bind `tool-bar-map' with `let' around calls of this
127 (setq map global-map
))
128 (let* ((menu-bar-map (lookup-key map
[menu-bar
]))
129 (keys (where-is-internal command menu-bar-map
))
130 (fg (face-attribute 'tool-bar
:foreground
))
131 (bg (face-attribute 'tool-bar
:background
))
132 (colors (nconc (if (eq fg
'unspecified
) nil
(list :foreground fg
))
133 (if (eq bg
'unspecified
) nil
(list :background bg
))))
134 (spec (if (display-color-p)
135 (list (list :type
'xpm
:file
(concat icon
".xpm"))
136 (append (list :type
'pbm
:file
(concat icon
".pbm"))
138 (append (list :type
'xbm
:file
(concat icon
".xbm"))
140 (list (append (list :type
'pbm
:file
(concat icon
".pbm"))
142 (append (list :type
'xbm
:file
(concat icon
".xbm"))
144 (list :type
'xpm
:file
(concat icon
".xpm")))))
145 (image (find-image spec
))
147 (when (and (display-images-p) image
)
148 ;; We'll pick up the last valid entry in the list of keys if
149 ;; there's more than one.
151 ;; We're looking for a binding of the command in a submap of
152 ;; the menu bar map, so the key sequence must be two or more
156 (let ((m (lookup-key menu-bar-map
(substring k
0 -
1)))
157 ;; Last element in the bound key sequence:
158 (kk (aref k
(1- (length k
)))))
163 (when (and (symbolp submap
) (boundp submap
))
164 (setq submap
(eval submap
)))
165 (unless (image-mask-p image
)
166 (setq image
(append image
'(:mask heuristic
))))
167 (let ((defn (assq key
(cdr submap
))))
168 (if (eq (cadr defn
) 'menu-item
)
169 (define-key-after tool-bar-map
(vector key
)
170 (append (cdr defn
) (list :image image
) props
))
171 (setq defn
(cdr defn
))
172 (define-key-after tool-bar-map
(vector key
)
173 (append `(menu-item ,(car defn
) ,(cddr defn
))
174 (list :image image
) props
)))))))
176 ;;; Set up some global items. Additions/deletions up for grabs.
178 (defun tool-bar-setup ()
179 ;; People say it's bad to have EXIT on the tool bar, since users
180 ;; might inadvertently click that button.
181 ;;(tool-bar-add-item-from-menu 'save-buffers-kill-emacs "exit")
182 (tool-bar-add-item-from-menu 'find-file
"new")
183 (tool-bar-add-item-from-menu 'dired
"open")
184 (tool-bar-add-item-from-menu 'kill-this-buffer
"close")
185 (tool-bar-add-item-from-menu 'save-buffer
"save" nil
186 :visible
'(or buffer-file-name
190 (tool-bar-add-item-from-menu 'write-file
"saveas" nil
191 :visible
'(or buffer-file-name
195 (tool-bar-add-item-from-menu 'undo
"undo" nil
196 :visible
'(not (eq 'special
(get major-mode
198 (tool-bar-add-item-from-menu 'kill-region
"cut" nil
199 :visible
'(not (eq 'special
(get major-mode
201 (tool-bar-add-item-from-menu 'menu-bar-kill-ring-save
"copy")
202 (tool-bar-add-item-from-menu 'yank
"paste" nil
203 :visible
'(not (eq 'special
(get major-mode
205 (tool-bar-add-item-from-menu 'nonincremental-search-forward
"search")
206 ;;(tool-bar-add-item-from-menu 'ispell-buffer "spell")
208 ;; There's no icon appropriate for News and we need a command rather
209 ;; than a lambda for Read Mail.
210 ;;(tool-bar-add-item-from-menu 'compose-mail "mail_compose")
212 (tool-bar-add-item-from-menu 'print-buffer
"print")
213 (tool-bar-add-item "preferences" 'customize
'customize
214 :help
"Edit preferences (customize)")
216 (tool-bar-add-item "help" (lambda ()
218 (popup-menu menu-bar-help-menu
))
220 :help
"Pop up the Help menu")
225 ;;; tool-bar.el ends here