Line data Source code
1 : ;;; easymenu.el --- support the easymenu interface for defining a menu -*- lexical-binding:t -*-
2 :
3 : ;; Copyright (C) 1994, 1996, 1998-2017 Free Software Foundation, Inc.
4 :
5 : ;; Keywords: emulations
6 : ;; Author: Richard Stallman <rms@gnu.org>
7 : ;; Package: emacs
8 :
9 : ;; This file is part of GNU Emacs.
10 :
11 : ;; GNU Emacs is free software: you can redistribute it and/or modify
12 : ;; it under the terms of the GNU General Public License as published by
13 : ;; the Free Software Foundation, either version 3 of the License, or
14 : ;; (at your option) any later version.
15 :
16 : ;; GNU Emacs is distributed in the hope that it will be useful,
17 : ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 : ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 : ;; GNU General Public License for more details.
20 :
21 : ;; You should have received a copy of the GNU General Public License
22 : ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
23 :
24 : ;;; Commentary:
25 :
26 : ;; This is compatible with easymenu.el by Per Abrahamsen
27 : ;; but it is much simpler as it doesn't try to support other Emacs versions.
28 : ;; The code was mostly derived from lmenu.el.
29 :
30 : ;;; Code:
31 :
32 : (defvar easy-menu-precalculate-equivalent-keybindings nil
33 : "Determine when equivalent key bindings are computed for easy-menu menus.
34 : It can take some time to calculate the equivalent key bindings that are shown
35 : in a menu. If the variable is on, then this calculation gives a (maybe
36 : noticeable) delay when a mode is first entered. If the variable is off, then
37 : this delay will come when a menu is displayed the first time. If you never use
38 : menus, turn this variable off, otherwise it is probably better to keep it on.")
39 : (make-obsolete-variable
40 : 'easy-menu-precalculate-equivalent-keybindings nil "23.1")
41 :
42 : (defsubst easy-menu-intern (s)
43 19 : (if (stringp s) (intern s) s))
44 :
45 : ;;;###autoload
46 : (defmacro easy-menu-define (symbol maps doc menu)
47 : "Define a pop-up menu and/or menu bar menu specified by MENU.
48 : If SYMBOL is non-nil, define SYMBOL as a function to pop up the
49 : submenu defined by MENU, with DOC as its doc string.
50 :
51 : MAPS, if non-nil, should be a keymap or a list of keymaps; add
52 : the submenu defined by MENU to the keymap or each of the keymaps,
53 : as a top-level menu bar item.
54 :
55 : The first element of MENU must be a string. It is the menu bar
56 : item name. It may be followed by the following keyword argument
57 : pairs:
58 :
59 : :filter FUNCTION
60 : FUNCTION must be a function which, if called with one
61 : argument---the list of the other menu items---returns the
62 : items to actually display.
63 :
64 : :visible INCLUDE
65 : INCLUDE is an expression. The menu is visible if the
66 : expression evaluates to a non-nil value. `:included' is an
67 : alias for `:visible'.
68 :
69 : :active ENABLE
70 : ENABLE is an expression. The menu is enabled for selection
71 : if the expression evaluates to a non-nil value. `:enable' is
72 : an alias for `:active'.
73 :
74 : The rest of the elements in MENU are menu items.
75 : A menu item can be a vector of three elements:
76 :
77 : [NAME CALLBACK ENABLE]
78 :
79 : NAME is a string--the menu item name.
80 :
81 : CALLBACK is a command to run when the item is chosen, or an
82 : expression to evaluate when the item is chosen.
83 :
84 : ENABLE is an expression; the item is enabled for selection if the
85 : expression evaluates to a non-nil value.
86 :
87 : Alternatively, a menu item may have the form:
88 :
89 : [ NAME CALLBACK [ KEYWORD ARG ]... ]
90 :
91 : where NAME and CALLBACK have the same meanings as above, and each
92 : optional KEYWORD and ARG pair should be one of the following:
93 :
94 : :keys KEYS
95 : KEYS is a string; a keyboard equivalent to the menu item.
96 : This is normally not needed because keyboard equivalents are
97 : usually computed automatically. KEYS is expanded with
98 : `substitute-command-keys' before it is used.
99 :
100 : :key-sequence KEYS
101 : KEYS is a hint for speeding up Emacs's first display of the
102 : menu. It should be nil if you know that the menu item has no
103 : keyboard equivalent; otherwise it should be a string or
104 : vector specifying a keyboard equivalent for the menu item.
105 :
106 : :active ENABLE
107 : ENABLE is an expression; the item is enabled for selection
108 : whenever this expression's value is non-nil. `:enable' is an
109 : alias for `:active'.
110 :
111 : :visible INCLUDE
112 : INCLUDE is an expression; this item is only visible if this
113 : expression has a non-nil value. `:included' is an alias for
114 : `:visible'.
115 :
116 : :label FORM
117 : FORM is an expression that is dynamically evaluated and whose
118 : value serves as the menu item's label (the default is NAME).
119 :
120 : :suffix FORM
121 : FORM is an expression that is dynamically evaluated and whose
122 : value is concatenated with the menu entry's label.
123 :
124 : :style STYLE
125 : STYLE is a symbol describing the type of menu item; it should
126 : be `toggle' (a checkbox), or `radio' (a radio button), or any
127 : other value (meaning an ordinary menu item).
128 :
129 : :selected SELECTED
130 : SELECTED is an expression; the checkbox or radio button is
131 : selected whenever the expression's value is non-nil.
132 :
133 : :help HELP
134 : HELP is a string, the help to display for the menu item.
135 :
136 : Alternatively, a menu item can be a string. Then that string
137 : appears in the menu as unselectable text. A string consisting
138 : solely of dashes is displayed as a menu separator.
139 :
140 : Alternatively, a menu item can be a list with the same format as
141 : MENU. This is a submenu."
142 : (declare (indent defun) (debug (symbolp body)))
143 1 : `(progn
144 1 : ,(if symbol `(defvar ,symbol nil ,doc))
145 1 : (easy-menu-do-define (quote ,symbol) ,maps ,doc ,menu)))
146 :
147 : (defun easy-menu-binding (menu &optional item-name)
148 : "Return a binding suitable to pass to `define-key'.
149 : This is expected to be bound to a mouse event."
150 : ;; Under Emacs this is almost trivial, whereas under XEmacs this may
151 : ;; involve defining a function that calls popup-menu.
152 3 : (let ((props (if (symbolp menu)
153 0 : (prog1 (get menu 'menu-prop)
154 3 : (setq menu (symbol-function menu))))))
155 3 : (cons 'menu-item
156 3 : (cons (if (eq :label (car props))
157 0 : (prog1 (cadr props)
158 0 : (setq props (cddr props)))
159 3 : (or item-name
160 0 : (if (keymapp menu)
161 0 : (keymap-prompt menu))
162 3 : ""))
163 3 : (cons menu props)))))
164 :
165 : ;;;###autoload
166 : (defun easy-menu-do-define (symbol maps doc menu)
167 : ;; We can't do anything that might differ between Emacs dialects in
168 : ;; `easy-menu-define' in order to make byte compiled files
169 : ;; compatible. Therefore everything interesting is done in this
170 : ;; function.
171 3 : (let ((keymap (easy-menu-create-menu (car menu) (cdr menu))))
172 3 : (when symbol
173 3 : (set symbol keymap)
174 3 : (defalias symbol
175 3 : `(lambda (event) ,doc (interactive "@e")
176 : ;; FIXME: XEmacs uses popup-menu which calls the binding
177 : ;; while x-popup-menu only returns the selection.
178 : (x-popup-menu event
179 3 : (or (and (symbolp ,symbol)
180 : (funcall
181 3 : (or (plist-get (get ,symbol 'menu-prop)
182 : :filter)
183 : 'identity)
184 3 : (symbol-function ,symbol)))
185 3 : ,symbol)))))
186 3 : (dolist (map (if (keymapp maps) (list maps) maps))
187 3 : (define-key map
188 3 : (vector 'menu-bar (easy-menu-intern (car menu)))
189 3 : (easy-menu-binding keymap (car menu))))))
190 :
191 : (defun easy-menu-filter-return (menu &optional name)
192 : "Convert MENU to the right thing to return from a menu filter.
193 : MENU is a menu as computed by `easy-menu-define' or `easy-menu-create-menu' or
194 : a symbol whose value is such a menu.
195 : In Emacs a menu filter must return a menu (a keymap), in XEmacs a filter must
196 : return a menu items list (without menu name and keywords).
197 : This function returns the right thing in the two cases.
198 : If NAME is provided, it is used for the keymap."
199 0 : (cond
200 0 : ((and (not (keymapp menu)) (consp menu))
201 : ;; If it's a cons but not a keymap, then it can't be right
202 : ;; unless it's an XEmacs menu.
203 0 : (setq menu (easy-menu-create-menu (or name "") menu)))
204 0 : ((vectorp menu)
205 : ;; It's just a menu entry.
206 0 : (setq menu (cdr (easy-menu-convert-item menu)))))
207 0 : menu)
208 :
209 : (defvar easy-menu-avoid-duplicate-keys t
210 : "Dynamically scoped var to register already used keys in a menu.
211 : If it holds a list, this is expected to be a list of keys already seen in the
212 : menu we're processing. Else it means we're not processing a menu.")
213 :
214 : ;;;###autoload
215 : (defun easy-menu-create-menu (menu-name menu-items)
216 : "Create a menu called MENU-NAME with items described in MENU-ITEMS.
217 : MENU-NAME is a string, the name of the menu. MENU-ITEMS is a list of items
218 : possibly preceded by keyword pairs as described in `easy-menu-define'."
219 3 : (let ((menu (make-sparse-keymap menu-name))
220 : (easy-menu-avoid-duplicate-keys nil)
221 : prop keyword label enable filter visible help)
222 : ;; Look for keywords.
223 3 : (while (and menu-items
224 3 : (cdr menu-items)
225 3 : (keywordp (setq keyword (car menu-items))))
226 0 : (let ((arg (cadr menu-items)))
227 0 : (setq menu-items (cddr menu-items))
228 0 : (pcase keyword
229 : (`:filter
230 0 : (setq filter (lambda (menu)
231 0 : (easy-menu-filter-return (funcall arg menu)
232 0 : menu-name))))
233 0 : ((or `:enable `:active) (setq enable (or arg ''nil)))
234 0 : (`:label (setq label arg))
235 0 : (`:help (setq help arg))
236 3 : ((or `:included `:visible) (setq visible (or arg ''nil))))))
237 3 : (if (equal visible ''nil)
238 : nil ; Invisible menu entry, return nil.
239 3 : (if (and visible (not (easy-menu-always-true-p visible)))
240 3 : (setq prop (cons :visible (cons visible prop))))
241 3 : (if (and enable (not (easy-menu-always-true-p enable)))
242 3 : (setq prop (cons :enable (cons enable prop))))
243 3 : (if filter (setq prop (cons :filter (cons filter prop))))
244 3 : (if help (setq prop (cons :help (cons help prop))))
245 3 : (if label (setq prop (cons :label (cons label prop))))
246 3 : (setq menu (if filter
247 : ;; The filter expects the menu in its XEmacs form and the
248 : ;; pre-filter form will only be passed to the filter
249 : ;; anyway, so we'd better not convert it at all (it will
250 : ;; be converted on the fly by easy-menu-filter-return).
251 0 : menu-items
252 3 : (append menu (mapcar 'easy-menu-convert-item menu-items))))
253 3 : (when prop
254 0 : (setq menu (easy-menu-make-symbol menu 'noexp))
255 3 : (put menu 'menu-prop prop))
256 3 : menu)))
257 :
258 :
259 : ;; Known button types.
260 : (defvar easy-menu-button-prefix
261 : '((radio . :radio) (toggle . :toggle)))
262 :
263 : (defvar easy-menu-converted-items-table (make-hash-table :test 'equal))
264 :
265 : (defun easy-menu-convert-item (item)
266 : "Memoize the value returned by `easy-menu-convert-item-1' called on ITEM.
267 : This makes key-shortcut-caching work a *lot* better when this
268 : conversion is done from within a filter.
269 : This also helps when the NAME of the entry is recreated each time:
270 : since the menu is built and traversed separately, the lookup
271 : would always fail because the key is `equal' but not `eq'."
272 24 : (let* ((cache (gethash item easy-menu-converted-items-table))
273 24 : (result (or cache (easy-menu-convert-item-1 item)))
274 24 : (key (car-safe result)))
275 24 : (when (and (listp easy-menu-avoid-duplicate-keys) (symbolp key))
276 : ;; Merging multiple entries with the same name is sometimes what we
277 : ;; want, but not when the entries are actually different (e.g. same
278 : ;; name but different :suffix as seen in cal-menu.el) and appear in
279 : ;; the same menu. So we try to detect and resolve conflicts.
280 27 : (while (memq key easy-menu-avoid-duplicate-keys)
281 : ;; We need to use some distinct object, ideally a symbol, ideally
282 : ;; related to the `name'. Uninterned symbols do not work (they
283 : ;; are apparently turned into strings and re-interned later on).
284 3 : (setq key (intern (format "%s-%d" (symbol-name key)
285 3 : (length easy-menu-avoid-duplicate-keys))))
286 24 : (setq result (cons key (cdr result))))
287 48 : (push key easy-menu-avoid-duplicate-keys))
288 :
289 24 : (unless cache (puthash item result easy-menu-converted-items-table))
290 24 : result))
291 :
292 : (defun easy-menu-convert-item-1 (item)
293 : "Parse an item description and convert it to a menu keymap element.
294 : ITEM defines an item as in `easy-menu-define'."
295 16 : (let (name command label prop remove)
296 16 : (cond
297 16 : ((stringp item) ; An item or separator.
298 1 : (setq label item))
299 15 : ((consp item) ; A sub-menu
300 0 : (setq label (setq name (car item)))
301 0 : (setq command (cdr item))
302 0 : (if (not (keymapp command))
303 0 : (setq command (easy-menu-create-menu name command)))
304 0 : (if (null command)
305 : ;; Invisible menu item. Don't insert into keymap.
306 0 : (setq remove t)
307 0 : (when (and (symbolp command) (setq prop (get command 'menu-prop)))
308 0 : (when (eq :label (car prop))
309 0 : (setq label (cadr prop))
310 0 : (setq prop (cddr prop)))
311 0 : (setq command (symbol-function command)))))
312 15 : ((vectorp item) ; An item.
313 15 : (let* ((ilen (length item))
314 15 : (active (if (> ilen 2) (or (aref item 2) ''nil) t))
315 15 : (no-name (not (symbolp (setq command (aref item 1)))))
316 : cache cache-specified)
317 15 : (setq label (setq name (aref item 0)))
318 15 : (if no-name (setq command (easy-menu-make-symbol command)))
319 15 : (if (keywordp active)
320 12 : (let ((count 2)
321 : keyword arg suffix visible style selected keys)
322 12 : (setq active nil)
323 24 : (while (> ilen count)
324 12 : (setq keyword (aref item count))
325 12 : (setq arg (aref item (1+ count)))
326 12 : (setq count (+ 2 count))
327 12 : (pcase keyword
328 0 : ((or `:included `:visible) (setq visible (or arg ''nil)))
329 0 : (`:key-sequence (setq cache arg cache-specified t))
330 0 : (`:keys (setq keys arg no-name nil))
331 0 : (`:label (setq label arg))
332 7 : ((or `:active `:enable) (setq active (or arg ''nil)))
333 5 : (`:help (setq prop (cons :help (cons arg prop))))
334 0 : (`:suffix (setq suffix arg))
335 0 : (`:style (setq style arg))
336 12 : (`:selected (setq selected (or arg ''nil)))))
337 12 : (if suffix
338 0 : (setq label
339 0 : (if (stringp suffix)
340 0 : (if (stringp label) (concat label " " suffix)
341 0 : `(concat ,label ,(concat " " suffix)))
342 0 : (if (stringp label)
343 0 : `(concat ,(concat label " ") ,suffix)
344 12 : `(concat ,label " " ,suffix)))))
345 12 : (cond
346 12 : ((eq style 'button)
347 0 : (setq label (if (stringp label) (concat "[" label "]")
348 0 : `(concat "[" ,label "]"))))
349 12 : ((and selected
350 12 : (setq style (assq style easy-menu-button-prefix)))
351 0 : (setq prop (cons :button
352 12 : (cons (cons (cdr style) selected) prop)))))
353 12 : (when (stringp keys)
354 0 : (if (string-match "^[^\\]*\\(\\\\\\[\\([^]]+\\)]\\)[^\\]*$"
355 0 : keys)
356 0 : (let ((prefix
357 0 : (if (< (match-beginning 0) (match-beginning 1))
358 0 : (substring keys 0 (match-beginning 1))))
359 : (postfix
360 0 : (if (< (match-end 1) (match-end 0))
361 0 : (substring keys (match-end 1))))
362 0 : (cmd (intern (match-string 2 keys))))
363 0 : (setq keys (and (or prefix postfix)
364 0 : (cons prefix postfix)))
365 0 : (setq keys
366 0 : (and (or keys (not (eq command cmd)))
367 0 : (cons cmd keys))))
368 0 : (setq cache-specified nil))
369 12 : (if keys (setq prop (cons :keys (cons keys prop)))))
370 12 : (if (and visible (not (easy-menu-always-true-p visible)))
371 0 : (if (equal visible ''nil)
372 : ;; Invisible menu item. Don't insert into keymap.
373 0 : (setq remove t)
374 15 : (setq prop (cons :visible (cons visible prop)))))))
375 15 : (if (and active (not (easy-menu-always-true-p active)))
376 15 : (setq prop (cons :enable (cons active prop))))
377 15 : (if (and (or no-name cache-specified)
378 15 : (or (null cache) (stringp cache) (vectorp cache)))
379 15 : (setq prop (cons :key-sequence (cons cache prop))))))
380 16 : (t (error "Invalid menu item in easymenu")))
381 : ;; `intern' the name so as to merge multiple entries with the same name.
382 : ;; It also makes it easier/possible to lookup/change menu bindings
383 : ;; via keymap functions.
384 16 : (let ((key (easy-menu-intern name)))
385 16 : (cons key
386 16 : (and (not remove)
387 16 : (cons 'menu-item
388 16 : (cons label
389 16 : (and name
390 16 : (cons command prop)))))))))
391 :
392 : (defun easy-menu-define-key (menu key item &optional before)
393 : "Add binding in MENU for KEY => ITEM. Similar to `define-key-after'.
394 : If KEY is not nil then delete any duplications.
395 : If ITEM is nil, then delete the definition of KEY.
396 :
397 : Optional argument BEFORE is nil or a key in MENU. If BEFORE is not nil,
398 : put binding before the item in MENU named BEFORE; otherwise,
399 : if a binding for KEY is already present in MENU, just change it;
400 : otherwise put the new binding last in MENU.
401 : BEFORE can be either a string (menu item name) or a symbol
402 : \(the fake function key for the menu item).
403 : KEY does not have to be a symbol, and comparison is done with equal."
404 0 : (if (symbolp menu) (setq menu (indirect-function menu)))
405 0 : (let ((inserted (null item)) ; Fake already inserted.
406 : tail done)
407 0 : (while (not done)
408 0 : (cond
409 0 : ((or (setq done (or (null (cdr menu)) (keymapp (cdr menu))))
410 0 : (and before (easy-menu-name-match before (cadr menu))))
411 : ;; If key is nil, stop here, otherwise keep going past the
412 : ;; inserted element so we can delete any duplications that come
413 : ;; later.
414 0 : (if (null key) (setq done t))
415 0 : (unless inserted ; Don't insert more than once.
416 0 : (setcdr menu (cons (cons key item) (cdr menu)))
417 0 : (setq inserted t)
418 0 : (setq menu (cdr menu)))
419 0 : (setq menu (cdr menu)))
420 0 : ((and key (equal (car-safe (cadr menu)) key))
421 0 : (if (or inserted ; Already inserted or
422 0 : (and before ; wanted elsewhere and
423 0 : (setq tail (cddr menu)) ; not last item and not
424 0 : (not (keymapp tail))
425 0 : (not (easy-menu-name-match
426 0 : before (car tail))))) ; in position
427 0 : (setcdr menu (cddr menu)) ; Remove item.
428 0 : (setcdr (cadr menu) item) ; Change item.
429 0 : (setq inserted t)
430 0 : (setq menu (cdr menu))))
431 0 : (t (setq menu (cdr menu)))))))
432 :
433 : (defun easy-menu-name-match (name item)
434 : "Return t if NAME is the name of menu item ITEM.
435 : NAME can be either a string, or a symbol.
436 : ITEM should be a keymap binding of the form (KEY . MENU-ITEM)."
437 0 : (if (consp item)
438 0 : (if (symbolp name)
439 0 : (eq (car-safe item) name)
440 0 : (if (stringp name)
441 : ;; Match against the text that is displayed to the user.
442 0 : (or (condition-case nil (member-ignore-case name item)
443 0 : (error nil)) ;`item' might not be a proper list.
444 : ;; Also check the string version of the symbol name,
445 : ;; for backwards compatibility.
446 0 : (eq (car-safe item) (intern name)))))))
447 :
448 : (defun easy-menu-always-true-p (x)
449 : "Return true if form X never evaluates to nil."
450 10 : (if (consp x) (and (eq (car x) 'quote) (cadr x))
451 10 : (or (eq x t) (not (symbolp x)))))
452 :
453 : (defvar easy-menu-item-count 0)
454 :
455 : (defun easy-menu-make-symbol (callback &optional noexp)
456 : "Return a unique symbol with CALLBACK as function value.
457 : When non-nil, NOEXP indicates that CALLBACK cannot be an expression
458 : \(i.e. does not need to be turned into a function)."
459 0 : (let ((command
460 0 : (make-symbol (format "menu-function-%d" easy-menu-item-count))))
461 0 : (setq easy-menu-item-count (1+ easy-menu-item-count))
462 0 : (fset command
463 0 : (if (or (keymapp callback) (commandp callback)
464 : ;; `functionp' is probably not needed.
465 0 : (functionp callback) noexp)
466 0 : callback
467 0 : `(lambda () (interactive) ,callback)))
468 0 : command))
469 :
470 : ;;;###autoload
471 : (defun easy-menu-change (path name items &optional before map)
472 : "Change menu found at PATH as item NAME to contain ITEMS.
473 : PATH is a list of strings for locating the menu that
474 : should contain a submenu named NAME.
475 : ITEMS is a list of menu items, as in `easy-menu-define'.
476 : These items entirely replace the previous items in that submenu.
477 :
478 : If MAP is specified, it should normally be a keymap; nil stands for the local
479 : menu-bar keymap. It can also be a symbol, which has earlier been used as the
480 : first argument in a call to `easy-menu-define', or the value of such a symbol.
481 :
482 : If the menu located by PATH has no submenu named NAME, add one.
483 : If the optional argument BEFORE is present, add it just before
484 : the submenu named BEFORE, otherwise add it at the end of the menu.
485 :
486 : To implement dynamic menus, either call this from
487 : `menu-bar-update-hook' or use a menu filter."
488 0 : (easy-menu-add-item map path (easy-menu-create-menu name items) before))
489 :
490 : ;; XEmacs needs the following two functions to add and remove menus.
491 : ;; In Emacs this is done automatically when switching keymaps, so
492 : ;; here easy-menu-remove and easy-menu-add are a noops.
493 : (defalias 'easy-menu-remove 'ignore
494 : "Remove MENU from the current menu bar.
495 : Contrary to XEmacs, this is a nop on Emacs since menus are automatically
496 : \(de)activated when the corresponding keymap is (de)activated.
497 :
498 : \(fn MENU)")
499 :
500 : (defalias 'easy-menu-add #'ignore
501 : "Add the menu to the menubar.
502 : On Emacs this is a nop, because menus are already automatically
503 : activated when the corresponding keymap is activated. On XEmacs
504 : this is needed to actually add the menu to the current menubar.
505 :
506 : You should call this once the menu and keybindings are set up
507 : completely and menu filter functions can be expected to work.
508 :
509 : \(fn MENU &optional MAP)")
510 :
511 : (defun add-submenu (menu-path submenu &optional before in-menu)
512 : "Add submenu SUBMENU in the menu at MENU-PATH.
513 : If BEFORE is non-nil, add before the item named BEFORE.
514 : If IN-MENU is non-nil, follow MENU-PATH in IN-MENU.
515 : This is a compatibility function; use `easy-menu-add-item'."
516 0 : (easy-menu-add-item (or in-menu (current-global-map))
517 0 : (cons "menu-bar" menu-path)
518 0 : submenu before))
519 :
520 : (defun easy-menu-add-item (map path item &optional before)
521 : "To the submenu of MAP with path PATH, add ITEM.
522 :
523 : If an item with the same name is already present in this submenu,
524 : then ITEM replaces it. Otherwise, ITEM is added to this submenu.
525 : In the latter case, ITEM is normally added at the end of the submenu.
526 : However, if BEFORE is a string and there is an item in the submenu
527 : with that name, then ITEM is added before that item.
528 :
529 : MAP should normally be a keymap; nil stands for the local menu-bar keymap.
530 : It can also be a symbol, which has earlier been used as the first
531 : argument in a call to `easy-menu-define', or the value of such a symbol.
532 :
533 : PATH is a list of strings for locating the submenu where ITEM is to be
534 : added. If PATH is nil, MAP itself is used. Otherwise, the first
535 : element should be the name of a submenu directly under MAP. This
536 : submenu is then traversed recursively with the remaining elements of PATH.
537 :
538 : ITEM is either defined as in `easy-menu-define' or a non-nil value returned
539 : by `easy-menu-item-present-p' or `easy-menu-remove-item' or a menu defined
540 : earlier by `easy-menu-define' or `easy-menu-create-menu'."
541 0 : (setq map (easy-menu-get-map map path
542 0 : (and (null map) (null path)
543 0 : (stringp (car-safe item))
544 0 : (car item))))
545 0 : (if (and (consp item) (consp (cdr item)) (eq (cadr item) 'menu-item))
546 : ;; This is a value returned by `easy-menu-item-present-p' or
547 : ;; `easy-menu-remove-item'.
548 0 : (easy-menu-define-key map (easy-menu-intern (car item))
549 0 : (cdr item) before)
550 0 : (if (or (keymapp item)
551 0 : (and (symbolp item) (keymapp (symbol-value item))
552 0 : (setq item (symbol-value item))))
553 : ;; Item is a keymap, find the prompt string and use as item name.
554 0 : (setq item (cons (keymap-prompt item) item)))
555 0 : (setq item (easy-menu-convert-item item))
556 0 : (easy-menu-define-key map (easy-menu-intern (car item)) (cdr item) before)))
557 :
558 : (defun easy-menu-item-present-p (map path name)
559 : "In submenu of MAP with path PATH, return non-nil if item NAME is present.
560 : MAP and PATH are defined as in `easy-menu-add-item'.
561 : NAME should be a string, the name of the element to be looked for."
562 0 : (easy-menu-return-item (easy-menu-get-map map path) name))
563 :
564 : (defun easy-menu-remove-item (map path name)
565 : "From submenu of MAP with path PATH remove item NAME.
566 : MAP and PATH are defined as in `easy-menu-add-item'.
567 : NAME should be a string, the name of the element to be removed."
568 0 : (setq map (easy-menu-get-map map path))
569 0 : (let ((ret (easy-menu-return-item map name)))
570 0 : (if ret (easy-menu-define-key map (easy-menu-intern name) nil))
571 0 : ret))
572 :
573 : (defun easy-menu-return-item (menu name)
574 : "In menu MENU try to look for menu item with name NAME.
575 : If a menu item is found, return (NAME . item), otherwise return nil.
576 : If item is an old format item, a new format item is returned."
577 : ;; The call to `lookup-key' also calls the C function `get_keyelt' which
578 : ;; looks inside a menu-item to only return the actual command. This is
579 : ;; not what we want here. We should either add an arg to lookup-key to be
580 : ;; able to turn off this "feature", or else we could use map-keymap here.
581 : ;; In the mean time, I just use `assq' which is an OK approximation since
582 : ;; menus are rarely built from vectors or char-tables.
583 0 : (let ((item (or (cdr (assq name menu))
584 0 : (lookup-key menu (vector (easy-menu-intern name)))))
585 : ret enable cache label)
586 0 : (cond
587 0 : ((stringp (car-safe item))
588 : ;; This is the old menu format. Convert it to new format.
589 0 : (setq label (car item))
590 0 : (when (stringp (car (setq item (cdr item)))) ; Got help string
591 0 : (setq ret (list :help (car item)))
592 0 : (setq item (cdr item)))
593 0 : (when (and (consp item) (consp (car item))
594 0 : (or (null (caar item)) (numberp (caar item))))
595 0 : (setq cache (car item)) ; Got cache
596 0 : (setq item (cdr item)))
597 0 : (and (symbolp item) (setq enable (get item 'menu-enable)) ; Got enable
598 0 : (setq ret (cons :enable (cons enable ret))))
599 0 : (if cache (setq ret (cons cache ret)))
600 0 : (cons name (cons 'menu-enable (cons label (cons item ret)))))
601 0 : (item ; (or (symbolp item) (keymapp item) (eq (car-safe item) 'menu-item))
602 0 : (cons name item)) ; Keymap or new menu format
603 0 : )))
604 :
605 : (defun easy-menu-lookup-name (map name)
606 : "Lookup menu item NAME in keymap MAP.
607 : Like `lookup-key' except that NAME is not an array but just a single key
608 : and that NAME can be a string representing the menu item's name."
609 0 : (or (lookup-key map (vector (easy-menu-intern name)))
610 0 : (when (stringp name)
611 : ;; `lookup-key' failed and we have a menu item name: look at the
612 : ;; actual menu entries's names.
613 0 : (catch 'found
614 0 : (map-keymap (lambda (key item)
615 0 : (if (condition-case nil (member name item)
616 0 : (error nil))
617 : ;; Found it!! Look for it again with
618 : ;; `lookup-key' so as to handle inheritance and
619 : ;; to extract the actual command/keymap bound to
620 : ;; `name' from the item (via get_keyelt).
621 0 : (throw 'found (lookup-key map (vector key)))))
622 0 : map)))))
623 :
624 : (defun easy-menu-get-map (map path &optional to-modify)
625 : "Return a sparse keymap in which to add or remove an item.
626 : MAP and PATH are as defined in `easy-menu-add-item'.
627 :
628 : TO-MODIFY, if non-nil, is the name of the item the caller
629 : wants to modify in the map that we return.
630 : In some cases we use that to select between the local and global maps."
631 0 : (setq map
632 0 : (catch 'found
633 0 : (if (and map (symbolp map) (not (keymapp map)))
634 0 : (setq map (symbol-value map)))
635 0 : (let ((maps (if map (if (keymapp map) (list map) map)
636 0 : (current-active-maps))))
637 : ;; Look for PATH in each map.
638 0 : (unless map (push 'menu-bar path))
639 0 : (dolist (name path)
640 0 : (setq maps
641 0 : (delq nil (mapcar (lambda (map)
642 0 : (setq map (easy-menu-lookup-name
643 0 : map name))
644 0 : (and (keymapp map) map))
645 0 : maps))))
646 :
647 : ;; Prefer a map that already contains the to-be-modified entry.
648 0 : (when to-modify
649 0 : (dolist (map maps)
650 0 : (when (easy-menu-lookup-name map to-modify)
651 0 : (throw 'found map))))
652 : ;; Use the first valid map.
653 0 : (when maps (throw 'found (car maps)))
654 :
655 : ;; Otherwise, make one up.
656 : ;; Hardcoding current-local-map is lame, but it's difficult
657 : ;; to know what the caller intended for us to do ;-(
658 0 : (let* ((name (if path (format "%s" (car (reverse path)))))
659 0 : (newmap (make-sparse-keymap name)))
660 0 : (define-key (or map (current-local-map))
661 0 : (apply 'vector (mapcar 'easy-menu-intern path))
662 0 : (if name (cons name newmap) newmap))
663 0 : newmap))))
664 0 : (or (keymapp map) (error "Malformed menu in easy-menu: (%s)" map))
665 0 : map)
666 :
667 : (provide 'easymenu)
668 :
669 : ;;; easymenu.el ends here
|