|
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)
|
|
|
194 (if current-menubar
|
|
|
195 (progn
|
|
|
196 (set (make-local-variable 'current-menubar)
|
|
|
197 (copy-sequence current-menubar))
|
|
|
198 (add-submenu nil edit-toolbar-menu)))
|
|
|
199 (use-local-map edit-toolbar-map)
|
|
|
200 (setq buffer-read-only nil)
|
|
|
201 (message "Edit Toolbar Version %s. Type \"?\" for help." edit-toolbar-version))
|
|
|
202
|
|
|
203 (defun edit-toolbar-list ()
|
|
|
204 (erase-buffer)
|
|
|
205 (edit-toolbar-insert-item 'header)
|
|
183
|
206 (mapcar (function (lambda (item)
|
|
|
207 (edit-toolbar-insert-item item)))
|
|
|
208 (specifier-instance edit-toolbar-temp-toolbar))
|
|
173
|
209 (goto-char (point-min)))
|
|
|
210
|
|
183
|
211 (defun edit-toolbar-button-p ()
|
|
|
212 "Returns t if the currently selected edit-toolbar item is a button."
|
|
|
213 (let ((item (edit-toolbar-current-item)))
|
|
|
214 (not (or (eq item nil)
|
|
|
215 (eq (aref item 0) :style)
|
|
|
216 (eq (aref item 0) :size)))))
|
|
|
217
|
|
|
218 (defun edit-toolbar-current-index ()
|
|
|
219 "Returns the offset of the currently selected edit-toolbar item."
|
|
|
220 (- (count-lines (point-min) (point)) 2))
|
|
|
221
|
|
|
222 (defun edit-toolbar-current-item ()
|
|
|
223 "Returns the value of the currently selected edit-toolbar item."
|
|
|
224 (let ((toolbar (specifier-instance edit-toolbar-temp-toolbar)))
|
|
|
225 (nth (edit-toolbar-current-index) toolbar)))
|
|
|
226
|
|
173
|
227 (defun edit-toolbar-quit ()
|
|
|
228 "Quit an Edit Toolbar session. This simply buries the buffer."
|
|
|
229 (interactive)
|
|
|
230 ;;FIXME
|
|
|
231 (bury-buffer))
|
|
|
232
|
|
|
233 (defun edit-toolbar-next ()
|
|
|
234 "Move to the next line in the Edit Toolbar buffer."
|
|
|
235 (interactive)
|
|
|
236 (next-line 1))
|
|
|
237
|
|
|
238 (defun edit-toolbar-previous ()
|
|
|
239 "Move to the previous line in the Edit Toolbar buffer."
|
|
|
240 (interactive)
|
|
|
241 (next-line -1))
|
|
|
242
|
|
|
243 (defun edit-toolbar-set-function (func)
|
|
|
244 "Set the function for the selected toolbar button."
|
|
|
245 (interactive "aNew Function: ")
|
|
183
|
246 (let ((index (edit-toolbar-current-index)))
|
|
|
247 (if (not (edit-toolbar-button-p))
|
|
|
248 (error "Not a button")
|
|
|
249 (setf (aref (edit-toolbar-current-item) 1) func)
|
|
|
250 (edit-toolbar-list)
|
|
|
251 (forward-line (+ index 2)))))
|
|
173
|
252
|
|
|
253 (defun edit-toolbar-set-help (help)
|
|
|
254 "Set the help string for the selected toolbar button."
|
|
|
255 (interactive "sNew Help String: ")
|
|
183
|
256 (let ((index (edit-toolbar-current-index)))
|
|
|
257 (if (not (edit-toolbar-button-p))
|
|
|
258 (error "Not a button")
|
|
|
259 (setf (aref (edit-toolbar-current-item) 3) help)
|
|
|
260 (edit-toolbar-list)
|
|
|
261 (forward-line (+ index 2)))))
|
|
173
|
262
|
|
|
263 (defun edit-toolbar-copy ()
|
|
|
264 "Make a copy of the selected toolbar button."
|
|
|
265 (interactive)
|
|
183
|
266 (let ((index (edit-toolbar-current-index)))
|
|
|
267 (if (not (edit-toolbar-button-p))
|
|
|
268 (error "Not a button")
|
|
|
269 (setcdr (nthcdr index (specifier-instance edit-toolbar-temp-toolbar))
|
|
|
270 (cons (edit-toolbar-current-item)
|
|
|
271 (nthcdr (1+ index)
|
|
|
272 (specifier-instance edit-toolbar-temp-toolbar))))
|
|
|
273 (edit-toolbar-list)
|
|
|
274 (forward-line (+ index 3)))))
|
|
173
|
275
|
|
|
276 (defun edit-toolbar-down ()
|
|
|
277 "Move the current toolbar button down (right) one position."
|
|
|
278 (interactive)
|
|
183
|
279 (let* ((toolbar (specifier-instance edit-toolbar-temp-toolbar))
|
|
173
|
280 (index (- (count-lines (point-min) (point)) 2))
|
|
183
|
281 (item (nth index toolbar)))
|
|
173
|
282 (if (eq (1+ index) (length toolbar))
|
|
|
283 (error "Already at the bottom of the toolbar."))
|
|
|
284 (if (eq index 0)
|
|
|
285 (setq toolbar (cdr toolbar))
|
|
|
286 (setcdr (nthcdr (1- index) toolbar)
|
|
|
287 (nthcdr (1+ index) toolbar)))
|
|
|
288 (setcdr (nthcdr index toolbar)
|
|
|
289 (cons item (nthcdr (1+ index) toolbar)))
|
|
183
|
290 (set-specifier
|
|
|
291 (symbol-value (intern-soft edit-toolbar-temp-toolbar-name)) toolbar)
|
|
173
|
292 (edit-toolbar-list)
|
|
|
293 (forward-line (+ index 3))))
|
|
|
294
|
|
|
295 (defun edit-toolbar-up ()
|
|
|
296 "Move the current toolbar button up (left) one position."
|
|
|
297 (interactive)
|
|
183
|
298 (let* ((toolbar (specifier-instance edit-toolbar-temp-toolbar))
|
|
173
|
299 (index (- (count-lines (point-min) (point)) 2))
|
|
|
300 (item (nth index toolbar)))
|
|
183
|
301 (if (<= index 0)
|
|
173
|
302 (error "Already at the top of the toolbar."))
|
|
|
303 (setcdr (nthcdr (1- index) toolbar)
|
|
|
304 (nthcdr (1+ index) toolbar))
|
|
|
305 (if (eq index 1)
|
|
|
306 (setq toolbar (cons item toolbar))
|
|
|
307 (setcdr (nthcdr (- index 2) toolbar)
|
|
|
308 (cons item (nthcdr (- index 1) toolbar))))
|
|
183
|
309 (set-specifier
|
|
|
310 (symbol-value (intern-soft edit-toolbar-temp-toolbar-name)) toolbar)
|
|
173
|
311 (edit-toolbar-list)
|
|
|
312 (forward-line (+ index 1))))
|
|
|
313
|
|
|
314 (defun edit-toolbar-kill ()
|
|
|
315 "Remove the current toolbar button."
|
|
|
316 (interactive)
|
|
183
|
317 (let* ((toolbar (specifier-instance edit-toolbar-temp-toolbar))
|
|
185
|
318 (index (- (count-lines (point-min) (point)) 2))
|
|
|
319 (etk-scratch-list)
|
|
|
320 (button (elt (nth index toolbar) 0 )))
|
|
|
321
|
|
|
322 (mapcar
|
|
|
323 (lambda (cons)
|
|
|
324 (if (not (memq button cons))
|
|
|
325 (setq etk-scratch-list (append etk-scratch-list cons)))
|
|
|
326 )
|
|
|
327 edit-toolbar-added-buttons-alist)
|
|
|
328 (setq edit-toolbar-added-buttons-alist etk-scratch-list)
|
|
173
|
329 (if (eq index 0)
|
|
|
330 (setq toolbar (cdr toolbar))
|
|
|
331 (setcdr (nthcdr (1- index) toolbar)
|
|
|
332 (nthcdr (1+ index) toolbar)))
|
|
183
|
333 (set-specifier
|
|
|
334 (symbol-value (intern-soft edit-toolbar-temp-toolbar-name)) toolbar)
|
|
173
|
335 (edit-toolbar-list)
|
|
|
336 (forward-line (+ index 2))))
|
|
|
337
|
|
|
338 (defun edit-toolbar-insert-item (item)
|
|
|
339 (let ((line-format "%-30s %s\n")
|
|
|
340 icon function help)
|
|
|
341 (if (eq item 'header)
|
|
|
342 (progn
|
|
|
343 (setq function "Function"
|
|
|
344 help "Help String")
|
|
|
345 (insert-face "Icon\t" 'bold)
|
|
|
346 (insert-face (format line-format function help) 'bold))
|
|
183
|
347 (cond ((eq item nil)
|
|
|
348 (setq icon nil
|
|
|
349 function "-------------- Right/Left Divider --------------"
|
|
|
350 help ""))
|
|
|
351 ((or (eq (aref item 0) :style)
|
|
173
|
352 (eq (aref item 0) :size))
|
|
|
353 (setq icon nil
|
|
|
354 function "----------------------------------------"
|
|
|
355 help ""))
|
|
|
356 (t
|
|
|
357 (setq icon (if (listp (aref item 0))
|
|
|
358 (car (aref item 0))
|
|
|
359 (car (symbol-value (aref item 0))))
|
|
|
360 function (aref item 1)
|
|
|
361 help (aref item 3))))
|
|
|
362 (let ((st (point))
|
|
|
363 (fn #'(lambda (str callback data)
|
|
|
364 (let ((st1 (point)))
|
|
|
365 (insert str)
|
|
|
366 (add-list-mode-item st1 (point) nil callback data)))))
|
|
|
367 (insert "\t")
|
|
|
368 (funcall fn (format line-format function help) nil item)
|
|
|
369 (set-extent-begin-glyph (make-extent st (point)) icon)))))
|
|
|
370
|
|
|
371 (defun edit-toolbar-create-button-alist ()
|
|
|
372 (let ((button-alist nil)
|
|
183
|
373 (buttons (specifier-instance edit-toolbar-temp-toolbar)))
|
|
173
|
374 (while buttons
|
|
|
375 (setq button-alist
|
|
183
|
376 (if (arrayp (car buttons))
|
|
|
377 (cons (cons (symbol-name (aref (car buttons) 1)) (car buttons))
|
|
|
378 button-alist)
|
|
|
379 (cons (car buttons) button-alist)))
|
|
173
|
380 (setq buttons (cdr buttons)))
|
|
|
381 button-alist))
|
|
|
382
|
|
183
|
383 (defvar edit-toolbar-button-alist nil
|
|
|
384 "List of buttons in the toolbar currently being edited.")
|
|
|
385
|
|
|
386 (defvar edit-toolbar-toolbar-alist nil
|
|
|
387 "List of existing toolbars (used for completing read).")
|
|
173
|
388
|
|
|
389 (defun edit-toolbar-add-item (item)
|
|
|
390 "Add a toolbar item ITEM at the current location."
|
|
183
|
391 (let* ((toolbar (specifier-instance edit-toolbar-temp-toolbar))
|
|
173
|
392 (index (- (count-lines (point-min) (point)) 2)))
|
|
183
|
393 (if (<= index 0)
|
|
173
|
394 (setq toolbar (cons item toolbar))
|
|
|
395 (setcdr (nthcdr (- index 1) toolbar)
|
|
|
396 (cons item (nthcdr index toolbar))))
|
|
183
|
397 (set-specifier
|
|
|
398 (symbol-value (intern-soft edit-toolbar-temp-toolbar-name)) toolbar)
|
|
173
|
399 (edit-toolbar-list)
|
|
|
400 (forward-line (+ index 2))))
|
|
|
401
|
|
|
402 ;(defun edit-toolbar-check-for-save ()
|
|
|
403 ; (if (not (buffer-modified-p))
|
|
|
404 ; ()
|
|
|
405 ; (if (yes-or-no-p-maybe-dialog-box "
|
|
|
406
|
|
|
407 (defun edit-toolbar-restore ()
|
|
|
408 "Restore the default toolbar."
|
|
|
409 (interactive)
|
|
|
410 ; (edit-toolbar-check-for-save)
|
|
183
|
411 (set-specifier edit-toolbar-temp-toolbar
|
|
|
412 edit-toolbar-fallback-toolbar)
|
|
173
|
413 (edit-toolbar-list)
|
|
|
414 (set-buffer-modified-p nil))
|
|
|
415
|
|
|
416 (defun edit-toolbar-add-separator-2D-narrow ()
|
|
|
417 "Add a narrow 2D separator at the current position."
|
|
|
418 (interactive)
|
|
|
419 (edit-toolbar-add-item [:style 2D]))
|
|
|
420
|
|
|
421 (defun edit-toolbar-add-separator-3D-narrow ()
|
|
|
422 "Add a narrow 3D separator at the current position."
|
|
|
423 (interactive)
|
|
|
424 (edit-toolbar-add-item [:style 3D]))
|
|
|
425
|
|
|
426 (defun edit-toolbar-add-separator-2D-wide ()
|
|
|
427 "Add a wide 2D separator at the current position."
|
|
|
428 (interactive)
|
|
|
429 (edit-toolbar-add-item [:style 2D :size 30]))
|
|
|
430
|
|
|
431 (defun edit-toolbar-add-separator-3D-wide ()
|
|
|
432 "Add a wide 3D separator at the current position."
|
|
|
433 (interactive)
|
|
|
434 (edit-toolbar-add-item [:style 3D :size 30]))
|
|
|
435
|
|
183
|
436 (defun edit-toolbar-add-separator-right-left ()
|
|
|
437 "Add a right/left separator at the current position."
|
|
|
438 (interactive)
|
|
|
439 (if (memq nil (specifier-instance edit-toolbar-temp-toolbar))
|
|
|
440 (error "Can't have more than one left/right divider in a toolbar.")
|
|
|
441 (edit-toolbar-add-item nil)))
|
|
|
442
|
|
173
|
443 (defun edit-toolbar-add-button ()
|
|
|
444 "Add a new toolbar item at the current position.
|
|
|
445 Completion is available to the known toolbar buttons."
|
|
|
446 (interactive)
|
|
|
447 (let ((button (completing-read
|
|
|
448 "New Toolbar Button (RET to create a new button): "
|
|
|
449 edit-toolbar-button-alist nil t)))
|
|
|
450 (if (string-equal button "")
|
|
|
451 (let ((prompts '("UP glyph for button: "
|
|
|
452 "DOWN glyph (RET for no glyph): "
|
|
|
453 "DISABLED glyph (RET for no glyph): "
|
|
|
454 "UP CAPTIONED glyph (RET for no glyph): "
|
|
|
455 "DOWN CAPTIONED glyph (RET for no glyph): "
|
|
|
456 "DISABLED CAPTIONED glyph (RET for no glyph): "))
|
|
185
|
457 (glyphs-list nil)
|
|
173
|
458 (count 0))
|
|
|
459 (let ((glyph-file (read-file-name (car prompts) nil "")))
|
|
|
460 (if (string-equal glyph-file "")
|
|
|
461 (error "You must specify at least the UP glyph.")
|
|
185
|
462 (setq glyphs-list (list glyph-file))
|
|
173
|
463 (setq prompts (cdr prompts))))
|
|
|
464 (while prompts
|
|
|
465 (let ((glyph-file (read-file-name (car prompts) nil "")))
|
|
|
466 (if (not (string-equal glyph-file ""))
|
|
185
|
467 (setq glyphs-list
|
|
|
468 (append glyphs-list (list glyph-file)))))
|
|
173
|
469 (setq prompts (cdr prompts)))
|
|
185
|
470 (setq added-button (gentemp edit-toolbar-button-prefix ))
|
|
|
471 (setf (symbol-value added-button)
|
|
|
472 (toolbar-make-button-list glyphs-list))
|
|
|
473 (setq edit-toolbar-added-buttons-alist
|
|
|
474 (append edit-toolbar-added-buttons-alist
|
|
|
475 (list (cons added-button glyphs-list))))
|
|
173
|
476 (let ((func (read-string "Function to call: "))
|
|
|
477 (help (read-string "Help String: ")))
|
|
185
|
478 (setq new-button (vector added-button (intern func) t help))))
|
|
173
|
479 (let ((match (assoc button edit-toolbar-button-alist)))
|
|
|
480 (if match
|
|
|
481 (setq new-button (cdr match))
|
|
|
482 (error "Can't find button %s" button))))
|
|
|
483 (edit-toolbar-add-item new-button)))
|
|
|
484
|
|
|
485 (defun edit-toolbar-prompt-for-initialization ()
|
|
|
486 (popup-dialog-box
|
|
|
487 '("Edit Toolbar has created the file ~/.xemacs/.toolbar
|
|
|
488
|
|
|
489 In order for your changes to take effect the next time
|
|
|
490 you start XEmacs, you need to add the following line
|
|
|
491 to the end of your .emacs file:
|
|
|
492
|
|
|
493 (load \"~/.xemacs/.toolbar\")
|
|
|
494
|
|
|
495 Alternatively, I can do this for you now."
|
|
|
496 ["Yes, please\nadd the line\nof code for me." edit-toolbar-add-initialization t]
|
|
|
497 nil
|
|
|
498 ["No thanks,\nI'll take care\nof it myself." ignore t])))
|
|
|
499
|
|
|
500 (defun edit-toolbar-add-initialization ()
|
|
|
501 "Add a line to the end of the user's init file for edit-toolbar use."
|
|
|
502 (interactive)
|
|
|
503 (set-buffer (find-file-noselect user-init-file))
|
|
|
504 (goto-char (point-max))
|
|
|
505 (insert "
|
|
|
506 (if (and (featurep 'toolbar)
|
|
|
507 (fboundp 'console-on-window-system-p)
|
|
|
508 (console-on-window-system-p)
|
|
|
509 (file-exists-p \"" edit-toolbar-file-name "\"))
|
|
|
510 (load-file (expand-file-name \"" edit-toolbar-file-name "\")))
|
|
|
511 ")
|
|
|
512 (save-buffer))
|
|
|
513
|
|
|
514 (defun edit-toolbar-save ()
|
|
|
515 "Save the current toolbar in the file specified by edit-toolbar-file-name."
|
|
|
516 (interactive)
|
|
|
517 (save-excursion
|
|
|
518 (let* ((exists (file-exists-p edit-toolbar-file-name))
|
|
|
519 (buf (find-file-noselect edit-toolbar-file-name))
|
|
|
520 (standard-output buf))
|
|
|
521 (set-buffer buf)
|
|
|
522 (erase-buffer)
|
|
185
|
523 (insert "(setq edit-toolbar-added-buttons-alist '")
|
|
|
524 (prin1 edit-toolbar-added-buttons-alist)
|
|
|
525 (insert ")\n")
|
|
|
526 (insert "(mapcar
|
|
|
527 (lambda (cons)
|
|
|
528 (setf (symbol-value (car cons)) (toolbar-make-button-list (cdr cons)))
|
|
|
529 )
|
|
|
530 edit-toolbar-added-buttons-alist)\n")
|
|
183
|
531 (insert (concat "(set-specifier " edit-toolbar-temp-toolbar-name) " '")
|
|
|
532 (prin1 (specifier-instance edit-toolbar-temp-toolbar))
|
|
173
|
533 (insert ")")
|
|
|
534 (save-buffer)
|
|
|
535 (kill-buffer (current-buffer))
|
|
|
536 (or exists (edit-toolbar-prompt-for-initialization))))
|
|
|
537 (set-buffer-modified-p nil))
|
|
|
538
|
|
|
539 (provide 'edit-toolbar)
|
|
|
540
|
|
|
541 ;;; edit-toolbar.el ends here
|
