Mercurial > emacs
comparison lisp/tool-bar.el @ 66168:28718fa5d988
Moved all remaining images from lisp/toolbar to etc/images, moved
lisp/toolbar/tool-bar to lisp and "deleted" lisp/toolbar. The low
resolution images were placed in their own directory (low-color).
Replaced underscore (_) in filenames with dash (-) per convention
* make-dist: Create and populate etc/images/low-color.
* admin/FOR-RELEASE (DOCUMENTATION): Removed lisp/toolbar from list
since it's gone. Also marked mh-e as done.
* lisp/toolbar/attach.*, lisp/toolbar/cancel.*, lisp/toolbar/close.*:
* lisp/toolbar/copy.*, lisp/toolbar/cut.*, lisp/toolbar/diropen.*:
* lisp/toolbar/exit.*, lisp/toolbar/help.*, lisp/toolbar/home.*:
* lisp/toolbar/index.*, lisp/toolbar/info.*, lisp/toolbar/mail.*:
* lisp/toolbar/new.*, lisp/toolbar/open.*, lisp/toolbar/paste.*, *
* lisp/toolbar/preferences.*, lisp/toolbar/print.*, lisp/toolbar/save.*:
* lisp/toolbar/saveas.*, lisp/toolbar/search.*:
* lisp/toolbar/search-replace.*: lisp/toolbar/spell.*:
* lisp/toolbar/undo.*: Moved to etc/images.
* lisp/toolbar/lc-copy.*: Moved to etc/images/low-color/copy.*.
* lisp/toolbar/lc-cut.*: Moved to etc/images/low-color/cut.*.
* lisp/toolbar/lc-help.*: Moved to etc/images/low-color/help.*.
* lisp/toolbar/lc-home.*: Moved to etc/images/low-color/home.*.
* lisp/toolbar/lc-index.*: Moved to etc/images/low-color/index.*.
* lisp/toolbar/lc-new.*: Moved to etc/images/low-color/new.*.
* lisp/toolbar/lc-open.*: Moved to etc/images/low-color/open.*.
* lisp/toolbar/lc-paste.*: Moved to etc/images/low-color/paste.*.
* lisp/toolbar/lc-preferences.*: Moved to etc/images/low-color/preferences.*.
* lisp/toolbar/lc-print.*: Moved to etc/images/low-color/print.*.
* lisp/toolbar/lc-save.*: Moved to etc/images/low-color/save.*.
* lisp/toolbar/lc-saveas.*: Moved to etc/images/low-color/saveas.*.
* lisp/toolbar/lc-search.*: Moved to etc/images/low-color/search.*.
* lisp/toolbar/lc-spell.*: Moved to etc/images/low-color/spell.*.
* lisp/toolbar/lc-undo.*: Moved to etc/images/low-color/undo.*.
To conform with convention, the underscore (_) in the following image
names were replaced with dash (-) or (/) as appropriate.
* lisp/toolbar/back_arrow.*: Moved to etc/images/back-arrow.*.
* lisp/toolbar/fld_open.*: Moved to etc/images/fld-open.*.
* lisp/toolbar/fwd_arrow.*: Moved to etc/images/fwd-arrow.*.
* lisp/toolbar/jump_to.*: Moved to etc/images/jump-to.*.
* lisp/toolbar/left_arrow.*: Moved to etc/images/left-arrow.*.
* lisp/toolbar/right_arrow.*: Moved to etc/images/right-arrow.*.
* lisp/toolbar/up_arrow.*: Moved to etc/images/up-arrow.*.
* lisp/toolbar/lc-back_arrow.*.: Moved to etc/images/low-color/back-arrow.*.
* lisp/toolbar/lc-fwd_arrow.*.: Moved to etc/images/low-color/fwd-arrow.*.
* lisp/toolbar/lc-jump_to.*: Moved to etc/images/low-color/jump-to.*.
* lisp/toolbar/lc-left_arrow.*.: Moved to etc/images/low-color/left-arrow.*.
* lisp/toolbar/lc-right_arrow.*.: Moved to etc/images/low-color/right-arrow.*.
* lisp/toolbar/lc-up_arrow.*: Moved to etc/images/low-color/up-arrow.*.
* lisp/toolbar/mail_compose.*.: Moved to etc/images/mail/compose.*.
* lisp/toolbar/mail_send.*: Moved to etc/images/mail/send.*.
* lisp/info.el (info-tool-bar-map): Replaced underscores in image
names with dashes.
* lisp/makefile.w32-in (WINS): Removed toolbar.
* lisp/menu-bar.el: Replaced toolbar/tool-bar.el with tool-bar.el in
comment.
* lisp/tool-bar.el: Moved to lisp from lisp/toolbar. Now that
lisp/toolbar is empty, it should be deleted when folks run "cvs up
-P".
* etc/images/README: Incorporated the content of lisp/toolbar/README
now that all of the images are here.
author | Bill Wohler <wohler@newt.com> |
---|---|
date | Mon, 17 Oct 2005 22:21:06 +0000 |
parents | |
children | b9971215f644 |
comparison
equal
deleted
inserted
replaced
66167:60d4cad2cd95 | 66168:28718fa5d988 |
---|---|
1 ;;; tool-bar.el --- setting up the tool bar | |
2 ;; | |
3 ;; Copyright (C) 2000, 2001, 2002, 2003, 2004, | |
4 ;; 2005 Free Software Foundation, Inc. | |
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 | |
23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, | |
24 ;; Boston, MA 02110-1301, USA. | |
25 | |
26 ;;; Commentary: | |
27 | |
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'. | |
31 | |
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' | |
38 ;; property.) | |
39 | |
40 ;; Todo: Somehow make tool bars easily customizable by the naive? | |
41 | |
42 ;;; Code: | |
43 | |
44 ;;;###autoload | |
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. | |
48 | |
49 See `tool-bar-add-item' and `tool-bar-add-item-from-menu' for | |
50 conveniently adding tool bar items." | |
51 :init-value nil | |
52 :global t | |
53 :group 'mouse | |
54 :group 'frames | |
55 (and (display-images-p) | |
56 (let ((lines (if tool-bar-mode 1 0))) | |
57 ;; Alter existing frames... | |
58 (mapc (lambda (frame) | |
59 (modify-frame-parameters frame | |
60 (list (cons 'tool-bar-lines lines)))) | |
61 (frame-list)) | |
62 ;; ...and future ones. | |
63 (let ((elt (assq 'tool-bar-lines default-frame-alist))) | |
64 (if elt | |
65 (setcdr elt lines) | |
66 (add-to-list 'default-frame-alist (cons 'tool-bar-lines lines))))) | |
67 (if (and tool-bar-mode | |
68 (display-graphic-p) | |
69 (= 1 (length (default-value 'tool-bar-map)))) ; not yet setup | |
70 (tool-bar-setup)))) | |
71 | |
72 ;;;###autoload | |
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, | |
79 ;; please do so. | |
80 ;; -- Per Abrahamsen <abraham@dina.kvl.dk> 2002-02-21. | |
81 (put 'tool-bar-mode 'standard-value '(t)) | |
82 | |
83 (defvar tool-bar-map (make-sparse-keymap) | |
84 "Keymap for the tool bar. | |
85 Define this locally to override the global tool bar.") | |
86 | |
87 (global-set-key [tool-bar] | |
88 '(menu-item "tool bar" ignore | |
89 :filter (lambda (ignore) tool-bar-map))) | |
90 | |
91 ;;;###autoload | |
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. | |
98 | |
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'. | |
103 | |
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)) | |
107 | |
108 ;;;###autoload | |
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. | |
115 | |
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) | |
126 nil | |
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)) | |
133 (image (find-image | |
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))))) | |
137 | |
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))))) | |
143 | |
144 ;;;###autoload | |
145 (defun tool-bar-add-item-from-menu (command icon &optional map &rest props) | |
146 "Define tool bar binding for COMMAND using the given ICON in keymap MAP. | |
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. | |
152 | |
153 MAP must contain appropriate binding for `[menu-bar]' which holds a keymap. | |
154 | |
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'." | |
157 (apply 'tool-bar-local-item-from-menu command icon | |
158 (default-value 'tool-bar-map) map props)) | |
159 | |
160 ;;;###autoload | |
161 (defun tool-bar-local-item-from-menu (command icon in-map &optional from-map &rest props) | |
162 "Define tool bar binding for COMMAND using the given ICON in keymap MAP. | |
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. | |
168 | |
169 MAP must contain appropriate binding for `[menu-bar]' which holds a keymap." | |
170 (unless from-map | |
171 (setq from-map global-map)) | |
172 (let* ((menu-bar-map (lookup-key from-map [menu-bar])) | |
173 (keys (where-is-internal command menu-bar-map)) | |
174 (fg (face-attribute 'tool-bar :foreground)) | |
175 (bg (face-attribute 'tool-bar :background)) | |
176 (colors (nconc (if (eq fg 'unspecified) nil (list :foreground fg)) | |
177 (if (eq bg 'unspecified) nil (list :background bg)))) | |
178 (xpm-spec (list :type 'xpm :file (concat icon ".xpm"))) | |
179 (xpm-lo-spec (if (> (display-color-cells) 256) | |
180 nil | |
181 (list :type 'xpm :file | |
182 (concat "low-color/" icon ".xpm")))) | |
183 (pbm-spec (append (list :type 'pbm :file | |
184 (concat icon ".pbm")) colors)) | |
185 (xbm-spec (append (list :type 'xbm :file | |
186 (concat icon ".xbm")) colors)) | |
187 (spec (if (display-color-p) | |
188 (list xpm-lo-spec xpm-spec pbm-spec xbm-spec) | |
189 (list pbm-spec xbm-spec xpm-lo-spec xpm-spec))) | |
190 (image (find-image spec)) | |
191 submap key) | |
192 (when (and (display-images-p) image) | |
193 ;; We'll pick up the last valid entry in the list of keys if | |
194 ;; there's more than one. | |
195 (dolist (k keys) | |
196 ;; We're looking for a binding of the command in a submap of | |
197 ;; the menu bar map, so the key sequence must be two or more | |
198 ;; long. | |
199 (if (and (vectorp k) | |
200 (> (length k) 1)) | |
201 (let ((m (lookup-key menu-bar-map (substring k 0 -1))) | |
202 ;; Last element in the bound key sequence: | |
203 (kk (aref k (1- (length k))))) | |
204 (if (and (keymapp m) | |
205 (symbolp kk)) | |
206 (setq submap m | |
207 key kk))))) | |
208 (when (and (symbolp submap) (boundp submap)) | |
209 (setq submap (eval submap))) | |
210 (unless (image-mask-p image) | |
211 (setq image (append image '(:mask heuristic)))) | |
212 (let ((defn (assq key (cdr submap)))) | |
213 (if (eq (cadr defn) 'menu-item) | |
214 (define-key-after in-map (vector key) | |
215 (append (cdr defn) (list :image image) props)) | |
216 (setq defn (cdr defn)) | |
217 (define-key-after in-map (vector key) | |
218 (let ((rest (cdr defn))) | |
219 ;; If the rest of the definition starts | |
220 ;; with a list of menu cache info, get rid of that. | |
221 (if (and (consp rest) (consp (car rest))) | |
222 (setq rest (cdr rest))) | |
223 (append `(menu-item ,(car defn) ,rest) | |
224 (list :image image) props)))))))) | |
225 | |
226 ;;; Set up some global items. Additions/deletions up for grabs. | |
227 | |
228 (defun tool-bar-setup () | |
229 ;; People say it's bad to have EXIT on the tool bar, since users | |
230 ;; might inadvertently click that button. | |
231 ;;(tool-bar-add-item-from-menu 'save-buffers-kill-emacs "exit") | |
232 (tool-bar-add-item-from-menu 'find-file "new") | |
233 (tool-bar-add-item-from-menu 'find-file-existing "open") | |
234 (tool-bar-add-item-from-menu 'dired "diropen") | |
235 (tool-bar-add-item-from-menu 'kill-this-buffer "close") | |
236 (tool-bar-add-item-from-menu 'save-buffer "save" nil | |
237 :visible '(or buffer-file-name | |
238 (not (eq 'special | |
239 (get major-mode | |
240 'mode-class))))) | |
241 (tool-bar-add-item-from-menu 'write-file "saveas" nil | |
242 :visible '(or buffer-file-name | |
243 (not (eq 'special | |
244 (get major-mode | |
245 'mode-class))))) | |
246 (tool-bar-add-item-from-menu 'undo "undo" nil | |
247 :visible '(not (eq 'special (get major-mode | |
248 'mode-class)))) | |
249 (tool-bar-add-item-from-menu (lookup-key menu-bar-edit-menu [cut]) | |
250 "cut" nil | |
251 :visible '(not (eq 'special (get major-mode | |
252 'mode-class)))) | |
253 (tool-bar-add-item-from-menu (lookup-key menu-bar-edit-menu [copy]) | |
254 "copy") | |
255 (tool-bar-add-item-from-menu (lookup-key menu-bar-edit-menu [paste]) | |
256 "paste" nil | |
257 :visible '(not (eq 'special (get major-mode | |
258 'mode-class)))) | |
259 (tool-bar-add-item-from-menu 'nonincremental-search-forward "search") | |
260 ;;(tool-bar-add-item-from-menu 'ispell-buffer "spell") | |
261 | |
262 ;; There's no icon appropriate for News and we need a command rather | |
263 ;; than a lambda for Read Mail. | |
264 ;;(tool-bar-add-item-from-menu 'compose-mail "mail/compose") | |
265 | |
266 (tool-bar-add-item-from-menu 'print-buffer "print") | |
267 (tool-bar-add-item "preferences" 'customize 'customize | |
268 :help "Edit preferences (customize)") | |
269 | |
270 (tool-bar-add-item "help" (lambda () | |
271 (interactive) | |
272 (popup-menu menu-bar-help-menu)) | |
273 'help | |
274 :help "Pop up the Help menu") | |
275 ) | |
276 | |
277 (provide 'tool-bar) | |
278 | |
279 ;;; arch-tag: 15f30f0a-d0d7-4d50-bbb7-f48fd0c8582f | |
280 ;;; tool-bar.el ends here |