aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorRichard M. Stallman1999-01-04 18:53:32 +0000
committerRichard M. Stallman1999-01-04 18:53:32 +0000
commit3de63fb6350dc7dae540e9c5b5f2d9c984a0e8c0 (patch)
tree315355effa1446d0d3f3e72ce704e4c7114c1afd
parent55a2e19e03b81c0c955b409070910b866915c869 (diff)
downloademacs-3de63fb6350dc7dae540e9c5b5f2d9c984a0e8c0.tar.gz
emacs-3de63fb6350dc7dae540e9c5b5f2d9c984a0e8c0.zip
(easy-menu-define): Doc fix.
(easy-menu-create-menu): New keyword :included. (easy-menu-do-add-item): New keyword :included. SUFFIX may be an expression, not only a string. Simulate style `button'. Use easy-menu-define-key-intern instead of easy-menu-define-key. (easy-menu-define-key-intern): New function. (easy-menu-add-item): Understand value returned from easy-menu-item-present-p and easy-menu-remove-item. (easy-menu-return-item): New function. (easy-menu-item-present-p, easy-menu-remove-item): Use it.
-rw-r--r--lisp/emacs-lisp/easymenu.el178
1 files changed, 127 insertions, 51 deletions
diff --git a/lisp/emacs-lisp/easymenu.el b/lisp/emacs-lisp/easymenu.el
index f29279c7876..04c4a94e5d6 100644
--- a/lisp/emacs-lisp/easymenu.el
+++ b/lisp/emacs-lisp/easymenu.el
@@ -48,12 +48,24 @@ The menu keymap is stored in symbol SYMBOL, both as its value
48and as its function definition. DOC is used as the doc string for SYMBOL. 48and as its function definition. DOC is used as the doc string for SYMBOL.
49 49
50The first element of MENU must be a string. It is the menu bar item name. 50The first element of MENU must be a string. It is the menu bar item name.
51It may be followed by the keyword argument pair 51It may be followed by the following keyword argument pairs
52
52 :filter FUNCTION 53 :filter FUNCTION
54
53FUNCTION is a function with one argument, the menu. It returns the actual 55FUNCTION is a function with one argument, the menu. It returns the actual
54menu displayed. 56menu displayed.
55 57
56The rest of the elements are menu items. 58 :visible INCLUDE
59
60INCLUDE is an expression; this menu is only visible if this
61expression has a non-nil value. `:include' is an alias for `:visible'.
62
63 :active ENABLE
64
65ENABLE is an expression; the menu is enabled for selection
66whenever this expression's value is non-nil.
67
68The rest of the elements in MENU, are menu items.
57 69
58A menu item is usually a vector of three elements: [NAME CALLBACK ENABLE] 70A menu item is usually a vector of three elements: [NAME CALLBACK ENABLE]
59 71
@@ -76,12 +88,26 @@ Where KEYWORD is one of the symbols defined below.
76KEYS is a string; a complex keyboard equivalent to this menu item. 88KEYS is a string; a complex keyboard equivalent to this menu item.
77This is normally not needed because keyboard equivalents are usually 89This is normally not needed because keyboard equivalents are usually
78computed automatically. 90computed automatically.
91KEYS is expanded with `substitute-command-keys' before it is used.
92
93 :key-sequence KEYS
94
95KEYS is nil a string or a vector; nil or a keyboard equivalent to this
96menu item.
97This is a hint that will considerably speed up Emacs first display of
98a menu. Use `:key-sequence nil' when you know that this menu item has no
99keyboard equivalent.
79 100
80 :active ENABLE 101 :active ENABLE
81 102
82ENABLE is an expression; the item is enabled for selection 103ENABLE is an expression; the item is enabled for selection
83whenever this expression's value is non-nil. 104whenever this expression's value is non-nil.
84 105
106 :included INCLUDE
107
108INCLUDE is an expression; this item is only visible if this
109expression has a non-nil value.
110
85 :suffix NAME 111 :suffix NAME
86 112
87NAME is a string; the name of an argument to CALLBACK. 113NAME is a string; the name of an argument to CALLBACK.
@@ -92,10 +118,12 @@ STYLE is a symbol describing the type of menu item. The following are
92defined: 118defined:
93 119
94toggle: A checkbox. 120toggle: A checkbox.
95 Prepend the name with '(*) ' or '( ) ' depending on if selected or not. 121 Prepend the name with `(*) ' or `( ) ' depending on if selected or not.
96radio: A radio button. 122radio: A radio button.
97 Prepend the name with '[X] ' or '[ ] ' depending on if selected or not. 123 Prepend the name with `[X] ' or `[ ] ' depending on if selected or not.
98nil: An ordinary menu item. 124button: Surround the name with `[' and `]'. Use this for an item in the
125 menu bar itself.
126anything else means an ordinary menu item.
99 127
100 :selected SELECTED 128 :selected SELECTED
101 129
@@ -106,11 +134,7 @@ A menu item can be a string. Then that string appears in the menu as
106unselectable text. A string consisting solely of hyphens is displayed 134unselectable text. A string consisting solely of hyphens is displayed
107as a solid horizontal line. 135as a solid horizontal line.
108 136
109A menu item can be a list. It is treated as a submenu. 137A menu item can be a list with the same format as MENU. This is a submenu."
110The first element should be the submenu name. That's used as the
111menu item name in the top-level menu. It may be followed by the :filter
112FUNCTION keyword argument pair. The rest of the submenu list are menu items,
113as above."
114 `(progn 138 `(progn
115 (defvar ,symbol nil ,doc) 139 (defvar ,symbol nil ,doc)
116 (easy-menu-do-define (quote ,symbol) ,maps ,doc ,menu))) 140 (easy-menu-do-define (quote ,symbol) ,maps ,doc ,menu)))
@@ -134,8 +158,8 @@ as above."
134MENU is a menu as computed by `easy-menu-define' or `easy-menu-create-menu' or 158MENU is a menu as computed by `easy-menu-define' or `easy-menu-create-menu' or
135a symbol whose value is such a menu. 159a symbol whose value is such a menu.
136In Emacs a menu filter must return a menu (a keymap), in XEmacs a filter must 160In Emacs a menu filter must return a menu (a keymap), in XEmacs a filter must
137return a menu items list (without menu name and keywords). This function 161return a menu items list (without menu name and keywords).
138returns the right thing in the two cases." 162This function returns the right thing in the two cases."
139 (easy-menu-get-map menu nil)) ; Get past indirections. 163 (easy-menu-get-map menu nil)) ; Get past indirections.
140 164
141;;;###autoload 165;;;###autoload
@@ -152,10 +176,11 @@ possibly preceded by keyword pairs as described in `easy-menu-define'."
152 (setq arg (cadr menu-items)) 176 (setq arg (cadr menu-items))
153 (setq menu-items (cddr menu-items)) 177 (setq menu-items (cddr menu-items))
154 (cond 178 (cond
155 ((eq keyword ':filter) (setq filter arg)) 179 ((eq keyword :filter) (setq filter arg))
156 ((eq keyword ':active) (setq enable (or arg ''nil))) 180 ((eq keyword :active) (setq enable (or arg ''nil)))
157 ((eq keyword ':label) (setq label arg)) 181 ((eq keyword :label) (setq label arg))
158 ((eq keyword ':visible) (setq visible (or arg ''nil))))) 182 ((or (eq keyword :included) (eq keyword :visible))
183 (setq visible (or arg ''nil)))))
159 (if (equal visible ''nil) nil ; Invisible menu entry, return nil. 184 (if (equal visible ''nil) nil ; Invisible menu entry, return nil.
160 (if (and visible (not (easy-menu-always-true visible))) 185 (if (and visible (not (easy-menu-always-true visible)))
161 (setq prop (cons :visible (cons visible prop)))) 186 (setq prop (cons :visible (cons visible prop))))
@@ -172,7 +197,7 @@ possibly preceded by keyword pairs as described in `easy-menu-define'."
172 menu))) 197 menu)))
173 198
174 199
175;; Button prefixes. 200;; Known button types.
176(defvar easy-menu-button-prefix 201(defvar easy-menu-button-prefix
177 '((radio . :radio) (toggle . :toggle))) 202 '((radio . :radio) (toggle . :toggle)))
178 203
@@ -187,7 +212,7 @@ possibly preceded by keyword pairs as described in `easy-menu-define'."
187 ;; MENU, just change it, otherwise put it last in MENU. 212 ;; MENU, just change it, otherwise put it last in MENU.
188 (let (name command label prop remove) 213 (let (name command label prop remove)
189 (cond 214 (cond
190 ((stringp item) 215 ((stringp item) ; An unselectable string.
191 (setq label 216 (setq label
192 (if (string-match ; If an XEmacs separator 217 (if (string-match ; If an XEmacs separator
193 "^\\(-+\\|\ 218 "^\\(-+\\|\
@@ -195,7 +220,7 @@ possibly preceded by keyword pairs as described in `easy-menu-define'."
195shadow\\(Double\\)?Etched\\(In\\|Out\\)\\(Dash\\)?\\)\\)$" 220shadow\\(Double\\)?Etched\\(In\\|Out\\)\\(Dash\\)?\\)\\)$"
196 item) "" ; use a single line separator. 221 item) "" ; use a single line separator.
197 item))) 222 item)))
198 ((consp item) 223 ((consp item) ; A sub-menu.
199 (setq label (setq name (car item))) 224 (setq label (setq name (car item)))
200 (setq command (cdr item)) 225 (setq command (cdr item))
201 (if (not (keymapp command)) 226 (if (not (keymapp command))
@@ -208,7 +233,7 @@ shadow\\(Double\\)?Etched\\(In\\|Out\\)\\(Dash\\)?\\)\\)$"
208 (setq label (cadr prop)) 233 (setq label (cadr prop))
209 (setq prop (cddr prop))) 234 (setq prop (cddr prop)))
210 (setq command (symbol-function command))))) 235 (setq command (symbol-function command)))))
211 ((vectorp item) 236 ((vectorp item) ; An item.
212 (let* ((ilen (length item)) 237 (let* ((ilen (length item))
213 (active (if (> ilen 2) (or (aref item 2) ''nil) t)) 238 (active (if (> ilen 2) (or (aref item 2) ''nil) t))
214 (no-name (not (symbolp (setq command (aref item 1))))) 239 (no-name (not (symbolp (setq command (aref item 1)))))
@@ -224,7 +249,8 @@ shadow\\(Double\\)?Etched\\(In\\|Out\\)\\(Dash\\)?\\)\\)$"
224 (setq arg (aref item (1+ count))) 249 (setq arg (aref item (1+ count)))
225 (setq count (+ 2 count)) 250 (setq count (+ 2 count))
226 (cond 251 (cond
227 ((eq keyword :visible) (setq visible (or arg ''nil))) 252 ((or (eq keyword :included) (eq keyword :visible))
253 (setq visible (or arg ''nil)))
228 ((eq keyword :key-sequence) 254 ((eq keyword :key-sequence)
229 (setq cache arg cache-specified t)) 255 (setq cache arg cache-specified t))
230 ((eq keyword :keys) (setq keys arg no-name nil)) 256 ((eq keyword :keys) (setq keys arg no-name nil))
@@ -233,14 +259,22 @@ shadow\\(Double\\)?Etched\\(In\\|Out\\)\\(Dash\\)?\\)\\)$"
233 ((eq keyword :suffix) (setq suffix arg)) 259 ((eq keyword :suffix) (setq suffix arg))
234 ((eq keyword :style) (setq style arg)) 260 ((eq keyword :style) (setq style arg))
235 ((eq keyword :selected) (setq selected (or arg ''nil))))) 261 ((eq keyword :selected) (setq selected (or arg ''nil)))))
236 (if (stringp suffix) 262 (if suffix
237 (setq label (if (stringp label) (concat label " " suffix) 263 (setq label
238 (list 'concat label (concat " " suffix))))) 264 (if (stringp suffix)
239 (if (and selected 265 (if (stringp label) (concat label " " suffix)
240 (setq style (assq style easy-menu-button-prefix))) 266 (list 'concat label (concat " " suffix)))
241 (setq prop (cons :button 267 (if (stringp label)
242 (cons (cons (cdr style) (or selected ''nil)) 268 (list 'concat (concat label " ") suffix)
243 prop)))) 269 (list 'concat label " " suffix)))))
270 (cond
271 ((eq style 'button)
272 (setq label (if (stringp label) (concat "[" label "]")
273 (list 'concat "[" label "]"))))
274 ((and selected
275 (setq style (assq style easy-menu-button-prefix)))
276 (setq prop (cons :button
277 (cons (cons (cdr style) selected) prop)))))
244 (when (stringp keys) 278 (when (stringp keys)
245 (if (string-match "^[^\\]*\\(\\\\\\[\\([^]]+\\)]\\)[^\\]*$" 279 (if (string-match "^[^\\]*\\(\\\\\\[\\([^]]+\\)]\\)[^\\]*$"
246 keys) 280 keys)
@@ -270,12 +304,19 @@ shadow\\(Double\\)?Etched\\(In\\|Out\\)\\(Dash\\)?\\)\\)$"
270 (or (null cache) (stringp cache) (vectorp cache))) 304 (or (null cache) (stringp cache) (vectorp cache)))
271 (setq prop (cons :key-sequence (cons cache prop)))))) 305 (setq prop (cons :key-sequence (cons cache prop))))))
272 (t (error "Invalid menu item in easymenu"))) 306 (t (error "Invalid menu item in easymenu")))
273 (easy-menu-define-key menu (if (stringp name) (intern name) name) 307 (easy-menu-define-key-intern menu name
274 (and (not remove) 308 (and (not remove)
275 (cons 'menu-item 309 (cons 'menu-item
276 (cons label 310 (cons label
277 (and name (cons command prop))))) 311 (and name
278 (if (stringp before) (intern before) before)))) 312 (cons command prop)))))
313 before)))
314
315(defun easy-menu-define-key-intern (menu key item &optional before)
316 ;; This is the same as easy-menu-define-key, but it interns KEY and
317 ;; BEFORE if they are strings.
318 (easy-menu-define-key menu (if (stringp key) (intern key) key) item
319 (if (stringp before) (intern before) before)))
279 320
280(defun easy-menu-define-key (menu key item &optional before) 321(defun easy-menu-define-key (menu key item &optional before)
281 ;; Add binding in MENU for KEY => ITEM. Similar to `define-key-after'. 322 ;; Add binding in MENU for KEY => ITEM. Similar to `define-key-after'.
@@ -284,6 +325,8 @@ shadow\\(Double\\)?Etched\\(In\\|Out\\)\\(Dash\\)?\\)\\)$"
284 ;; Optional argument BEFORE is nil or a key in MENU. If BEFORE is not nil 325 ;; Optional argument BEFORE is nil or a key in MENU. If BEFORE is not nil
285 ;; put binding before BEFORE in MENU, otherwise if binding is already 326 ;; put binding before BEFORE in MENU, otherwise if binding is already
286 ;; present in MENU, just change it, otherwise put it last in MENU. 327 ;; present in MENU, just change it, otherwise put it last in MENU.
328 ;; KEY and BEFORE don't have to be symbols, comparison is done with equal
329 ;; not with eq.
287 (let ((inserted (null item)) ; Fake already inserted. 330 (let ((inserted (null item)) ; Fake already inserted.
288 tail done) 331 tail done)
289 (while (not done) 332 (while (not done)
@@ -358,7 +401,7 @@ Do it if `easy-menu-precalculate-equivalent-keybindings' is on,"
358 (if (keymapp menu) (x-popup-menu nil menu)))) 401 (if (keymapp menu) (x-popup-menu nil menu))))
359 402
360(defun easy-menu-add-item (map path item &optional before) 403(defun easy-menu-add-item (map path item &optional before)
361 "At the end of the submenu of MAP with path PATH add ITEM. 404 "To the submenu of MAP with path PATH, add ITEM.
362If ITEM is already present in this submenu, then this item will be changed. 405If ITEM is already present in this submenu, then this item will be changed.
363otherwise ITEM will be added at the end of the submenu, unless the optional 406otherwise ITEM will be added at the end of the submenu, unless the optional
364argument BEFORE is present, in which case ITEM will instead be added 407argument BEFORE is present, in which case ITEM will instead be added
@@ -372,32 +415,65 @@ PATH is a list of strings for locating the submenu where ITEM is to be
372added. If PATH is nil, MAP itself is used. Otherwise, the first 415added. If PATH is nil, MAP itself is used. Otherwise, the first
373element should be the name of a submenu directly under MAP. This 416element should be the name of a submenu directly under MAP. This
374submenu is then traversed recursively with the remaining elements of PATH. 417submenu is then traversed recursively with the remaining elements of PATH.
375ITEM is either defined as in `easy-menu-define' or a menu defined earlier 418
376by `easy-menu-define' or `easy-menu-create-menu'." 419ITEM is either defined as in `easy-menu-define' or a non-nil value returned
420by `easy-menu-item-present-p' or `easy-menu-remove-item' or a menu defined
421earlier by `easy-menu-define' or `easy-menu-create-menu'."
377 (setq map (easy-menu-get-map map path)) 422 (setq map (easy-menu-get-map map path))
378 (if (or (keymapp item) 423 (if (and (consp item) (consp (cdr item)) (eq (cadr item) 'menu-item))
379 (and (symbolp item) (keymapp (symbol-value item)))) 424 ;; This is a value returned by `easy-menu-item-present-p' or
380 ;; Item is a keymap, find the prompt string and use as item name. 425 ;; `easy-menu-remove-item'.
381 (let ((tail (easy-menu-get-map item nil)) name) 426 (easy-menu-define-key-intern map (car item) (cdr item) before)
382 (if (not (keymapp item)) (setq item tail)) 427 (if (or (keymapp item)
383 (while (and (null name) (consp (setq tail (cdr tail))) 428 (and (symbolp item) (keymapp (symbol-value item))))
384 (not (keymapp tail))) 429 ;; Item is a keymap, find the prompt string and use as item name.
385 (if (stringp (car tail)) (setq name (car tail)) ; Got a name. 430 (let ((tail (easy-menu-get-map item nil)) name)
386 (setq tail (cdr tail)))) 431 (if (not (keymapp item)) (setq item tail))
387 (setq item (cons name item)))) 432 (while (and (null name) (consp (setq tail (cdr tail)))
388 (easy-menu-do-add-item map item before)) 433 (not (keymapp tail)))
434 (if (stringp (car tail)) (setq name (car tail)) ; Got a name.
435 (setq tail (cdr tail))))
436 (setq item (cons name item))))
437 (easy-menu-do-add-item map item before)))
389 438
390(defun easy-menu-item-present-p (map path name) 439(defun easy-menu-item-present-p (map path name)
391 "In submenu of MAP with path PATH, return true iff item NAME is present. 440 "In submenu of MAP with path PATH, return true iff item NAME is present.
392MAP and PATH are defined as in `easy-menu-add-item'. 441MAP and PATH are defined as in `easy-menu-add-item'.
393NAME should be a string, the name of the element to be looked for." 442NAME should be a string, the name of the element to be looked for."
394 (lookup-key (easy-menu-get-map map path) (vector (intern name)))) 443 (easy-menu-return-item (easy-menu-get-map map path) name))
395 444
396(defun easy-menu-remove-item (map path name) 445(defun easy-menu-remove-item (map path name)
397 "From submenu of MAP with path PATH remove item NAME. 446 "From submenu of MAP with path PATH remove item NAME.
398MAP and PATH are defined as in `easy-menu-add-item'. 447MAP and PATH are defined as in `easy-menu-add-item'.
399NAME should be a string, the name of the element to be removed." 448NAME should be a string, the name of the element to be removed."
400 (easy-menu-define-key (easy-menu-get-map map path) (intern name) nil)) 449 (setq map (easy-menu-get-map map path))
450 (let ((ret (easy-menu-return-item map name)))
451 (if ret (easy-menu-define-key-intern map name nil))
452 ret))
453
454(defun easy-menu-return-item (menu name)
455 ;; In menu MENU try to look for menu item with name NAME.
456 ;; If a menu item is found, return (NAME . item), otherwise return nil.
457 ;; If item is an old format item, a new format item is returned.
458 (let ((item (lookup-key menu (vector (intern name))))
459 ret enable cache label)
460 (cond
461 ((or (keymapp item) (eq (car-safe item) 'menu-item))
462 (cons name item)) ; Keymap or new menu format
463 ((stringp (car-safe item))
464 ;; This is the old menu format. Convert it to new format.
465 (setq label (car item))
466 (when (stringp (car (setq item (cdr item)))) ; Got help string
467 (setq ret (list :help (car item)))
468 (setq item (cdr item)))
469 (when (and (consp item) (consp (car item))
470 (or (null (caar item)) (numberp (caar item))))
471 (setq cache (car item)) ; Got cache
472 (setq item (cdr item)))
473 (and (symbolp item) (setq enable (get item 'menu-enable)) ; Got enable
474 (setq ret (cons :enable (cons enable ret))))
475 (if cache (setq ret (cons cache ret)))
476 (cons name (cons 'menu-enable (cons label (cons item ret))))))))
401 477
402(defun easy-menu-get-map (map path) 478(defun easy-menu-get-map (map path)
403 ;; Return a sparse keymap in which to add or remove an item. 479 ;; Return a sparse keymap in which to add or remove an item.