Mercurial > emacs

--- a/lisp/emacs-lisp/easymenu.el	Mon Jan 04 12:10:38 1999 +0000
+++ b/lisp/emacs-lisp/easymenu.el	Mon Jan 04 18:53:32 1999 +0000
@@ -48,12 +48,24 @@
 and as its function definition.   DOC is used as the doc string for SYMBOL.

 The first element of MENU must be a string.  It is the menu bar item name.
-It may be followed by the keyword argument pair
+It may be followed by the following keyword argument pairs
+
    :filter FUNCTION
+
 FUNCTION is a function with one argument, the menu.  It returns the actual
 menu displayed.

-The rest of the elements are menu items.
+   :visible INCLUDE
+
+INCLUDE is an expression; this menu is only visible if this
+expression has a non-nil value.  `:include' is an alias for `:visible'.
+
+   :active ENABLE
+
+ENABLE is an expression; the menu is enabled for selection
+whenever this expression's value is non-nil.
+
+The rest of the elements in MENU, are menu items.

 A menu item is usually a vector of three elements:  [NAME CALLBACK ENABLE]

@@ -76,12 +88,26 @@
 KEYS is a string; a complex keyboard equivalent to this menu item.
 This is normally not needed because keyboard equivalents are usually
 computed automatically.
+KEYS is expanded with `substitute-command-keys' before it is used.
+
+   :key-sequence KEYS
+
+KEYS is nil a string or a vector; nil or a keyboard equivalent to this
+menu item.
+This is a hint that will considerably speed up Emacs first display of
+a menu.  Use `:key-sequence nil' when you know that this menu item has no
+keyboard equivalent.

    :active ENABLE

 ENABLE is an expression; the item is enabled for selection
 whenever this expression's value is non-nil.

+   :included INCLUDE
+
+INCLUDE is an expression; this item is only visible if this
+expression has a non-nil value.
+
    :suffix NAME

 NAME is a string; the name of an argument to CALLBACK.
@@ -92,10 +118,12 @@
 defined:

 toggle: A checkbox.
-        Prepend the name with '(*) ' or '( ) ' depending on if selected or not.
+        Prepend the name with `(*) ' or `( ) ' depending on if selected or not.
 radio: A radio button.
-       Prepend the name with '[X] ' or '[ ] ' depending on if selected or not.
-nil: An ordinary menu item.
+       Prepend the name with `[X] ' or `[ ] ' depending on if selected or not.
+button: Surround the name with `[' and `]'. Use this for an item in the
+        menu bar itself.
+anything else means an ordinary menu item.

    :selected SELECTED

@@ -106,11 +134,7 @@
 unselectable text.  A string consisting solely of hyphens is displayed
 as a solid horizontal line.

-A menu item can be a list.  It is treated as a submenu.
-The first element should be the submenu name.  That's used as the
-menu item name in the top-level menu.  It may be followed by the :filter
-FUNCTION keyword argument pair.  The rest of the submenu list are menu items,
-as above."
+A menu item can be a list with the same format as MENU.  This is a submenu."
   `(progn
      (defvar ,symbol nil ,doc)
      (easy-menu-do-define (quote ,symbol) ,maps ,doc ,menu)))
@@ -134,8 +158,8 @@
 MENU is a menu as computed by `easy-menu-define' or `easy-menu-create-menu' or
 a symbol whose value is such a menu.
 In Emacs a menu filter must return a menu (a keymap), in XEmacs a filter must
-return a menu items list (without menu name and keywords). This function
-returns the right thing in the two cases."
+return a menu items list (without menu name and keywords).
+This function returns the right thing in the two cases."
  (easy-menu-get-map menu nil))		; Get past indirections.

 ;;;###autoload
