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