diff lisp/utils/edit-toolbar.el @ 183:e121b013d1f0 r20-3b18

Import from CVS: tag r20-3b18
author cvs
date Mon, 13 Aug 2007 09:54:23 +0200
parents 8eaf7971accc
children 3d6bfa290dbd
line wrap: on
line diff
--- a/lisp/utils/edit-toolbar.el	Mon Aug 13 09:53:23 2007 +0200
+++ b/lisp/utils/edit-toolbar.el	Mon Aug 13 09:54:23 2007 +0200
@@ -42,20 +42,35 @@
 
 ;; To do:
 
-;; o It would be nice if edit-toolbar could edit *any* toolbar, not just
-;;   the default one.
 ;; o The function edit-toolbar-quit should do something other than just
 ;;   bury the buffer.
 ;; o Dynamically add new items to edit-toolbar-button-alist as new buttons
 ;;   are added.
+;; o Allow more than one toolbar to be saved in the ~/.xemacs/.toolbar file.
+;; o Allow buttons to be copied from any toolbar.
+;; o Allow multiple toolbars to be edited simultaneously.
+
+;;; Change Log:
+
+;; Modified by Mike Scheidler <c23mts@eng.delcoelect.com> 25 Jul 1997
+;;  - Enabled editing of any toolbar (not just `default-toolbar').
+;;  - Added context sensitivity to `edit-toolbar-menu'.
+;;  - Added support for `nil' toolbar item (left/right divider).
+;;  - Enabled editing of empty toolbars.
 
 ;;; Code:
 
-(defvar edit-toolbar-version "1.01"
+(defvar edit-toolbar-version "1.02"
   "Version of Edit Toolbar.")
 
-(defvar edit-toolbar-default-toolbar (specifier-instance default-toolbar)
-  "Default toolbar used when reverting.")
+(defvar edit-toolbar-temp-toolbar-name nil
+  "Value of toolbar being edited.")
+
+(defvar edit-toolbar-temp-toolbar nil
+  "Working copy of toolbar being edited.")
+
+(defvar edit-toolbar-fallback-toolbar nil
+  "Toolbar definition to use when reverting.")
 
 (defvar edit-toolbar-file-name (concat "~"
 				       (if (boundp 'emacs-user-extension-dir)
@@ -66,22 +81,24 @@
 
 (defvar edit-toolbar-menu
   '("Edit Toolbar"
-    ["Move This Item Up" edit-toolbar-up t]
-    ["Move This Item Down" edit-toolbar-down t]
-    ["Set Function" edit-toolbar-set-function t]
-    ["Set Help String" edit-toolbar-set-help t]
-    ["Remove This Item" edit-toolbar-kill t]
+    ["Move This Item Up" edit-toolbar-up (>= (edit-toolbar-current-index) 0)]
+    ["Move This Item Down" edit-toolbar-down (>= (edit-toolbar-current-index) 0)]
+    ["Set Function" edit-toolbar-set-function (edit-toolbar-button-p)]
+    ["Set Help String" edit-toolbar-set-help (edit-toolbar-button-p)]
+    ["Copy This Button" edit-toolbar-copy (edit-toolbar-button-p)]
+    ["Remove This Item" edit-toolbar-kill (>= (edit-toolbar-current-index) 0)]
     "----"
     ["Add Button..." edit-toolbar-add-button t]
     ("Add Separator"
-     ["2D (narrow)      " edit-toolbar-add-separator-2D-narrow t]
+     ["2D (narrow)" edit-toolbar-add-separator-2D-narrow t]
      ["3D (narrow)" edit-toolbar-add-separator-3D-narrow t]
      ["2D (wide)" edit-toolbar-add-separator-2D-wide t]
      ["3D (wide)" edit-toolbar-add-separator-3D-wide t]
+     ["Right/left divider" edit-toolbar-add-separator-right-left t]
      )
     "----"
-    ["Restore Default Toolbar      " edit-toolbar-restore t]
-    ["Save This Toolbar" edit-toolbar-save t]
+    ["Restore Default Toolbar      " edit-toolbar-restore (buffer-modified-p)]
+    ["Save This Toolbar" edit-toolbar-save (buffer-modified-p)]
     "----"
     ["Help" describe-mode t]
     "----"
@@ -104,6 +121,7 @@
     (define-key map "@" 'edit-toolbar-add-separator-2D-wide)
     (define-key map "3" 'edit-toolbar-add-separator-3D-narrow)
     (define-key map "#" 'edit-toolbar-add-separator-3D-wide)
+    (define-key map "R" 'edit-toolbar-add-separator-right-left)
     (define-key map "c" 'edit-toolbar-copy)
     (define-key map "d" 'edit-toolbar-down)
     (define-key map "u" 'edit-toolbar-up)
@@ -116,17 +134,41 @@
     map
     ))
 
+(defun edit-toolbar-create-toolbar-alist ()
+  (setq edit-toolbar-toolbar-alist nil)
+  (mapatoms
+   (lambda (sym)
+     (if (and (boundp sym)
+              (toolbar-specifier-p (symbol-value sym))
+              (not (string-match "^edit-toolbar" (symbol-name sym))))
+         (setq edit-toolbar-toolbar-alist
+               (cons (cons (symbol-name sym) sym)
+                     edit-toolbar-toolbar-alist))))))
+ 
 ;;;###autoload
-(defun edit-toolbar ()
-  "Alter toolbar characteristics by editing a buffer representing the current toolbar.
-Pops up a buffer containing a list of the current toobar."
+(defun edit-toolbar (&optional toolbar)
+  "Alter toolbar characteristics by editing a buffer representing the specified toolbar.
+Pops up a buffer containing a list of the toolbar matching TOOLBAR_NAME."
   (interactive)
+  (edit-toolbar-create-toolbar-alist)
+  (if (eq toolbar nil)
+      (setq toolbar (intern-soft
+                     (completing-read
+                      "Toolbar: " edit-toolbar-toolbar-alist))))
+  (if (not (toolbar-specifier-p (symbol-value toolbar)))
+      (error (format "Toolbar named %s not found" (prin1 toolbar))))
   (pop-to-buffer (get-buffer-create "*Edit Toolbar*"))
+  (setq edit-toolbar-temp-toolbar (symbol-value toolbar))
+  (setq edit-toolbar-temp-toolbar-name (symbol-name toolbar))
+  (setq edit-toolbar-fallback-toolbar
+                 (specifier-instance (symbol-value toolbar)))
+  (edit-toolbar-create-button-alist)
   (edit-toolbar-list)
   (set-buffer-modified-p nil)
   (edit-toolbar-mode)
   (set-face-foreground 'default "black" (current-buffer))
   (set-face-background 'default "grey75" (current-buffer))
+  (set-face-background-pixmap 'default "nil" (current-buffer))
   (set-face-foreground 'list-mode-item-selected "yellow" (current-buffer))
   (set-face-background 'list-mode-item-selected "black" (current-buffer)))
 
@@ -149,12 +191,27 @@
 (defun edit-toolbar-list ()
   (erase-buffer)
   (edit-toolbar-insert-item 'header)
-  (let ((ilist (specifier-instance default-toolbar)))
-    (while (setq item (car ilist))
-      (edit-toolbar-insert-item item)
-      (setq ilist (cdr ilist))))
+  (mapcar (function (lambda (item)
+                      (edit-toolbar-insert-item item)))
+          (specifier-instance edit-toolbar-temp-toolbar))
   (goto-char (point-min)))
 
+(defun edit-toolbar-button-p ()
+  "Returns t if the currently selected edit-toolbar item is a button."
+  (let ((item (edit-toolbar-current-item)))
+    (not (or (eq item nil)
+             (eq (aref item 0) :style)
+             (eq (aref item 0) :size)))))
+
+(defun edit-toolbar-current-index ()
+  "Returns the offset of the currently selected edit-toolbar item." 
+  (- (count-lines (point-min) (point)) 2))
+
+(defun edit-toolbar-current-item ()
+  "Returns the value of the currently selected edit-toolbar item." 
+  (let ((toolbar (specifier-instance edit-toolbar-temp-toolbar)))
+    (nth (edit-toolbar-current-index) toolbar)))
+
 (defun edit-toolbar-quit ()
   "Quit an Edit Toolbar session.  This simply buries the buffer."
   (interactive)
@@ -174,38 +231,42 @@
 (defun edit-toolbar-set-function (func)
   "Set the function for the selected toolbar button."
   (interactive "aNew Function: ")
-  (let ((toolbar (specifier-instance default-toolbar))
-	(index (- (count-lines (point-min) (point)) 2)))
-    (setf (aref (nth index toolbar) 1) func)
-    (edit-toolbar-list)
-    (forward-line (+ index 2))))
+  (let ((index (edit-toolbar-current-index)))
+    (if (not (edit-toolbar-button-p))
+        (error "Not a button")
+      (setf (aref (edit-toolbar-current-item) 1) func)
+      (edit-toolbar-list)
+      (forward-line (+ index 2)))))
 
 (defun edit-toolbar-set-help (help)
   "Set the help string for the selected toolbar button."
   (interactive "sNew Help String: ")
-  (let ((toolbar (specifier-instance default-toolbar))
-	(index (- (count-lines (point-min) (point)) 2)))
-    (setf (aref (nth index toolbar) 3) help)
-    (edit-toolbar-list)
-    (forward-line (+ index 2))))
+  (let ((index (edit-toolbar-current-index)))
+    (if (not (edit-toolbar-button-p))
+        (error "Not a button")
+      (setf (aref (edit-toolbar-current-item) 3) help)
+      (edit-toolbar-list)
+      (forward-line (+ index 2)))))
 
 (defun edit-toolbar-copy ()
   "Make a copy of the selected toolbar button."
   (interactive)
-  (let* ((toolbar (specifier-instance default-toolbar))
-	 (index (- (count-lines (point-min) (point)) 2))
-	 (item (nth index toolbar)))
-    (setcdr (nthcdr index toolbar)
-	    (cons item (nthcdr (1+ index) toolbar)))
-    (edit-toolbar-list)
-    (forward-line (+ index 3))))
+  (let ((index (edit-toolbar-current-index)))
+    (if (not (edit-toolbar-button-p))
+        (error "Not a button")
+      (setcdr (nthcdr index (specifier-instance edit-toolbar-temp-toolbar))
+              (cons (edit-toolbar-current-item)
+                    (nthcdr (1+ index)
+                            (specifier-instance edit-toolbar-temp-toolbar))))
+      (edit-toolbar-list)
+      (forward-line (+ index 3)))))
 
 (defun edit-toolbar-down ()
   "Move the current toolbar button down (right) one position."
   (interactive)
-  (let* ((toolbar (specifier-instance default-toolbar))
+  (let* ((toolbar (specifier-instance edit-toolbar-temp-toolbar))
 	 (index (- (count-lines (point-min) (point)) 2))
-	 (item (nth index toolbar)))
+         (item (nth index toolbar)))
     (if (eq (1+ index) (length toolbar))
 	(error "Already at the bottom of the toolbar."))
     (if (eq index 0)
@@ -214,17 +275,18 @@
 	      (nthcdr (1+ index) toolbar)))
     (setcdr (nthcdr index toolbar)
 	    (cons item (nthcdr (1+ index) toolbar)))
-    (set-specifier default-toolbar toolbar)
+    (set-specifier
+     (symbol-value (intern-soft edit-toolbar-temp-toolbar-name)) toolbar)
     (edit-toolbar-list)
     (forward-line (+ index 3))))
 
 (defun edit-toolbar-up ()
   "Move the current toolbar button up (left) one position."
   (interactive)
-  (let* ((toolbar (specifier-instance default-toolbar))
+  (let* ((toolbar (specifier-instance edit-toolbar-temp-toolbar))
 	 (index (- (count-lines (point-min) (point)) 2))
 	 (item (nth index toolbar)))
-    (if (eq index 0)
+    (if (<= index 0)
 	(error "Already at the top of the toolbar."))
     (setcdr (nthcdr (1- index) toolbar)
 	    (nthcdr (1+ index) toolbar))
@@ -232,21 +294,22 @@
 	(setq toolbar (cons item toolbar))
       (setcdr (nthcdr (- index 2) toolbar)
 	      (cons item (nthcdr (- index 1) toolbar))))
-    (set-specifier default-toolbar toolbar)
+    (set-specifier
+     (symbol-value (intern-soft edit-toolbar-temp-toolbar-name)) toolbar)
     (edit-toolbar-list)
     (forward-line (+ index 1))))
 
 (defun edit-toolbar-kill ()
   "Remove the current toolbar button."
   (interactive)
-  (let* ((toolbar (specifier-instance default-toolbar))
-	 (index (- (count-lines (point-min) (point)) 2))
-	 (item (nth index toolbar)))
+  (let* ((toolbar (specifier-instance edit-toolbar-temp-toolbar))
+	 (index (- (count-lines (point-min) (point)) 2)))
     (if (eq index 0)
 	(setq toolbar (cdr toolbar))
       (setcdr (nthcdr (1- index) toolbar)
 	      (nthcdr (1+ index) toolbar)))
-    (set-specifier default-toolbar toolbar)
+    (set-specifier
+     (symbol-value (intern-soft edit-toolbar-temp-toolbar-name)) toolbar)
     (edit-toolbar-list)
     (forward-line (+ index 2))))
 
@@ -259,7 +322,11 @@
 		help "Help String")
 	  (insert-face "Icon\t" 'bold)
 	  (insert-face (format line-format function help) 'bold))
-      (cond ((or (eq (aref item 0) :style)
+      (cond ((eq item nil)
+             (setq icon nil
+                   function "-------------- Right/Left Divider --------------"
+                   help ""))
+	    ((or (eq (aref item 0) :style)
 		 (eq (aref item 0) :size))
 	     (setq icon nil
 		   function "----------------------------------------"
@@ -281,25 +348,32 @@
 
 (defun edit-toolbar-create-button-alist ()
   (let ((button-alist nil)
-	(buttons (specifier-instance default-toolbar)))
+	(buttons (specifier-instance edit-toolbar-temp-toolbar)))
     (while buttons
       (setq button-alist
-	    (cons (cons (symbol-name (aref (car buttons) 1)) (car buttons))
-		  button-alist))
+	    (if (arrayp (car buttons))
+		(cons (cons (symbol-name (aref (car buttons) 1)) (car buttons))
+		      button-alist)
+	      (cons (car buttons) button-alist)))
       (setq buttons (cdr buttons)))
     button-alist))
 
-(defvar edit-toolbar-button-alist (edit-toolbar-create-button-alist))
+(defvar edit-toolbar-button-alist nil
+  "List of buttons in the toolbar currently being edited.")
+
+(defvar edit-toolbar-toolbar-alist nil
+  "List of existing toolbars (used for completing read).")
 
 (defun edit-toolbar-add-item (item)
   "Add a toolbar item ITEM at the current location."
-  (let* ((toolbar (specifier-instance default-toolbar))
+  (let* ((toolbar (specifier-instance edit-toolbar-temp-toolbar))
 	 (index (- (count-lines (point-min) (point)) 2)))
-    (if (eq index 0)
+    (if (<= index 0)
 	(setq toolbar (cons item toolbar))
       (setcdr (nthcdr (- index 1) toolbar)
 	      (cons item (nthcdr index toolbar))))
-    (set-specifier default-toolbar toolbar)
+    (set-specifier
+     (symbol-value (intern-soft edit-toolbar-temp-toolbar-name)) toolbar)
     (edit-toolbar-list)
     (forward-line (+ index 2))))
 
@@ -312,7 +386,8 @@
   "Restore the default toolbar."
   (interactive)
 ;  (edit-toolbar-check-for-save)
-  (set-specifier default-toolbar edit-toolbar-default-toolbar)
+  (set-specifier edit-toolbar-temp-toolbar
+                 edit-toolbar-fallback-toolbar)
   (edit-toolbar-list)
   (set-buffer-modified-p nil))
   
@@ -336,6 +411,13 @@
   (interactive)
   (edit-toolbar-add-item [:style 3D :size 30]))
 
+(defun edit-toolbar-add-separator-right-left ()
+  "Add a right/left separator at the current position."
+  (interactive)
+  (if (memq nil (specifier-instance edit-toolbar-temp-toolbar))
+      (error "Can't have more than one left/right divider in a toolbar.")
+    (edit-toolbar-add-item nil)))
+
 (defun edit-toolbar-add-button ()
   "Add a new toolbar item at the current position.
 Completion is available to the known toolbar buttons."
@@ -410,8 +492,8 @@
 	   (standard-output buf))
       (set-buffer buf)
       (erase-buffer)
-      (insert "(set-specifier default-toolbar '")
-      (prin1 (specifier-instance default-toolbar))
+      (insert (concat "(set-specifier " edit-toolbar-temp-toolbar-name) " '")
+      (prin1 (specifier-instance edit-toolbar-temp-toolbar))
       (insert ")")
       (save-buffer)
       (kill-buffer (current-buffer))