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