(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.

(popup-menu): Update documentation string to describe the new syntax.

1 files changed, 81 insertions, 31 deletions

diff --git a/lisp/emacs-lisp/lmenu.el b/lisp/emacs-lisp/lmenu.el
index 8c152399a05..eed3fbb662e 100644
--- a/lisp/emacs-lisp/lmenu.el
+++ b/lisp/emacs-lisp/lmenu.el
@@ -63,9 +63,8 @@
     ;; since the define-key loop reverses them again.
     (setq menu-items (reverse menu-items))
     (while menu-items
-      (let* ((item (car menu-items))
-	     (callback (if (vectorp item) (aref item 1)))
-	     command name)
+      (let ((item (car menu-items))
+	    command name callback)
 	(cond ((stringp item)
 	       (setq command nil)
 	       (setq name (if (string-match "^-+$" item) "" item)))
@@ -74,20 +73,51 @@
 	       (setq name (car item)))
 	      ((vectorp item)
 	       (setq command (make-symbol (format "menu-function-%d"
-						  add-menu-item-count)))
-	       (setq add-menu-item-count (1+ add-menu-item-count))
-	       (if (aref item 2)
-		   (put command 'menu-enable (aref item 2))
-		 (put command 'menu-enable 'make-lucid-menu-keymap-disable))
-	       (setq name (aref item 0))	       
+						  add-menu-item-count))
+		     add-menu-item-count (1+ add-menu-item-count)
+		     name (aref item 0)
+		     callback (aref item 1))
 	       (if (symbolp callback)
 		   (fset command callback)
-		 (fset command (list 'lambda () '(interactive) callback)))))
+		 (fset command (list 'lambda () '(interactive) callback)))
+	       (let ((i 2))
+		 (while (< i (length item))
+		   (cond
+		    ((eq (aref item i) ':active)
+		     (put command 'menu-enable
+			  (or (aref item (1+ i))
+			      'make-lucid-menu-keymap-disable))
+		     (setq i (+ 2 i)))
+		    ((eq (aref item i) ':suffix)
+		     ;; unimplemented
+		     (setq i (+ 2 i)))
+		    ((eq (aref item i) ':keys)
+		     ;; unimplemented
+		     (setq i (+ 2 i)))
+		    ((eq (aref item i) ':style)
+		     ;; unimplemented
+		     (setq i (+ 2 i)))
+		    ((eq (aref item i) ':selected)
+		     ;; unimplemented
+		     (setq i (+ 2 i)))
+		    ((and (symbolp (aref item i))
+			  (= ?: (string-to-char (symbol-name (aref item i)))))
+		     (error "Unrecognized menu item keyword: %S"
+			    (aref item i)))
+		    ((= i 2)
+		     ;; old-style format: active-p &optional suffix
+		     (put command 'menu-enable
+			  (or (aref item i) 'make-lucid-menu-keymap-disable))
+		     ;; suffix is unimplemented
+		     (setq i (length item)))
+		    (t
+		     (error "Unexpected menu item value: %S"
+			    (aref item i))))))))
 	(if (null command)
 	    ;; Handle inactive strings specially--allow any number
 	    ;; of identical ones.
 	    (setcdr menu (cons (list nil name) (cdr menu)))
-	  (if name 
+	  (if name
 	      (define-key menu (vector (intern name)) (cons name command)))))
       (setq menu-items (cdr menu-items)))
     menu))
@@ -101,20 +131,33 @@ menu.  This is the string that will be displayed in the parent menu, if
 any.  For toplevel menus, it is ignored.  This string is not displayed
 in the menu itself.
 
-A menu item is a vector of three or four elements:
+A menu item is a vector containing:
 
  - the name of the menu item (a string);
  - the `callback' of that item;
- - whether this item is active (selectable);
- - and an optional string to append to the name.
+ - a list of keywords with associated values:
+   - :active active-p	a form specifying whether this item is selectable;
+   - :suffix suffix	a string to be appended to the name as an `argument'
+			to the command, like `Kill Buffer NAME';
+   - :keys command-keys	a string, suitable for `substitute-command-keys',
+			to specify the keyboard equivalent of a command
+			when the callback is a form (this is not necessary
+			when the callback is a symbol, as the keyboard
+			equivalent is computed automatically in that case);
+   - :style style	a symbol: nil for a normal menu item, `toggle' for
+			a toggle button (a single option that can be turned
+			on or off), or `radio' for a radio button (one of a
+			group of mutually exclusive options);
+   - :selected form	for `toggle' or `radio' style, a form that specifies
+			whether the button will be in the selected state.
+
+Alternately, the vector may contain exactly 3 or 4 elements, with the third
+element specifying `active-p' and the fourth specifying `suffix'.
 
 If the `callback' of a menu item is a symbol, then it must name a command.
 It will be invoked with `call-interactively'.  If it is a list, then it is
 evaluated with `eval'.
 
-The fourth element of a menu item is a convenient way of adding the name
-of a command's ``argument'' to the menu, like ``Kill Buffer NAME''.
-
 If an element of a menu is a string, then that string will be presented in
 the menu as unselectable text.
 
@@ -133,10 +176,17 @@ The syntax, more precisely:
    active-p	:=  <t or nil, whether this thing is selectable>
    text		:=  <string, non selectable>
    name		:=  <string>
-   argument	:=  <string>
-   menu-item	:=  '['  name callback active-p [ argument ]  ']'
-   menu		:=  '(' name [ menu-item | menu | text ]+ ')'
-"
+   suffix	:=  <string>
+   command-keys	:=  <string>
+   object-style	:=  'nil' | 'toggle' | 'radio'
+   keyword	:=  ':active' active-p
+		 |  ':suffix' suffix
+		 |  ':keys' command-keys
+		 |  ':style' object-style
+		 |  ':selected' form
+   menu-item	:=  '['  name callback active-p [ suffix ]  ']'
+		 |  '['  name callback [ keyword ]+  ']'
+   menu		:=  '(' name [ menu-item | menu | text ]+ ')'"
   (let ((menu (make-lucid-menu-keymap (car menu-desc) (cdr menu-desc)))
 	(pos (mouse-pixel-position))
 	answer cmd)
@@ -202,7 +252,7 @@ The syntax, more precisely:
 	    (call-interactively (cdr meaning))
 	  (eval (cdr meaning))))))
 
-;; This is empty because the usual elements of the menu bar 
+;; This is empty because the usual elements of the menu bar
 ;; are provided by menu-bar.el instead.
 ;; It would not make sense to duplicate them here.
 (defconst default-menubar nil)
@@ -252,9 +302,9 @@ Signals an error if the item is not found."
 
 (defun disable-menu-item (path)
   "Make the named menu item be unselectable.
-PATH is a list of strings which identify the position of the menu item in 
+PATH is a list of strings which identify the position of the menu item in
 the menu hierarchy.  (\"File\" \"Save\") means the menu item called \"Save\"
-under the toplevel \"File\" menu.  (\"Menu\" \"Foo\" \"Item\") means the 
+under the toplevel \"File\" menu.  (\"Menu\" \"Foo\" \"Item\") means the
 menu item called \"Item\" under the \"Foo\" submenu of \"Menu\"."
   (let* ((menubar current-menubar)
 	 (pair (find-menu-item menubar path))
@@ -271,9 +321,9 @@ menu item called \"Item\" under the \"Foo\" submenu of \"Menu\"."
 
 (defun enable-menu-item (path)
   "Make the named menu item be selectable.
-PATH is a list of strings which identify the position of the menu item in 
+PATH is a list of strings which identify the position of the menu item in
 the menu hierarchy.  (\"File\" \"Save\") means the menu item called \"Save\"
-under the toplevel \"File\" menu.  (\"Menu\" \"Foo\" \"Item\") means the 
+under the toplevel \"File\" menu.  (\"Menu\" \"Foo\" \"Item\") means the
 menu item called \"Item\" under the \"Foo\" submenu of \"Menu\"."
   (let* ((menubar current-menubar)
 	 (pair (find-menu-item menubar path))
@@ -357,7 +407,7 @@ MENU-PATH identifies the menu under which the new menu item should be inserted.
 ITEM-NAME is the string naming the menu item to be added.
 FUNCTION is the command to invoke when this menu item is selected.
  If it is a symbol, then it is invoked with `call-interactively', in the same
- way that functions bound to keys are invoked.  If it is a list, then the 
+ way that functions bound to keys are invoked.  If it is a list, then the
  list is simply evaluated.
 ENABLED-P controls whether the item is selectable or not.
 BEFORE, if provided, is the name of a menu item before which this item should
@@ -370,9 +420,9 @@ BEFORE, if provided, is the name of a menu item before which this item should
 
 (defun delete-menu-item (path)
   "Remove the named menu item from the menu hierarchy.
-PATH is a list of strings which identify the position of the menu item in 
+PATH is a list of strings which identify the position of the menu item in
 the menu hierarchy.  (\"File\" \"Save\") means the menu item called \"Save\"
-under the toplevel \"File\" menu.  (\"Menu\" \"Foo\" \"Item\") means the 
+under the toplevel \"File\" menu.  (\"Menu\" \"Foo\" \"Item\") means the
 menu item called \"Item\" under the \"Foo\" submenu of \"Menu\"."
   (let* ((menubar current-menubar)
 	 (pair (find-menu-item menubar path))
@@ -391,9 +441,9 @@ menu item called \"Item\" under the \"Foo\" submenu of \"Menu\"."
 
 (defun relabel-menu-item (path new-name)
   "Change the string of the specified menu item.
-PATH is a list of strings which identify the position of the menu item in 
+PATH is a list of strings which identify the position of the menu item in
 the menu hierarchy.  (\"File\" \"Save\") means the menu item called \"Save\"
-under the toplevel \"File\" menu.  (\"Menu\" \"Foo\" \"Item\") means the 
+under the toplevel \"File\" menu.  (\"Menu\" \"Foo\" \"Item\") means the
 menu item called \"Item\" under the \"Foo\" submenu of \"Menu\".
 NEW-NAME is the string that the menu item will be printed as from now on."
   (or (stringp new-name)