Mercurial > hg > xemacs-beta

comparison lisp/utils/edit-toolbar.el @ 185:3d6bfa290dbd r20-3b19

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-3b19
author cvs
date Mon, 13 Aug 2007 09:55:28 +0200
parents e121b013d1f0
children 41ff10fd062f
comparison
equal deleted inserted replaced
184:bcd2674570bf 185:3d6bfa290dbd
55 ;; Modified by Mike Scheidler <c23mts@eng.delcoelect.com> 25 Jul 1997 55 ;; Modified by Mike Scheidler <c23mts@eng.delcoelect.com> 25 Jul 1997
56 ;; - Enabled editing of any toolbar (not just `default-toolbar'). 56 ;; - Enabled editing of any toolbar (not just `default-toolbar').
57 ;; - Added context sensitivity to `edit-toolbar-menu'. 57 ;; - Added context sensitivity to `edit-toolbar-menu'.
58 ;; - Added support for `nil' toolbar item (left/right divider). 58 ;; - Added support for `nil' toolbar item (left/right divider).
59 ;; - Enabled editing of empty toolbars. 59 ;; - Enabled editing of empty toolbars.
60 ;; Modified by Jeff Miller <jmiller@smart.net> 17 Aug 1997
61 ;; - Modfied how added toolbar buttons are created and saved.
60 62
61 ;;; Code: 63 ;;; Code:
62 64
63 (defvar edit-toolbar-version "1.02" 65 (defvar edit-toolbar-version "1.03"
64 "Version of Edit Toolbar.") 66 "Version of Edit Toolbar.")
65 67
66 (defvar edit-toolbar-temp-toolbar-name nil 68 (defvar edit-toolbar-temp-toolbar-name nil
67 "Value of toolbar being edited.") 69 "Value of toolbar being edited.")
68 70
76 (if (boundp 'emacs-user-extension-dir) 78 (if (boundp 'emacs-user-extension-dir)
77 emacs-user-extension-dir 79 emacs-user-extension-dir
78 "/") 80 "/")
79 ".toolbar") 81 ".toolbar")
80 "File name to save toolbars to. Defaults to \"~/.xemacs/.toolbar\"") 82 "File name to save toolbars to. Defaults to \"~/.xemacs/.toolbar\"")
83
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.")
81 93
82 (defvar edit-toolbar-menu 94 (defvar edit-toolbar-menu
83 '("Edit Toolbar" 95 '("Edit Toolbar"
84 ["Move This Item Up" edit-toolbar-up (>= (edit-toolbar-current-index) 0)] 96 ["Move This Item Up" edit-toolbar-up (>= (edit-toolbar-current-index) 0)]
85 ["Move This Item Down" edit-toolbar-down (>= (edit-toolbar-current-index) 0)] 97 ["Move This Item Down" edit-toolbar-down (>= (edit-toolbar-current-index) 0)]
301 313
302 (defun edit-toolbar-kill () 314 (defun edit-toolbar-kill ()
303 "Remove the current toolbar button." 315 "Remove the current toolbar button."
304 (interactive) 316 (interactive)
305 (let* ((toolbar (specifier-instance edit-toolbar-temp-toolbar)) 317 (let* ((toolbar (specifier-instance edit-toolbar-temp-toolbar))
306 (index (- (count-lines (point-min) (point)) 2))) 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)
307 (if (eq index 0) 329 (if (eq index 0)
308 (setq toolbar (cdr toolbar)) 330 (setq toolbar (cdr toolbar))
309 (setcdr (nthcdr (1- index) toolbar) 331 (setcdr (nthcdr (1- index) toolbar)
310 (nthcdr (1+ index) toolbar))) 332 (nthcdr (1+ index) toolbar)))
311 (set-specifier 333 (set-specifier
430 "DOWN glyph (RET for no glyph): " 452 "DOWN glyph (RET for no glyph): "
431 "DISABLED glyph (RET for no glyph): " 453 "DISABLED glyph (RET for no glyph): "
432 "UP CAPTIONED glyph (RET for no glyph): " 454 "UP CAPTIONED glyph (RET for no glyph): "
433 "DOWN CAPTIONED glyph (RET for no glyph): " 455 "DOWN CAPTIONED glyph (RET for no glyph): "
434 "DISABLED CAPTIONED glyph (RET for no glyph): ")) 456 "DISABLED CAPTIONED glyph (RET for no glyph): "))
435 (glyphs nil) 457 (glyphs-list nil)
436 (count 0)) 458 (count 0))
437 (let ((glyph-file (read-file-name (car prompts) nil ""))) 459 (let ((glyph-file (read-file-name (car prompts) nil "")))
438 (if (string-equal glyph-file "") 460 (if (string-equal glyph-file "")
439 (error "You must specify at least the UP glyph.") 461 (error "You must specify at least the UP glyph.")
440 (setq glyphs (list (make-glyph glyph-file))) 462 (setq glyphs-list (list glyph-file))
441 (setq prompts (cdr prompts)))) 463 (setq prompts (cdr prompts))))
442 (while prompts 464 (while prompts
443 (let ((glyph-file (read-file-name (car prompts) nil ""))) 465 (let ((glyph-file (read-file-name (car prompts) nil "")))
444 (if (not (string-equal glyph-file "")) 466 (if (not (string-equal glyph-file ""))
445 (setq glyphs 467 (setq glyphs-list
446 (append glyphs (list (make-glyph glyph-file)))))) 468 (append glyphs-list (list glyph-file)))))
447 (setq prompts (cdr prompts))) 469 (setq prompts (cdr prompts)))
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))))
448 (let ((func (read-string "Function to call: ")) 476 (let ((func (read-string "Function to call: "))
449 (help (read-string "Help String: "))) 477 (help (read-string "Help String: ")))
450 (setq new-button (vector glyphs (intern func) t help)))) 478 (setq new-button (vector added-button (intern func) t help))))
451 (let ((match (assoc button edit-toolbar-button-alist))) 479 (let ((match (assoc button edit-toolbar-button-alist)))
452 (if match 480 (if match
453 (setq new-button (cdr match)) 481 (setq new-button (cdr match))
454 (error "Can't find button %s" button)))) 482 (error "Can't find button %s" button))))
455 (edit-toolbar-add-item new-button))) 483 (edit-toolbar-add-item new-button)))
490 (let* ((exists (file-exists-p edit-toolbar-file-name)) 518 (let* ((exists (file-exists-p edit-toolbar-file-name))
491 (buf (find-file-noselect edit-toolbar-file-name)) 519 (buf (find-file-noselect edit-toolbar-file-name))
492 (standard-output buf)) 520 (standard-output buf))
493 (set-buffer buf) 521 (set-buffer buf)
494 (erase-buffer) 522 (erase-buffer)
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")
495 (insert (concat "(set-specifier " edit-toolbar-temp-toolbar-name) " '") 531 (insert (concat "(set-specifier " edit-toolbar-temp-toolbar-name) " '")
496 (prin1 (specifier-instance edit-toolbar-temp-toolbar)) 532 (prin1 (specifier-instance edit-toolbar-temp-toolbar))
497 (insert ")") 533 (insert ")")
498 (save-buffer) 534 (save-buffer)
499 (kill-buffer (current-buffer)) 535 (kill-buffer (current-buffer))