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