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