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