|
173
|
1 ;;; edit-toolbar.el --- Interactive toolbar editing mode for XEmacs
|
|
|
2
|
|
|
3 ;; Copyright (C) 1996 Peter D. Pezaris
|
|
|
4
|
|
|
5 ;; Author: Peter D. Pezaris <pez@dwwc.com>
|
|
|
6 ;; Keywords: tools
|
|
|
7
|
|
|
8 ;; This file is part of XEmacs.
|
|
|
9
|
|
|
10 ;; XEmacs is free software; you can redistribute it and/or modify it
|
|
|
11 ;; under the terms of the GNU General Public License as published by
|
|
|
12 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
13 ;; any later version.
|
|
|
14
|
|
|
15 ;; XEmacs is distributed in the hope that it will be useful, but
|
|
|
16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
|
18 ;; General Public License for more details.
|
|
|
19
|
|
|
20 ;; You should have received a copy of the GNU General Public License
|
|
|
21 ;; along with XEmacs; see the file COPYING. If not, write to the Free
|
|
|
22 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
|
|
|
23 ;; 02111-1307, USA.
|
|
|
24
|
|
|
25 ;;; Synched up with: Not in FSF
|
|
|
26
|
|
|
27 ;;; Commentary:
|
|
|
28
|
|
|
29 ;; To use edit-toolbar.el, simply type M-x edit-toolbar RET
|
|
|
30
|
|
|
31 ;; For help on the various commands you can type ? in a edit-toolbar
|
|
|
32 ;; buffer. To save a modified toolbar type C-x C-s in an edit-toolbar
|
|
|
33 ;; buffer. If you want to use a saved toolbar in your future XEmacs
|
|
|
34 ;; sessions, add the following line of code to your .emacs file:
|
|
|
35
|
|
|
36 ;; (load "~/.xemacs/.toolbar")
|
|
|
37
|
|
|
38 ;; Acknowledgements:
|
|
|
39
|
|
|
40 ;; Many thanks to Stig <stig@hackvan.com> and Ben Wing <wing@666.com>
|
|
|
41 ;; for writing edit-faces.el, on which much of this code is based.
|
|
|
42
|
|
|
43 ;; To do:
|
|
|
44
|
|
|
45 ;; o The function edit-toolbar-quit should do something other than just
|
|
|
46 ;; bury the buffer.
|
|
|
47 ;; o Dynamically add new items to edit-toolbar-button-alist as new buttons
|
|
|
48 ;; are added.
|
|
183
|
49 ;; o Allow more than one toolbar to be saved in the ~/.xemacs/.toolbar file.
|
|
|
50 ;; o Allow buttons to be copied from any toolbar.
|
|
|
51 ;; o Allow multiple toolbars to be edited simultaneously.
|
|
|
52
|
|
|
53 ;;; Change Log:
|
|
|
54
|
|
|
55 ;; Modified by Mike Scheidler <c23mts@eng.delcoelect.com> 25 Jul 1997
|
|
|
56 ;; - Enabled editing of any toolbar (not just `default-toolbar').
|
|
|
57 ;; - Added context sensitivity to `edit-toolbar-menu'.
|
|
|
58 ;; - Added support for `nil' toolbar item (left/right divider).
|
|
|
59 ;; - Enabled editing of empty toolbars.
|
|
185
|
60 ;; Modified by Jeff Miller <jmiller@smart.net> 17 Aug 1997
|
|
|
61 ;; - Modfied how added toolbar buttons are created and saved.
|
|
173
|
62
|
|
|
63 ;;; Code:
|
|
|
64
|
|
185
|
65 (defvar edit-toolbar-version "1.03"
|
|
173
|
66 "Version of Edit Toolbar.")
|
|
|
67
|
|
183
|
68 (defvar edit-toolbar-temp-toolbar-name nil
|
|
|
69 "Value of toolbar being edited.")
|
|
|
70
|
|
|
71 (defvar edit-toolbar-temp-toolbar nil
|
|
|
72 "Working copy of toolbar being edited.")
|
|
|
73
|
|
|
74 (defvar edit-toolbar-fallback-toolbar nil
|
|
|
75 "Toolbar definition to use when reverting.")
|
|
173
|
76
|
|
|
77 (defvar edit-toolbar-file-name (concat "~"
|
|
|
78 (if (boundp 'emacs-user-extension-dir)
|
|
|
79 emacs-user-extension-dir
|
|
|
80 "/")
|
|
|
81 ".toolbar")
|
|
|
82 "File name to save toolbars to. Defaults to \"~/.xemacs/.toolbar\"")
|
|
|
83
|
|
185
|
84 (defvar edit-toolbar-button-prefix "edit-toolbar-button"
|
|
|
85 "Prefix to use when naming new buttons created by edit-toolbar.
|
|
|
86 The new buttons will be stored in the file named by edit-toolbar-file-name")
|
|
|
87
|
|
|
88 (defvar edit-toolbar-added-buttons-alist nil
|
|
|
89 "Buttons added by edit-toolbar.
|
|
|
90 A list of cons cells. The car is the variable which stores the glyph data.
|
|
|
91 The cdr is a list of filenames to be passed as arguments to
|
|
|
92 toolbar-make-button-list when the toolbar file is read at startup.")
|
|
|
93
|
|
173
|
94 (defvar edit-toolbar-menu
|
|
|
95 '("Edit Toolbar"
|
|
183
|
96 ["Move This Item Up" edit-toolbar-up (>= (edit-toolbar-current-index) 0)]
|
|
|
97 ["Move This Item Down" edit-toolbar-down (>= (edit-toolbar-current-index) 0)]
|
|
|
98 ["Set Function" edit-toolbar-set-function (edit-toolbar-button-p)]
|
|
|
99 ["Set Help String" edit-toolbar-set-help (edit-toolbar-button-p)]
|
|
|
100 ["Copy This Button" edit-toolbar-copy (edit-toolbar-button-p)]
|
|
|
101 ["Remove This Item" edit-toolbar-kill (>= (edit-toolbar-current-index) 0)]
|
|
173
|
102 "----"
|
|
|
103 ["Add Button..." edit-toolbar-add-button t]
|
|
|
104 ("Add Separator"
|
|
183
|
105 ["2D (narrow)" edit-toolbar-add-separator-2D-narrow t]
|
|
173
|
106 ["3D (narrow)" edit-toolbar-add-separator-3D-narrow t]
|
|
|
107 ["2D (wide)" edit-toolbar-add-separator-2D-wide t]
|
|
|
108 ["3D (wide)" edit-toolbar-add-separator-3D-wide t]
|
|
183
|
109 ["Right/left divider" edit-toolbar-add-separator-right-left t]
|
|
173
|
110 )
|
|
|
111 "----"
|
|
183
|
112 ["Restore Default Toolbar " edit-toolbar-restore (buffer-modified-p)]
|
|
|
113 ["Save This Toolbar" edit-toolbar-save (buffer-modified-p)]
|
|
173
|
114 "----"
|
|
|
115 ["Help" describe-mode t]
|
|
|
116 "----"
|
|
|
117 ["Quit" edit-toolbar-quit t]
|
|
|
118 )
|
|
|
119 )
|
|
|
120
|
|
|
121 (defvar edit-toolbar-map
|
|
|
122 (let ((map (make-sparse-keymap)))
|
|
|
123 (suppress-keymap map)
|
|
|
124 (define-key map "q" 'edit-toolbar-quit)
|
|
|
125 (define-key map "n" 'edit-toolbar-next)
|
|
|
126 (define-key map "p" 'edit-toolbar-previous)
|
|
|
127 (define-key map " " 'edit-toolbar-next)
|
|
|
128 (define-key map "?" 'describe-mode)
|
|
|
129 (define-key map "f" 'edit-toolbar-set-function)
|
|
|
130 (define-key map "h" 'edit-toolbar-set-help)
|
|
|
131 (define-key map "a" 'edit-toolbar-add-button)
|
|
|
132 (define-key map "2" 'edit-toolbar-add-separator-2D-narrow)
|
|
|
133 (define-key map "@" 'edit-toolbar-add-separator-2D-wide)
|
|
|
134 (define-key map "3" 'edit-toolbar-add-separator-3D-narrow)
|
|
|
135 (define-key map "#" 'edit-toolbar-add-separator-3D-wide)
|
|
183
|
136 (define-key map "R" 'edit-toolbar-add-separator-right-left)
|
|
173
|
137 (define-key map "c" 'edit-toolbar-copy)
|
|
|
138 (define-key map "d" 'edit-toolbar-down)
|
|
|
139 (define-key map "u" 'edit-toolbar-up)
|
|
|
140 (define-key map "k" 'edit-toolbar-kill)
|
|
|
141 (define-key map "s" 'edit-toolbar-save)
|
|
|
142 (define-key map "\C-x\C-s" 'edit-toolbar-save)
|
|
|
143 (define-key map "r" 'edit-toolbar-restore)
|
|
|
144 (define-key map 'return 'edit-toolbar-next)
|
|
|
145 (define-key map 'delete 'edit-toolbar-previous)
|
|
|
146 map
|
|
|
147 ))
|
|
|
148
|
|
183
|
149 (defun edit-toolbar-create-toolbar-alist ()
|
|
|
150 (setq edit-toolbar-toolbar-alist nil)
|
|
|
151 (mapatoms
|
|
|
152 (lambda (sym)
|
|
|
153 (if (and (boundp sym)
|
|
|
154 (toolbar-specifier-p (symbol-value sym))
|
|
|
155 (not (string-match "^edit-toolbar" (symbol-name sym))))
|
|
|
156 (setq edit-toolbar-toolbar-alist
|
|
|
157 (cons (cons (symbol-name sym) sym)
|
|
|
158 edit-toolbar-toolbar-alist))))))
|
|
|
159
|
|
173
|
160 ;;;###autoload
|
|
183
|
161 (defun edit-toolbar (&optional toolbar)
|
|
|
162 "Alter toolbar characteristics by editing a buffer representing the specified toolbar.
|
|
|
163 Pops up a buffer containing a list of the toolbar matching TOOLBAR_NAME."
|
|
173
|
164 (interactive)
|
|
183
|
165 (edit-toolbar-create-toolbar-alist)
|
|
|
166 (if (eq toolbar nil)
|
|
|
167 (setq toolbar (intern-soft
|
|
|
168 (completing-read
|
|
|
169 "Toolbar: " edit-toolbar-toolbar-alist))))
|
|
|
170 (if (not (toolbar-specifier-p (symbol-value toolbar)))
|
|
|
171 (error (format "Toolbar named %s not found" (prin1 toolbar))))
|
|
173
|
172 (pop-to-buffer (get-buffer-create "*Edit Toolbar*"))
|
|
183
|
173 (setq edit-toolbar-temp-toolbar (symbol-value toolbar))
|
|
|
174 (setq edit-toolbar-temp-toolbar-name (symbol-name toolbar))
|
|
|
175 (setq edit-toolbar-fallback-toolbar
|
|
|
176 (specifier-instance (symbol-value toolbar)))
|
|
|
177 (edit-toolbar-create-button-alist)
|
|
173
|
178 (edit-toolbar-list)
|
|
|
179 (set-buffer-modified-p nil)
|
|
|
180 (edit-toolbar-mode)
|
|
|
181 (set-face-foreground 'default "black" (current-buffer))
|
|
|
182 (set-face-background 'default "grey75" (current-buffer))
|
|
183
|
183 (set-face-background-pixmap 'default "nil" (current-buffer))
|
|
173
|
184 (set-face-foreground 'list-mode-item-selected "yellow" (current-buffer))
|
|
|
185 (set-face-background 'list-mode-item-selected "black" (current-buffer)))
|
|
|
186
|
|
|
187 (define-derived-mode edit-toolbar-mode list-mode "Edit-Toolbar"
|
|
|
188 "Major mode for 'edit-toolbar' buffers.
|
|
|
189
|
|
|
190 Editing commands:
|
|
|
191
|
|
|
192 \\{edit-toolbar-map}"
|
|
|
193 (setq mode-popup-menu edit-toolbar-menu)
|
|
209
|
194 (if (and (featurep 'menubar))
|
|
|
195 current-menubar
|
|
173
|
196 (progn
|
|
|
197 (set (make-local-variable 'current-menubar)
|
|
|
198 (copy-sequence current-menubar))
|
|
|
199 (add-submenu nil edit-toolbar-menu)))
|
|
|
200 (use-local-map edit-toolbar-map)
|
|
|
201 (setq buffer-read-only nil)
|
|
|
202 (message "Edit Toolbar Version %s. Type \"?\" for help." edit-toolbar-version))
|
|
|
203
|
|
|
204 (defun edit-toolbar-list ()
|
|
|
205 (erase-buffer)
|
|
|
206 (edit-toolbar-insert-item 'header)
|
|
183
|
207 (mapcar (function (lambda (item)
|
|
|
208 (edit-toolbar-insert-item item)))
|
|
|
209 (specifier-instance edit-toolbar-temp-toolbar))
|
|
173
|
210 (goto-char (point-min)))
|
|
|
211
|
|
183
|
212 (defun edit-toolbar-button-p ()
|
|
|
213 "Returns t if the currently selected edit-toolbar item is a button."
|
|
|
214 (let ((item (edit-toolbar-current-item)))
|
|
|
215 (not (or (eq item nil)
|
|
|
216 (eq (aref item 0) :style)
|
|
|
217 (eq (aref item 0) :size)))))
|
|
|
218
|
|
|
219 (defun edit-toolbar-current-index ()
|
|
|
220 "Returns the offset of the currently selected edit-toolbar item."
|
|
|
221 (- (count-lines (point-min) (point)) 2))
|
|
|
222
|
|
|
223 (defun edit-toolbar-current-item ()
|
|
|
224 "Returns the value of the currently selected edit-toolbar item."
|
|
|
225 (let ((toolbar (specifier-instance edit-toolbar-temp-toolbar)))
|
|
|
226 (nth (edit-toolbar-current-index) toolbar)))
|
|
|
227
|
|
173
|
228 (defun edit-toolbar-quit ()
|
|
|
229 "Quit an Edit Toolbar session. This simply buries the buffer."
|
|
|
230 (interactive)
|
|
|
231 ;;FIXME
|
|
|
232 (bury-buffer))
|
|
|
233
|
|
|
234 (defun edit-toolbar-next ()
|
|
|
235 "Move to the next line in the Edit Toolbar buffer."
|
|
|
236 (interactive)
|
|
|
237 (next-line 1))
|
|
|
238
|
|
|
239 (defun edit-toolbar-previous ()
|
|
|
240 "Move to the previous line in the Edit Toolbar buffer."
|
|
|
241 (interactive)
|
|
|
242 (next-line -1))
|
|
|
243
|
|
|
244 (defun edit-toolbar-set-function (func)
|
|
|
245 "Set the function for the selected toolbar button."
|
|
|
246 (interactive "aNew Function: ")
|
|
183
|
247 (let ((index (edit-toolbar-current-index)))
|
|
|
248 (if (not (edit-toolbar-button-p))
|
|
|
249 (error "Not a button")
|
|
|
250 (setf (aref (edit-toolbar-current-item) 1) func)
|
|
|
251 (edit-toolbar-list)
|
|
|
252 (forward-line (+ index 2)))))
|
|
173
|
253
|
|
|
254 (defun edit-toolbar-set-help (help)
|
|
|
255 "Set the help string for the selected toolbar button."
|
|
|
256 (interactive "sNew Help String: ")
|
|
183
|
257 (let ((index (edit-toolbar-current-index)))
|
|
|
258 (if (not (edit-toolbar-button-p))
|
|
|
259 (error "Not a button")
|
|
|
260 (setf (aref (edit-toolbar-current-item) 3) help)
|
|
|
261 (edit-toolbar-list)
|
|
|
262 (forward-line (+ index 2)))))
|
|
173
|
263
|
|
|
264 (defun edit-toolbar-copy ()
|
|
|
265 "Make a copy of the selected toolbar button."
|
|
|
266 (interactive)
|
|
183
|
267 (let ((index (edit-toolbar-current-index)))
|
|
|
268 (if (not (edit-toolbar-button-p))
|
|
|
269 (error "Not a button")
|
|
|
270 (setcdr (nthcdr index (specifier-instance edit-toolbar-temp-toolbar))
|
|
|
271 (cons (edit-toolbar-current-item)
|
|
|
272 (nthcdr (1+ index)
|
|
|
273 (specifier-instance edit-toolbar-temp-toolbar))))
|
|
|
274 (edit-toolbar-list)
|
|
|
275 (forward-line (+ index 3)))))
|
|
173
|
276
|
|
|
277 (defun edit-toolbar-down ()
|
|
|
278 "Move the current toolbar button down (right) one position."
|
|
|
279 (interactive)
|
|
183
|
280 (let* ((toolbar (specifier-instance edit-toolbar-temp-toolbar))
|
|
173
|
281 (index (- (count-lines (point-min) (point)) 2))
|
|
183
|
282 (item (nth index toolbar)))
|
|
173
|
283 (if (eq (1+ index) (length toolbar))
|
|
|
284 (error "Already at the bottom of the toolbar."))
|
|
|
285 (if (eq index 0)
|
|
|
286 (setq toolbar (cdr toolbar))
|
|
|
287 (setcdr (nthcdr (1- index) toolbar)
|
|
|
288 (nthcdr (1+ index) toolbar)))
|
|
|
289 (setcdr (nthcdr index toolbar)
|
|
|
290 (cons item (nthcdr (1+ index) toolbar)))
|
|
183
|
291 (set-specifier
|
|
|
292 (symbol-value (intern-soft edit-toolbar-temp-toolbar-name)) toolbar)
|
|
173
|
293 (edit-toolbar-list)
|
|
|
294 (forward-line (+ index 3))))
|
|
|
295
|
|
|
296 (defun edit-toolbar-up ()
|
|
|
297 "Move the current toolbar button up (left) one position."
|
|
|
298 (interactive)
|
|
183
|
299 (let* ((toolbar (specifier-instance edit-toolbar-temp-toolbar))
|
|
173
|
300 (index (- (count-lines (point-min) (point)) 2))
|
|
|
301 (item (nth index toolbar)))
|
|
183
|
302 (if (<= index 0)
|
|
173
|
303 (error "Already at the top of the toolbar."))
|
|
|
304 (setcdr (nthcdr (1- index) toolbar)
|
|
|
305 (nthcdr (1+ index) toolbar))
|
|
|
306 (if (eq index 1)
|
|
|
307 (setq toolbar (cons item toolbar))
|
|
|
308 (setcdr (nthcdr (- index 2) toolbar)
|
|
|
309 (cons item (nthcdr (- index 1) toolbar))))
|
|
183
|
310 (set-specifier
|
|
|
311 (symbol-value (intern-soft edit-toolbar-temp-toolbar-name)) toolbar)
|
|
173
|
312 (edit-toolbar-list)
|
|
|
313 (forward-line (+ index 1))))
|
|
|
314
|
|
|
315 (defun edit-toolbar-kill ()
|
|
|
316 "Remove the current toolbar button."
|
|
|
317 (interactive)
|
|
183
|
318 (let* ((toolbar (specifier-instance edit-toolbar-temp-toolbar))
|
|
185
|
319 (index (- (count-lines (point-min) (point)) 2))
|
|
|
320 (etk-scratch-list)
|
|
|
321 (button (elt (nth index toolbar) 0 )))
|
|
|
322
|
|
|
323 (mapcar
|
|
|
324 (lambda (cons)
|
|
|
325 (if (not (memq button cons))
|
|
|
326 (setq etk-scratch-list (append etk-scratch-list cons)))
|
|
|
327 )
|
|
|
328 edit-toolbar-added-buttons-alist)
|
|
|
329 (setq edit-toolbar-added-buttons-alist etk-scratch-list)
|
|
173
|
330 (if (eq index 0)
|
|
|
331 (setq toolbar (cdr toolbar))
|
|
|
332 (setcdr (nthcdr (1- index) toolbar)
|
|
|
333 (nthcdr (1+ index) toolbar)))
|
|
183
|
334 (set-specifier
|
|
|
335 (symbol-value (intern-soft edit-toolbar-temp-toolbar-name)) toolbar)
|
|
173
|
336 (edit-toolbar-list)
|
|
|
337 (forward-line (+ index 2))))
|
|
|
338
|
|
|
339 (defun edit-toolbar-insert-item (item)
|
|
|
340 (let ((line-format "%-30s %s\n")
|
|
|
341 icon function help)
|
|
|
342 (if (eq item 'header)
|
|
|
343 (progn
|
|
|
344 (setq function "Function"
|
|
|
345 help "Help String")
|
|
|
346 (insert-face "Icon\t" 'bold)
|
|
|
347 (insert-face (format line-format function help) 'bold))
|
|
183
|
348 (cond ((eq item nil)
|
|
|
349 (setq icon nil
|
|
|
350 function "-------------- Right/Left Divider --------------"
|
|
|
351 help ""))
|
|
|
352 ((or (eq (aref item 0) :style)
|
|
173
|
353 (eq (aref item 0) :size))
|
|
|
354 (setq icon nil
|
|
|
355 function "----------------------------------------"
|
|
|
356 help ""))
|
|
|
357 (t
|
|
|
358 (setq icon (if (listp (aref item 0))
|
|
|
359 (car (aref item 0))
|
|
|
360 (car (symbol-value (aref item 0))))
|
|
|
361 function (aref item 1)
|
|
|
362 help (aref item 3))))
|
|
|
363 (let ((st (point))
|
|
|
364 (fn #'(lambda (str callback data)
|
|
|
365 (let ((st1 (point)))
|
|
|
366 (insert str)
|
|
|
367 (add-list-mode-item st1 (point) nil callback data)))))
|
|
|
368 (insert "\t")
|
|
|
369 (funcall fn (format line-format function help) nil item)
|
|
|
370 (set-extent-begin-glyph (make-extent st (point)) icon)))))
|
|
|
371
|
|
|
372 (defun edit-toolbar-create-button-alist ()
|
|
|
373 (let ((button-alist nil)
|
|
183
|
374 (buttons (specifier-instance edit-toolbar-temp-toolbar)))
|
|
173
|
375 (while buttons
|
|
|
376 (setq button-alist
|
|
183
|
377 (if (arrayp (car buttons))
|
|
|
378 (cons (cons (symbol-name (aref (car buttons) 1)) (car buttons))
|
|
|
379 button-alist)
|
|
|
380 (cons (car buttons) button-alist)))
|
|
173
|
381 (setq buttons (cdr buttons)))
|
|
|
382 button-alist))
|
|
|
383
|
|
183
|
384 (defvar edit-toolbar-button-alist nil
|
|
|
385 "List of buttons in the toolbar currently being edited.")
|
|
|
386
|
|
|
387 (defvar edit-toolbar-toolbar-alist nil
|
|
|
388 "List of existing toolbars (used for completing read).")
|
|
173
|
389
|
|
|
390 (defun edit-toolbar-add-item (item)
|
|
|
391 "Add a toolbar item ITEM at the current location."
|
|
183
|
392 (let* ((toolbar (specifier-instance edit-toolbar-temp-toolbar))
|
|
173
|
393 (index (- (count-lines (point-min) (point)) 2)))
|
|
183
|
394 (if (<= index 0)
|
|
173
|
395 (setq toolbar (cons item toolbar))
|
|
|
396 (setcdr (nthcdr (- index 1) toolbar)
|
|
|
397 (cons item (nthcdr index toolbar))))
|
|
183
|
398 (set-specifier
|
|
|
399 (symbol-value (intern-soft edit-toolbar-temp-toolbar-name)) toolbar)
|
|
173
|
400 (edit-toolbar-list)
|
|
|
401 (forward-line (+ index 2))))
|
|
|
402
|
|
|
403 ;(defun edit-toolbar-check-for-save ()
|
|
|
404 ; (if (not (buffer-modified-p))
|
|
|
405 ; ()
|
|
|
406 ; (if (yes-or-no-p-maybe-dialog-box "
|
|
|
407
|
|
|
408 (defun edit-toolbar-restore ()
|
|
|
409 "Restore the default toolbar."
|
|
|
410 (interactive)
|
|
|
411 ; (edit-toolbar-check-for-save)
|
|
183
|
412 (set-specifier edit-toolbar-temp-toolbar
|
|
|
413 edit-toolbar-fallback-toolbar)
|
|
173
|
414 (edit-toolbar-list)
|
|
|
415 (set-buffer-modified-p nil))
|
|
|
416
|
|
|
417 (defun edit-toolbar-add-separator-2D-narrow ()
|
|
|
418 "Add a narrow 2D separator at the current position."
|
|
|
419 (interactive)
|
|
|
420 (edit-toolbar-add-item [:style 2D]))
|
|
|
421
|
|
|
422 (defun edit-toolbar-add-separator-3D-narrow ()
|
|
|
423 "Add a narrow 3D separator at the current position."
|
|
|
424 (interactive)
|
|
|
425 (edit-toolbar-add-item [:style 3D]))
|
|
|
426
|
|
|
427 (defun edit-toolbar-add-separator-2D-wide ()
|
|
|
428 "Add a wide 2D separator at the current position."
|
|
|
429 (interactive)
|
|
|
430 (edit-toolbar-add-item [:style 2D :size 30]))
|
|
|
431
|
|
|
432 (defun edit-toolbar-add-separator-3D-wide ()
|
|
|
433 "Add a wide 3D separator at the current position."
|
|
|
434 (interactive)
|
|
|
435 (edit-toolbar-add-item [:style 3D :size 30]))
|
|
|
436
|
|
183
|
437 (defun edit-toolbar-add-separator-right-left ()
|
|
|
438 "Add a right/left separator at the current position."
|
|
|
439 (interactive)
|
|
|
440 (if (memq nil (specifier-instance edit-toolbar-temp-toolbar))
|
|
|
441 (error "Can't have more than one left/right divider in a toolbar.")
|
|
|
442 (edit-toolbar-add-item nil)))
|
|
|
443
|
|
173
|
444 (defun edit-toolbar-add-button ()
|
|
|
445 "Add a new toolbar item at the current position.
|
|
|
446 Completion is available to the known toolbar buttons."
|
|
|
447 (interactive)
|
|
|
448 (let ((button (completing-read
|
|
|
449 "New Toolbar Button (RET to create a new button): "
|
|
|
450 edit-toolbar-button-alist nil t)))
|
|
|
451 (if (string-equal button "")
|
|
|
452 (let ((prompts '("UP glyph for button: "
|
|
|
453 "DOWN glyph (RET for no glyph): "
|
|
|
454 "DISABLED glyph (RET for no glyph): "
|
|
|
455 "UP CAPTIONED glyph (RET for no glyph): "
|
|
|
456 "DOWN CAPTIONED glyph (RET for no glyph): "
|
|
|
457 "DISABLED CAPTIONED glyph (RET for no glyph): "))
|
|
185
|
458 (glyphs-list nil)
|
|
173
|
459 (count 0))
|
|
|
460 (let ((glyph-file (read-file-name (car prompts) nil "")))
|
|
|
461 (if (string-equal glyph-file "")
|
|
|
462 (error "You must specify at least the UP glyph.")
|
|
185
|
463 (setq glyphs-list (list glyph-file))
|
|
173
|
464 (setq prompts (cdr prompts))))
|
|
|
465 (while prompts
|
|
|
466 (let ((glyph-file (read-file-name (car prompts) nil "")))
|
|
|
467 (if (not (string-equal glyph-file ""))
|
|
185
|
468 (setq glyphs-list
|
|
|
469 (append glyphs-list (list glyph-file)))))
|
|
173
|
470 (setq prompts (cdr prompts)))
|
|
185
|
471 (setq added-button (gentemp edit-toolbar-button-prefix ))
|
|
|
472 (setf (symbol-value added-button)
|
|
|
473 (toolbar-make-button-list glyphs-list))
|
|
|
474 (setq edit-toolbar-added-buttons-alist
|
|
|
475 (append edit-toolbar-added-buttons-alist
|
|
|
476 (list (cons added-button glyphs-list))))
|
|
173
|
477 (let ((func (read-string "Function to call: "))
|
|
|
478 (help (read-string "Help String: ")))
|
|
185
|
479 (setq new-button (vector added-button (intern func) t help))))
|
|
173
|
480 (let ((match (assoc button edit-toolbar-button-alist)))
|
|
|
481 (if match
|
|
|
482 (setq new-button (cdr match))
|
|
|
483 (error "Can't find button %s" button))))
|
|
|
484 (edit-toolbar-add-item new-button)))
|
|
|
485
|
|
|
486 (defun edit-toolbar-prompt-for-initialization ()
|
|
|
487 (popup-dialog-box
|
|
|
488 '("Edit Toolbar has created the file ~/.xemacs/.toolbar
|
|
|
489
|
|
|
490 In order for your changes to take effect the next time
|
|
|
491 you start XEmacs, you need to add the following line
|
|
|
492 to the end of your .emacs file:
|
|
|
493
|
|
|
494 (load \"~/.xemacs/.toolbar\")
|
|
|
495
|
|
|
496 Alternatively, I can do this for you now."
|
|
|
497 ["Yes, please\nadd the line\nof code for me." edit-toolbar-add-initialization t]
|
|
|
498 nil
|
|
|
499 ["No thanks,\nI'll take care\nof it myself." ignore t])))
|
|
|
500
|
|
|
501 (defun edit-toolbar-add-initialization ()
|
|
|
502 "Add a line to the end of the user's init file for edit-toolbar use."
|
|
|
503 (interactive)
|
|
|
504 (set-buffer (find-file-noselect user-init-file))
|
|
|
505 (goto-char (point-max))
|
|
|
506 (insert "
|
|
|
507 (if (and (featurep 'toolbar)
|
|
|
508 (fboundp 'console-on-window-system-p)
|
|
|
509 (console-on-window-system-p)
|
|
|
510 (file-exists-p \"" edit-toolbar-file-name "\"))
|
|
|
511 (load-file (expand-file-name \"" edit-toolbar-file-name "\")))
|
|
|
512 ")
|
|
|
513 (save-buffer))
|
|
|
514
|
|
|
515 (defun edit-toolbar-save ()
|
|
|
516 "Save the current toolbar in the file specified by edit-toolbar-file-name."
|
|
|
517 (interactive)
|
|
|
518 (save-excursion
|
|
|
519 (let* ((exists (file-exists-p edit-toolbar-file-name))
|
|
|
520 (buf (find-file-noselect edit-toolbar-file-name))
|
|
|
521 (standard-output buf))
|
|
|
522 (set-buffer buf)
|
|
|
523 (erase-buffer)
|
|
185
|
524 (insert "(setq edit-toolbar-added-buttons-alist '")
|
|
|
525 (prin1 edit-toolbar-added-buttons-alist)
|
|
|
526 (insert ")\n")
|
|
|
527 (insert "(mapcar
|
|
|
528 (lambda (cons)
|
|
|
529 (setf (symbol-value (car cons)) (toolbar-make-button-list (cdr cons)))
|
|
|
530 )
|
|
|
531 edit-toolbar-added-buttons-alist)\n")
|
|
183
|
532 (insert (concat "(set-specifier " edit-toolbar-temp-toolbar-name) " '")
|
|
|
533 (prin1 (specifier-instance edit-toolbar-temp-toolbar))
|
|
173
|
534 (insert ")")
|
|
|
535 (save-buffer)
|
|
|
536 (kill-buffer (current-buffer))
|
|
|
537 (or exists (edit-toolbar-prompt-for-initialization))))
|
|
|
538 (set-buffer-modified-p nil))
|
|
|
539
|
|
|
540 (provide 'edit-toolbar)
|
|
|
541
|
|
|
542 ;;; edit-toolbar.el ends here
|