@@ -152,10 +176,11 @@
       (setq arg (cadr menu-items))
       (setq menu-items (cddr menu-items))
       (cond
-       ((eq keyword ':filter) (setq filter arg))
-       ((eq keyword ':active) (setq enable (or arg ''nil)))
-       ((eq keyword ':label) (setq label arg))
-       ((eq keyword ':visible) (setq visible (or arg ''nil)))))
+       ((eq keyword :filter) (setq filter arg))
+       ((eq keyword :active) (setq enable (or arg ''nil)))
+       ((eq keyword :label) (setq label arg))
+       ((or (eq keyword :included) (eq keyword :visible))
+	(setq visible (or arg ''nil)))))
     (if (equal visible ''nil) nil	; Invisible menu entry, return nil.
       (if (and visible (not (easy-menu-always-true visible)))
 	  (setq prop (cons :visible (cons visible prop))))
@@ -172,7 +197,7 @@
       menu)))


-;; Button prefixes.
+;; Known button types.
 (defvar easy-menu-button-prefix
   '((radio . :radio) (toggle . :toggle)))

@@ -187,7 +212,7 @@
   ;; MENU, just change it, otherwise put it last in MENU.
   (let (name command label prop remove)
     (cond
-     ((stringp item)
+     ((stringp item)			; An unselectable string.
       (setq label
 	    (if (string-match	; If an XEmacs separator
 		 "^\\(-+\\|\
@@ -195,7 +220,7 @@
 shadow\\(Double\\)?Etched\\(In\\|Out\\)\\(Dash\\)?\\)\\)$"
 		 item) ""		; use a single line separator.
 	      item)))
-     ((consp item)
+     ((consp item)			; A sub-menu.
       (setq label (setq name (car item)))
       (setq command (cdr item))
       (if (not (keymapp command))
@@ -208,7 +233,7 @@
 	    (setq label (cadr prop))
 	    (setq prop (cddr prop)))
 	  (setq command (symbol-function command)))))
-     ((vectorp item)
+     ((vectorp item)			; An item.
       (let* ((ilen (length item))
 	     (active (if (> ilen 2) (or (aref item 2) ''nil) t))
 	     (no-name (not (symbolp (setq command (aref item 1)))))
@@ -224,7 +249,8 @@
 		(setq arg (aref item (1+ count)))
 		(setq count (+ 2 count))
 		(cond
-		 ((eq keyword :visible) (setq visible (or arg ''nil)))
+		 ((or (eq keyword :included) (eq keyword :visible))
+		  (setq visible (or arg ''nil)))
 		 ((eq keyword :key-sequence)
 		  (setq cache arg cache-specified t))
 		 ((eq keyword :keys) (setq keys arg no-name nil))
@@ -233,14 +259,22 @@
 		 ((eq keyword :suffix) (setq suffix arg))
 		 ((eq keyword :style) (setq style arg))
 		 ((eq keyword :selected) (setq selected (or arg ''nil)))))
-	      (if (stringp suffix)
-		  (setq label (if (stringp label) (concat label " " suffix)
-				(list 'concat label (concat " " suffix)))))
-	      (if (and selected
-		       (setq style (assq style easy-menu-button-prefix)))
-		  (setq prop (cons :button
-				   (cons (cons (cdr style) (or selected ''nil))
-					 prop))))
+	      (if suffix
+		  (setq label
+			(if (stringp suffix)
+			    (if (stringp label) (concat label " " suffix)
+			      (list 'concat label (concat " " suffix)))
+			  (if (stringp label)
+			      (list 'concat (concat label " ") suffix)
+			    (list 'concat label " " suffix)))))
+	      (cond
+	       ((eq style 'button)
+		(setq label (if (stringp label) (concat "[" label "]")
+			      (list 'concat "[" label "]"))))
+	       ((and selected
+		     (setq style (assq style easy-menu-button-prefix)))
+		(setq prop (cons :button
+				 (cons (cons (cdr style) selected) prop)))))
 	      (when (stringp keys)
 		 (if (string-match "^[^\\]*\\(\\\\\\[\\([^]]+\\)]\\)[^\\]*$"
 				   keys)
@@ -270,12 +304,19 @@
 		 (or (null cache) (stringp cache) (vectorp cache)))
 	    (setq prop (cons :key-sequence (cons cache prop))))))
      (t (error "Invalid menu item in easymenu")))
-    (easy-menu-define-key menu (if (stringp name) (intern name) name)
-			  (and (not remove)
-			       (cons 'menu-item
-				     (cons label
-					   (and name (cons command prop)))))
-			  (if (stringp before) (intern before) before))))
+    (easy-menu-define-key-intern menu name
+				 (and (not remove)
+				      (cons 'menu-item
+					    (cons label
+						  (and name
+						       (cons command prop)))))
+				 before)))
+
+(defun easy-menu-define-key-intern (menu key item &optional before)
+  ;; This is the same as easy-menu-define-key, but it interns KEY and
+  ;; BEFORE if they are strings.
+  (easy-menu-define-key menu (if (stringp key) (intern key) key) item
+			(if (stringp before) (intern before) before)))

 (defun easy-menu-define-key (menu key item &optional before)
   ;; Add binding in MENU for KEY => ITEM.  Similar to `define-key-after'.
@@ -284,6 +325,8 @@
   ;; Optional argument BEFORE is nil or a key in MENU.  If BEFORE is not nil
   ;; put binding before BEFORE in MENU, otherwise if binding is already
   ;; present in MENU, just change it, otherwise put it last in MENU.
+  ;; KEY and BEFORE don't have to be symbols, comparison is done with equal
+  ;; not with eq.
   (let ((inserted (null item))		; Fake already inserted.
 	tail done)
     (while (not done)
@@ -358,7 +401,7 @@
     (if (keymapp menu) (x-popup-menu nil menu))))

 (defun easy-menu-add-item (map path item &optional before)
-  "At the end of the submenu of MAP with path PATH add ITEM.
+  "To the submenu of MAP with path PATH, add ITEM.
 If ITEM is already present in this submenu, then this item will be changed.
 otherwise ITEM will be added at the end of the submenu, unless the optional
 argument BEFORE is present, in which case ITEM will instead be added
@@ -372,32 +415,65 @@
 added.  If PATH is nil, MAP itself is used.  Otherwise, the first
 element should be the name of a submenu directly under MAP.  This
 submenu is then traversed recursively with the remaining elements of PATH.
-ITEM is either defined as in `easy-menu-define' or a menu defined earlier
-by `easy-menu-define' or `easy-menu-create-menu'."
+
+ITEM is either defined as in `easy-menu-define' or a non-nil value returned
+by `easy-menu-item-present-p' or `easy-menu-remove-item' or a menu defined
+earlier by `easy-menu-define' or `easy-menu-create-menu'."
   (setq map (easy-menu-get-map map path))
-  (if (or (keymapp item)
-	  (and (symbolp item) (keymapp (symbol-value item))))
-      ;; Item is a keymap, find the prompt string and use as item name.
-      (let ((tail (easy-menu-get-map item nil)) name)
-	(if (not (keymapp item)) (setq item tail))
-	(while (and (null name) (consp (setq tail (cdr tail)))
-		    (not (keymapp tail)))
-	  (if (stringp (car tail)) (setq name (car tail)) ; Got a name.
-	    (setq tail (cdr tail))))
-	(setq item (cons name item))))
-  (easy-menu-do-add-item map item before))
+  (if (and (consp item) (consp (cdr item)) (eq (cadr item) 'menu-item))
+      ;; This is a value returned by `easy-menu-item-present-p' or
+      ;; `easy-menu-remove-item'.
+      (easy-menu-define-key-intern map (car item) (cdr item) before)
+    (if (or (keymapp item)
+	    (and (symbolp item) (keymapp (symbol-value item))))
+	;; Item is a keymap, find the prompt string and use as item name.
+	(let ((tail (easy-menu-get-map item nil)) name)
+	  (if (not (keymapp item)) (setq item tail))
+	  (while (and (null name) (consp (setq tail (cdr tail)))
+		      (not (keymapp tail)))
+	    (if (stringp (car tail)) (setq name (car tail)) ; Got a name.
+	      (setq tail (cdr tail))))
+	  (setq item (cons name item))))
+    (easy-menu-do-add-item map item before)))

 (defun easy-menu-item-present-p (map path name)
   "In submenu of MAP with path PATH, return true iff item NAME is present.
 MAP and PATH are defined as in `easy-menu-add-item'.
 NAME should be a string, the name of the element to be looked for."
-  (lookup-key (easy-menu-get-map map path) (vector (intern name))))
+  (easy-menu-return-item (easy-menu-get-map map path) name))

 (defun easy-menu-remove-item (map path name)
   "From submenu of MAP with path PATH remove item NAME.
 MAP and PATH are defined as in `easy-menu-add-item'.
 NAME should be a string, the name of the element to be removed."
-  (easy-menu-define-key (easy-menu-get-map map path) (intern name) nil))
+  (setq map (easy-menu-get-map map path))
+  (let ((ret (easy-menu-return-item map name)))
+    (if ret (easy-menu-define-key-intern map name nil))
+    ret))
+
+(defun easy-menu-return-item (menu name)
+  ;; In menu MENU try to look for menu item with name NAME.
+  ;; If a menu item is found, return (NAME . item), otherwise return nil.
+  ;; If item is an old format item, a new format item is returned.
+  (let ((item (lookup-key menu (vector (intern name))))
+	ret enable cache label)
+    (cond
+     ((or (keymapp item) (eq (car-safe item) 'menu-item))
+      (cons name item))			; Keymap or new menu format
+     ((stringp (car-safe item))
+      ;; This is the old menu format. Convert it to new format.
+      (setq label (car item))
+      (when (stringp (car (setq item (cdr item)))) ; Got help string
+	(setq ret (list :help (car item)))
+	(setq item (cdr item)))
+      (when (and (consp item) (consp (car item))
+		 (or (null (caar item)) (numberp (caar item))))
+	(setq cache (car item))		; Got cache
+	(setq item (cdr item)))
+      (and (symbolp item) (setq enable (get item 'menu-enable))	; Got enable
+	   (setq ret (cons :enable (cons enable ret))))
+      (if cache (setq ret (cons cache ret)))
+      (cons name (cons 'menu-enable (cons label (cons item ret))))))))

 (defun easy-menu-get-map (map path)
   ;; Return a sparse keymap in which to add or remove an item.