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