|
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 It would be nice if edit-toolbar could edit *any* toolbar, not just
|
|
|
46 ;; the default one.
|
|
|
47 ;; o The function edit-toolbar-quit should do something other than just
|
|
|
48 ;; bury the buffer.
|
|
|
49 ;; o Dynamically add new items to edit-toolbar-button-alist as new buttons
|
|
|
50 ;; are added.
|
|
|
51
|
|
|
52 ;;; Code:
|
|
|
53
|
|
|
54 (defvar edit-toolbar-version "1.01"
|
|
|
55 "Version of Edit Toolbar.")
|
|
|
56
|
|
|
57 (defvar edit-toolbar-default-toolbar (specifier-instance default-toolbar)
|
|
|
58 "Default toolbar used when reverting.")
|
|
|
59
|
|
|
60 (defvar edit-toolbar-file-name (concat "~"
|
|
|
61 (if (boundp 'emacs-user-extension-dir)
|
|
|
62 emacs-user-extension-dir
|
|
|
63 "/")
|
|
|
64 ".toolbar")
|
|
|
65 "File name to save toolbars to. Defaults to \"~/.xemacs/.toolbar\"")
|
|
|
66
|
|
|
67 (defvar edit-toolbar-menu
|
|
|
68 '("Edit Toolbar"
|
|
|
69 ["Move This Item Up" edit-toolbar-up t]
|
|
|
70 ["Move This Item Down" edit-toolbar-down t]
|
|
|
71 ["Set Function" edit-toolbar-set-function t]
|
|
|
72 ["Set Help String" edit-toolbar-set-help t]
|
|
|
73 ["Remove This Item" edit-toolbar-kill t]
|
|
|
74 "----"
|
|
|
75 ["Add Button..." edit-toolbar-add-button t]
|
|
|
76 ("Add Separator"
|
|
|
77 ["2D (narrow) " edit-toolbar-add-separator-2D-narrow t]
|
|
|
78 ["3D (narrow)" edit-toolbar-add-separator-3D-narrow t]
|
|
|
79 ["2D (wide)" edit-toolbar-add-separator-2D-wide t]
|
|
|
80 ["3D (wide)" edit-toolbar-add-separator-3D-wide t]
|
|
|
81 )
|
|
|
82 "----"
|
|
|
83 ["Restore Default Toolbar " edit-toolbar-restore t]
|
|
|
84 ["Save This Toolbar" edit-toolbar-save t]
|
|
|
85 "----"
|
|
|
86 ["Help" describe-mode t]
|
|
|
87 "----"
|
|
|
88 ["Quit" edit-toolbar-quit t]
|
|
|
89 )
|
|
|
90 )
|
|
|
91
|
|
|
92 (defvar edit-toolbar-map
|
|
|
93 (let ((map (make-sparse-keymap)))
|
|
|
94 (suppress-keymap map)
|
|
|
95 (define-key map "q" 'edit-toolbar-quit)
|
|
|
96 (define-key map "n" 'edit-toolbar-next)
|
|
|
97 (define-key map "p" 'edit-toolbar-previous)
|
|
|
98 (define-key map " " 'edit-toolbar-next)
|
|
|
99 (define-key map "?" 'describe-mode)
|
|
|
100 (define-key map "f" 'edit-toolbar-set-function)
|
|
|
101 (define-key map "h" 'edit-toolbar-set-help)
|
|
|
102 (define-key map "a" 'edit-toolbar-add-button)
|
|
|
103 (define-key map "2" 'edit-toolbar-add-separator-2D-narrow)
|
|
|
104 (define-key map "@" 'edit-toolbar-add-separator-2D-wide)
|
|
|
105 (define-key map "3" 'edit-toolbar-add-separator-3D-narrow)
|
|
|
106 (define-key map "#" 'edit-toolbar-add-separator-3D-wide)
|
|
|
107 (define-key map "c" 'edit-toolbar-copy)
|
|
|
108 (define-key map "d" 'edit-toolbar-down)
|
|
|
109 (define-key map "u" 'edit-toolbar-up)
|
|
|
110 (define-key map "k" 'edit-toolbar-kill)
|
|
|
111 (define-key map "s" 'edit-toolbar-save)
|
|
|
112 (define-key map "\C-x\C-s" 'edit-toolbar-save)
|
|
|
113 (define-key map "r" 'edit-toolbar-restore)
|
|
|
114 (define-key map 'return 'edit-toolbar-next)
|
|
|
115 (define-key map 'delete 'edit-toolbar-previous)
|
|
|
116 map
|
|
|
117 ))
|
|
|
118
|
|
|
119 ;;;###autoload
|
|
|
120 (defun edit-toolbar ()
|
|
|
121 "Alter toolbar characteristics by editing a buffer representing the current toolbar.
|
|
|
122 Pops up a buffer containing a list of the current toobar."
|
|
|
123 (interactive)
|
|
|
124 (pop-to-buffer (get-buffer-create "*Edit Toolbar*"))
|
|
|
125 (edit-toolbar-list)
|
|
|
126 (set-buffer-modified-p nil)
|
|
|
127 (edit-toolbar-mode)
|
|
|
128 (set-face-foreground 'default "black" (current-buffer))
|
|
|
129 (set-face-background 'default "grey75" (current-buffer))
|
|
|
130 (set-face-foreground 'list-mode-item-selected "yellow" (current-buffer))
|
|
|
131 (set-face-background 'list-mode-item-selected "black" (current-buffer)))
|
|
|
132
|
|
|
133 (define-derived-mode edit-toolbar-mode list-mode "Edit-Toolbar"
|
|
|
134 "Major mode for 'edit-toolbar' buffers.
|
|
|
135
|
|
|
136 Editing commands:
|
|
|
137
|
|
|
138 \\{edit-toolbar-map}"
|
|
|
139 (setq mode-popup-menu edit-toolbar-menu)
|
|
|
140 (if current-menubar
|
|
|
141 (progn
|
|
|
142 (set (make-local-variable 'current-menubar)
|
|
|
143 (copy-sequence current-menubar))
|
|
|
144 (add-submenu nil edit-toolbar-menu)))
|
|
|
145 (use-local-map edit-toolbar-map)
|
|
|
146 (setq buffer-read-only nil)
|
|
|
147 (message "Edit Toolbar Version %s. Type \"?\" for help." edit-toolbar-version))
|
|
|
148
|
|
|
149 (defun edit-toolbar-list ()
|
|
|
150 (erase-buffer)
|
|
|
151 (edit-toolbar-insert-item 'header)
|
|
|
152 (let ((ilist (specifier-instance default-toolbar)))
|
|
|
153 (while (setq item (car ilist))
|
|
|
154 (edit-toolbar-insert-item item)
|
|
|
155 (setq ilist (cdr ilist))))
|
|
|
156 (goto-char (point-min)))
|
|
|
157
|
|
|
158 (defun edit-toolbar-quit ()
|
|
|
159 "Quit an Edit Toolbar session. This simply buries the buffer."
|
|
|
160 (interactive)
|
|
|
161 ;;FIXME
|
|
|
162 (bury-buffer))
|
|
|
163
|
|
|
164 (defun edit-toolbar-next ()
|
|
|
165 "Move to the next line in the Edit Toolbar buffer."
|
|
|
166 (interactive)
|
|
|
167 (next-line 1))
|
|
|
168
|
|
|
169 (defun edit-toolbar-previous ()
|
|
|
170 "Move to the previous line in the Edit Toolbar buffer."
|
|
|
171 (interactive)
|
|
|
172 (next-line -1))
|
|
|
173
|
|
|
174 (defun edit-toolbar-set-function (func)
|
|
|
175 "Set the function for the selected toolbar button."
|
|
|
176 (interactive "aNew Function: ")
|
|
|
177 (let ((toolbar (specifier-instance default-toolbar))
|
|
|
178 (index (- (count-lines (point-min) (point)) 2)))
|
|
|
179 (setf (aref (nth index toolbar) 1) func)
|
|
|
180 (edit-toolbar-list)
|
|
|
181 (forward-line (+ index 2))))
|
|
|
182
|
|
|
183 (defun edit-toolbar-set-help (help)
|
|
|
184 "Set the help string for the selected toolbar button."
|
|
|
185 (interactive "sNew Help String: ")
|
|
|
186 (let ((toolbar (specifier-instance default-toolbar))
|
|
|
187 (index (- (count-lines (point-min) (point)) 2)))
|
|
|
188 (setf (aref (nth index toolbar) 3) help)
|
|
|
189 (edit-toolbar-list)
|
|
|
190 (forward-line (+ index 2))))
|
|
|
191
|
|
|
192 (defun edit-toolbar-copy ()
|
|
|
193 "Make a copy of the selected toolbar button."
|
|
|
194 (interactive)
|
|
|
195 (let* ((toolbar (specifier-instance default-toolbar))
|
|
|
196 (index (- (count-lines (point-min) (point)) 2))
|
|
|
197 (item (nth index toolbar)))
|
|
|
198 (setcdr (nthcdr index toolbar)
|
|
|
199 (cons item (nthcdr (1+ index) toolbar)))
|
|
|
200 (edit-toolbar-list)
|
|
|
201 (forward-line (+ index 3))))
|
|
|
202
|
|
|
203 (defun edit-toolbar-down ()
|
|
|
204 "Move the current toolbar button down (right) one position."
|
|
|
205 (interactive)
|
|
|
206 (let* ((toolbar (specifier-instance default-toolbar))
|
|
|
207 (index (- (count-lines (point-min) (point)) 2))
|
|
|
208 (item (nth index toolbar)))
|
|
|
209 (if (eq (1+ index) (length toolbar))
|
|
|
210 (error "Already at the bottom of the toolbar."))
|
|
|
211 (if (eq index 0)
|
|
|
212 (setq toolbar (cdr toolbar))
|
|
|
213 (setcdr (nthcdr (1- index) toolbar)
|
|
|
214 (nthcdr (1+ index) toolbar)))
|
|
|
215 (setcdr (nthcdr index toolbar)
|
|
|
216 (cons item (nthcdr (1+ index) toolbar)))
|
|
|
217 (set-specifier default-toolbar toolbar)
|
|
|
218 (edit-toolbar-list)
|
|
|
219 (forward-line (+ index 3))))
|
|
|
220
|
|
|
221 (defun edit-toolbar-up ()
|
|
|
222 "Move the current toolbar button up (left) one position."
|
|
|
223 (interactive)
|
|
|
224 (let* ((toolbar (specifier-instance default-toolbar))
|
|
|
225 (index (- (count-lines (point-min) (point)) 2))
|
|
|
226 (item (nth index toolbar)))
|
|
|
227 (if (eq index 0)
|
|
|
228 (error "Already at the top of the toolbar."))
|
|
|
229 (setcdr (nthcdr (1- index) toolbar)
|
|
|
230 (nthcdr (1+ index) toolbar))
|
|
|
231 (if (eq index 1)
|
|
|
232 (setq toolbar (cons item toolbar))
|
|
|
233 (setcdr (nthcdr (- index 2) toolbar)
|
|
|
234 (cons item (nthcdr (- index 1) toolbar))))
|
|
|
235 (set-specifier default-toolbar toolbar)
|
|
|
236 (edit-toolbar-list)
|
|
|
237 (forward-line (+ index 1))))
|
|
|
238
|
|
|
239 (defun edit-toolbar-kill ()
|
|
|
240 "Remove the current toolbar button."
|
|
|
241 (interactive)
|
|
|
242 (let* ((toolbar (specifier-instance default-toolbar))
|
|
|
243 (index (- (count-lines (point-min) (point)) 2))
|
|
|
244 (item (nth index toolbar)))
|
|
|
245 (if (eq index 0)
|
|
|
246 (setq toolbar (cdr toolbar))
|
|
|
247 (setcdr (nthcdr (1- index) toolbar)
|
|
|
248 (nthcdr (1+ index) toolbar)))
|
|
|
249 (set-specifier default-toolbar toolbar)
|
|
|
250 (edit-toolbar-list)
|
|
|
251 (forward-line (+ index 2))))
|
|
|
252
|
|
|
253 (defun edit-toolbar-insert-item (item)
|
|
|
254 (let ((line-format "%-30s %s\n")
|
|
|
255 icon function help)
|
|
|
256 (if (eq item 'header)
|
|
|
257 (progn
|
|
|
258 (setq function "Function"
|
|
|
259 help "Help String")
|
|
|
260 (insert-face "Icon\t" 'bold)
|
|
|
261 (insert-face (format line-format function help) 'bold))
|
|
|
262 (cond ((or (eq (aref item 0) :style)
|
|
|
263 (eq (aref item 0) :size))
|
|
|
264 (setq icon nil
|
|
|
265 function "----------------------------------------"
|
|
|
266 help ""))
|
|
|
267 (t
|
|
|
268 (setq icon (if (listp (aref item 0))
|
|
|
269 (car (aref item 0))
|
|
|
270 (car (symbol-value (aref item 0))))
|
|
|
271 function (aref item 1)
|
|
|
272 help (aref item 3))))
|
|
|
273 (let ((st (point))
|
|
|
274 (fn #'(lambda (str callback data)
|
|
|
275 (let ((st1 (point)))
|
|
|
276 (insert str)
|
|
|
277 (add-list-mode-item st1 (point) nil callback data)))))
|
|
|
278 (insert "\t")
|
|
|
279 (funcall fn (format line-format function help) nil item)
|
|
|
280 (set-extent-begin-glyph (make-extent st (point)) icon)))))
|
|
|
281
|
|
|
282 (defun edit-toolbar-create-button-alist ()
|
|
|
283 (let ((button-alist nil)
|
|
|
284 (buttons (specifier-instance default-toolbar)))
|
|
|
285 (while buttons
|
|
|
286 (setq button-alist
|
|
|
287 (cons (cons (symbol-name (aref (car buttons) 1)) (car buttons))
|
|
|
288 button-alist))
|
|
|
289 (setq buttons (cdr buttons)))
|
|
|
290 button-alist))
|
|
|
291
|
|
|
292 (defvar edit-toolbar-button-alist (edit-toolbar-create-button-alist))
|
|
|
293
|
|
|
294 (defun edit-toolbar-add-item (item)
|
|
|
295 "Add a toolbar item ITEM at the current location."
|
|
|
296 (let* ((toolbar (specifier-instance default-toolbar))
|
|
|
297 (index (- (count-lines (point-min) (point)) 2)))
|
|
|
298 (if (eq index 0)
|
|
|
299 (setq toolbar (cons item toolbar))
|
|
|
300 (setcdr (nthcdr (- index 1) toolbar)
|
|
|
301 (cons item (nthcdr index toolbar))))
|
|
|
302 (set-specifier default-toolbar toolbar)
|
|
|
303 (edit-toolbar-list)
|
|
|
304 (forward-line (+ index 2))))
|
|
|
305
|
|
|
306 ;(defun edit-toolbar-check-for-save ()
|
|
|
307 ; (if (not (buffer-modified-p))
|
|
|
308 ; ()
|
|
|
309 ; (if (yes-or-no-p-maybe-dialog-box "
|
|
|
310
|
|
|
311 (defun edit-toolbar-restore ()
|
|
|
312 "Restore the default toolbar."
|
|
|
313 (interactive)
|
|
|
314 ; (edit-toolbar-check-for-save)
|
|
|
315 (set-specifier default-toolbar edit-toolbar-default-toolbar)
|
|
|
316 (edit-toolbar-list)
|
|
|
317 (set-buffer-modified-p nil))
|
|
|
318
|
|
|
319 (defun edit-toolbar-add-separator-2D-narrow ()
|
|
|
320 "Add a narrow 2D separator at the current position."
|
|
|
321 (interactive)
|
|
|
322 (edit-toolbar-add-item [:style 2D]))
|
|
|
323
|
|
|
324 (defun edit-toolbar-add-separator-3D-narrow ()
|
|
|
325 "Add a narrow 3D separator at the current position."
|
|
|
326 (interactive)
|
|
|
327 (edit-toolbar-add-item [:style 3D]))
|
|
|
328
|
|
|
329 (defun edit-toolbar-add-separator-2D-wide ()
|
|
|
330 "Add a wide 2D separator at the current position."
|
|
|
331 (interactive)
|
|
|
332 (edit-toolbar-add-item [:style 2D :size 30]))
|
|
|
333
|
|
|
334 (defun edit-toolbar-add-separator-3D-wide ()
|
|
|
335 "Add a wide 3D separator at the current position."
|
|
|
336 (interactive)
|
|
|
337 (edit-toolbar-add-item [:style 3D :size 30]))
|
|
|
338
|
|
|
339 (defun edit-toolbar-add-button ()
|
|
|
340 "Add a new toolbar item at the current position.
|
|
|
341 Completion is available to the known toolbar buttons."
|
|
|
342 (interactive)
|
|
|
343 (let ((button (completing-read
|
|
|
344 "New Toolbar Button (RET to create a new button): "
|
|
|
345 edit-toolbar-button-alist nil t)))
|
|
|
346 (if (string-equal button "")
|
|
|
347 (let ((prompts '("UP glyph for button: "
|
|
|
348 "DOWN glyph (RET for no glyph): "
|
|
|
349 "DISABLED glyph (RET for no glyph): "
|
|
|
350 "UP CAPTIONED glyph (RET for no glyph): "
|
|
|
351 "DOWN CAPTIONED glyph (RET for no glyph): "
|
|
|
352 "DISABLED CAPTIONED glyph (RET for no glyph): "))
|
|
|
353 (glyphs nil)
|
|
|
354 (count 0))
|
|
|
355 (let ((glyph-file (read-file-name (car prompts) nil "")))
|
|
|
356 (if (string-equal glyph-file "")
|
|
|
357 (error "You must specify at least the UP glyph.")
|
|
|
358 (setq glyphs (list (make-glyph glyph-file)))
|
|
|
359 (setq prompts (cdr prompts))))
|
|
|
360 (while prompts
|
|
|
361 (let ((glyph-file (read-file-name (car prompts) nil "")))
|
|
|
362 (if (not (string-equal glyph-file ""))
|
|
|
363 (setq glyphs
|
|
|
364 (append glyphs (list (make-glyph glyph-file))))))
|
|
|
365 (setq prompts (cdr prompts)))
|
|
|
366 (let ((func (read-string "Function to call: "))
|
|
|
367 (help (read-string "Help String: ")))
|
|
|
368 (setq new-button (vector glyphs (intern func) t help))))
|
|
|
369 (let ((match (assoc button edit-toolbar-button-alist)))
|
|
|
370 (if match
|
|
|
371 (setq new-button (cdr match))
|
|
|
372 (error "Can't find button %s" button))))
|
|
|
373 (edit-toolbar-add-item new-button)))
|
|
|
374
|
|
|
375 (defun edit-toolbar-prompt-for-initialization ()
|
|
|
376 (popup-dialog-box
|
|
|
377 '("Edit Toolbar has created the file ~/.xemacs/.toolbar
|
|
|
378
|
|
|
379 In order for your changes to take effect the next time
|
|
|
380 you start XEmacs, you need to add the following line
|
|
|
381 to the end of your .emacs file:
|
|
|
382
|
|
|
383 (load \"~/.xemacs/.toolbar\")
|
|
|
384
|
|
|
385 Alternatively, I can do this for you now."
|
|
|
386 ["Yes, please\nadd the line\nof code for me." edit-toolbar-add-initialization t]
|
|
|
387 nil
|
|
|
388 ["No thanks,\nI'll take care\nof it myself." ignore t])))
|
|
|
389
|
|
|
390 (defun edit-toolbar-add-initialization ()
|
|
|
391 "Add a line to the end of the user's init file for edit-toolbar use."
|
|
|
392 (interactive)
|
|
|
393 (set-buffer (find-file-noselect user-init-file))
|
|
|
394 (goto-char (point-max))
|
|
|
395 (insert "
|
|
|
396 (if (and (featurep 'toolbar)
|
|
|
397 (fboundp 'console-on-window-system-p)
|
|
|
398 (console-on-window-system-p)
|
|
|
399 (file-exists-p \"" edit-toolbar-file-name "\"))
|
|
|
400 (load-file (expand-file-name \"" edit-toolbar-file-name "\")))
|
|
|
401 ")
|
|
|
402 (save-buffer))
|
|
|
403
|
|
|
404 (defun edit-toolbar-save ()
|
|
|
405 "Save the current toolbar in the file specified by edit-toolbar-file-name."
|
|
|
406 (interactive)
|
|
|
407 (save-excursion
|
|
|
408 (let* ((exists (file-exists-p edit-toolbar-file-name))
|
|
|
409 (buf (find-file-noselect edit-toolbar-file-name))
|
|
|
410 (standard-output buf))
|
|
|
411 (set-buffer buf)
|
|
|
412 (erase-buffer)
|
|
|
413 (insert "(set-specifier default-toolbar '")
|
|
|
414 (prin1 (specifier-instance default-toolbar))
|
|
|
415 (insert ")")
|
|
|
416 (save-buffer)
|
|
|
417 (kill-buffer (current-buffer))
|
|
|
418 (or exists (edit-toolbar-prompt-for-initialization))))
|
|
|
419 (set-buffer-modified-p nil))
|
|
|
420
|
|
|
421 (provide 'edit-toolbar)
|
|
|
422
|
|
|
423 ;;; edit-toolbar.el ends here
|
