6529
|
1 ;;; easymenu.el --- support the easymenu interface for defining a menu.
|
|
2
|
20791
|
3 ;; Copyright (C) 1994, 1996, 1998 Free Software Foundation, Inc.
|
6600
|
4
|
6529
|
5 ;; Keywords: emulations
|
6600
|
6 ;; Author: rms
|
6529
|
7
|
|
8 ;; This file is part of GNU Emacs.
|
|
9
|
|
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
|
|
11 ;; it under the terms of the GNU General Public License as published by
|
|
12 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
13 ;; any later version.
|
|
14
|
|
15 ;; GNU Emacs is distributed in the hope that it will be useful,
|
|
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
18 ;; GNU General Public License for more details.
|
|
19
|
|
20 ;; You should have received a copy of the GNU General Public License
|
14169
|
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
|
|
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
23 ;; Boston, MA 02111-1307, USA.
|
6529
|
24
|
14169
|
25 ;;; Commentary:
|
|
26
|
|
27 ;; This is compatible with easymenu.el by Per Abrahamsen
|
|
28 ;; but it is much simpler as it doesn't try to support other Emacs versions.
|
|
29 ;; The code was mostly derived from lmenu.el.
|
6529
|
30
|
|
31 ;;; Code:
|
|
32
|
22196
|
33 (defcustom easy-menu-precalculate-equivalent-keybindings t
|
|
34 "Determine when equivalent key bindings are computed for easy-menu menus.
|
|
35 It can take some time to calculate the equivalent key bindings that are shown
|
|
36 in a menu. If the variable is on, then this calculation gives a (maybe
|
|
37 noticeable) delay when a mode is first entered. If the variable is off, then
|
|
38 this delay will come when a menu is displayed the first time. If you never use
|
|
39 menus, turn this variable off, otherwise it is probably better to keep it on."
|
|
40 :type 'boolean
|
|
41 :group 'menu
|
|
42 :version "20.3")
|
|
43
|
6542
|
44 ;;;###autoload
|
6600
|
45 (defmacro easy-menu-define (symbol maps doc menu)
|
6529
|
46 "Define a menu bar submenu in maps MAPS, according to MENU.
|
11512
|
47 The menu keymap is stored in symbol SYMBOL, both as its value
|
|
48 and as its function definition. DOC is used as the doc string for SYMBOL.
|
6529
|
49
|
|
50 The first element of MENU must be a string. It is the menu bar item name.
|
23991
|
51 It may be followed by the following keyword argument pairs
|
|
52
|
20791
|
53 :filter FUNCTION
|
23991
|
54
|
20791
|
55 FUNCTION is a function with one argument, the menu. It returns the actual
|
|
56 menu displayed.
|
|
57
|
23991
|
58 :visible INCLUDE
|
|
59
|
|
60 INCLUDE is an expression; this menu is only visible if this
|
|
61 expression has a non-nil value. `:include' is an alias for `:visible'.
|
|
62
|
|
63 :active ENABLE
|
|
64
|
|
65 ENABLE is an expression; the menu is enabled for selection
|
|
66 whenever this expression's value is non-nil.
|
|
67
|
|
68 The rest of the elements in MENU, are menu items.
|
6529
|
69
|
6600
|
70 A menu item is usually a vector of three elements: [NAME CALLBACK ENABLE]
|
6529
|
71
|
6542
|
72 NAME is a string--the menu item name.
|
6529
|
73
|
6542
|
74 CALLBACK is a command to run when the item is chosen,
|
|
75 or a list to evaluate when the item is chosen.
|
6529
|
76
|
8541
|
77 ENABLE is an expression; the item is enabled for selection
|
|
78 whenever this expression's value is non-nil.
|
6600
|
79
|
9733
|
80 Alternatively, a menu item may have the form:
|
|
81
|
|
82 [ NAME CALLBACK [ KEYWORD ARG ] ... ]
|
|
83
|
20791
|
84 Where KEYWORD is one of the symbols defined below.
|
9733
|
85
|
|
86 :keys KEYS
|
|
87
|
|
88 KEYS is a string; a complex keyboard equivalent to this menu item.
|
|
89 This is normally not needed because keyboard equivalents are usually
|
|
90 computed automatically.
|
23991
|
91 KEYS is expanded with `substitute-command-keys' before it is used.
|
|
92
|
|
93 :key-sequence KEYS
|
|
94
|
|
95 KEYS is nil a string or a vector; nil or a keyboard equivalent to this
|
|
96 menu item.
|
|
97 This is a hint that will considerably speed up Emacs first display of
|
|
98 a menu. Use `:key-sequence nil' when you know that this menu item has no
|
|
99 keyboard equivalent.
|
9733
|
100
|
|
101 :active ENABLE
|
|
102
|
|
103 ENABLE is an expression; the item is enabled for selection
|
|
104 whenever this expression's value is non-nil.
|
|
105
|
23991
|
106 :included INCLUDE
|
|
107
|
|
108 INCLUDE is an expression; this item is only visible if this
|
|
109 expression has a non-nil value.
|
|
110
|
9733
|
111 :suffix NAME
|
|
112
|
|
113 NAME is a string; the name of an argument to CALLBACK.
|
|
114
|
14108
|
115 :style STYLE
|
9733
|
116
|
|
117 STYLE is a symbol describing the type of menu item. The following are
|
|
118 defined:
|
|
119
|
16812
|
120 toggle: A checkbox.
|
23991
|
121 Prepend the name with `(*) ' or `( ) ' depending on if selected or not.
|
16812
|
122 radio: A radio button.
|
23991
|
123 Prepend the name with `[X] ' or `[ ] ' depending on if selected or not.
|
|
124 button: Surround the name with `[' and `]'. Use this for an item in the
|
|
125 menu bar itself.
|
|
126 anything else means an ordinary menu item.
|
9733
|
127
|
|
128 :selected SELECTED
|
|
129
|
|
130 SELECTED is an expression; the checkbox or radio button is selected
|
|
131 whenever this expression's value is non-nil.
|
|
132
|
6542
|
133 A menu item can be a string. Then that string appears in the menu as
|
|
134 unselectable text. A string consisting solely of hyphens is displayed
|
|
135 as a solid horizontal line.
|
6529
|
136
|
23991
|
137 A menu item can be a list with the same format as MENU. This is a submenu."
|
20791
|
138 `(progn
|
|
139 (defvar ,symbol nil ,doc)
|
|
140 (easy-menu-do-define (quote ,symbol) ,maps ,doc ,menu)))
|
9733
|
141
|
11860
|
142 ;;;###autoload
|
9733
|
143 (defun easy-menu-do-define (symbol maps doc menu)
|
|
144 ;; We can't do anything that might differ between Emacs dialects in
|
|
145 ;; `easy-menu-define' in order to make byte compiled files
|
|
146 ;; compatible. Therefore everything interesting is done in this
|
|
147 ;; function.
|
20791
|
148 (set symbol (easy-menu-create-menu (car menu) (cdr menu)))
|
9733
|
149 (fset symbol (` (lambda (event) (, doc) (interactive "@e")
|
16160
|
150 (x-popup-menu event (, symbol)))))
|
9733
|
151 (mapcar (function (lambda (map)
|
|
152 (define-key map (vector 'menu-bar (intern (car menu)))
|
|
153 (cons (car menu) (symbol-value symbol)))))
|
|
154 (if (keymapp maps) (list maps) maps)))
|
6542
|
155
|
20791
|
156 (defun easy-menu-filter-return (menu)
|
|
157 "Convert MENU to the right thing to return from a menu filter.
|
|
158 MENU is a menu as computed by `easy-menu-define' or `easy-menu-create-menu' or
|
|
159 a symbol whose value is such a menu.
|
|
160 In Emacs a menu filter must return a menu (a keymap), in XEmacs a filter must
|
23991
|
161 return a menu items list (without menu name and keywords).
|
|
162 This function returns the right thing in the two cases."
|
20791
|
163 (easy-menu-get-map menu nil)) ; Get past indirections.
|
6529
|
164
|
9586
|
165 ;;;###autoload
|
20791
|
166 (defun easy-menu-create-menu (menu-name menu-items)
|
|
167 "Create a menu called MENU-NAME with items described in MENU-ITEMS.
|
|
168 MENU-NAME is a string, the name of the menu. MENU-ITEMS is a list of items
|
|
169 possibly preceded by keyword pairs as described in `easy-menu-define'."
|
|
170 (let ((menu (make-sparse-keymap menu-name))
|
21745
|
171 prop keyword arg label enable filter visible)
|
20791
|
172 ;; Look for keywords.
|
|
173 (while (and menu-items (cdr menu-items)
|
|
174 (symbolp (setq keyword (car menu-items)))
|
|
175 (= ?: (aref (symbol-name keyword) 0)))
|
21745
|
176 (setq arg (cadr menu-items))
|
|
177 (setq menu-items (cddr menu-items))
|
|
178 (cond
|
23991
|
179 ((eq keyword :filter) (setq filter arg))
|
|
180 ((eq keyword :active) (setq enable (or arg ''nil)))
|
|
181 ((eq keyword :label) (setq label arg))
|
|
182 ((or (eq keyword :included) (eq keyword :visible))
|
|
183 (setq visible (or arg ''nil)))))
|
21745
|
184 (if (equal visible ''nil) nil ; Invisible menu entry, return nil.
|
|
185 (if (and visible (not (easy-menu-always-true visible)))
|
|
186 (setq prop (cons :visible (cons visible prop))))
|
|
187 (if (and enable (not (easy-menu-always-true enable)))
|
|
188 (setq prop (cons :enable (cons enable prop))))
|
|
189 (if filter (setq prop (cons :filter (cons filter prop))))
|
|
190 (if label (setq prop (cons nil (cons label prop))))
|
|
191 (while menu-items
|
|
192 (easy-menu-do-add-item menu (car menu-items))
|
|
193 (setq menu-items (cdr menu-items)))
|
|
194 (when prop
|
|
195 (setq menu (easy-menu-make-symbol menu))
|
|
196 (put menu 'menu-prop prop))
|
|
197 menu)))
|
6529
|
198
|
20791
|
199
|
23991
|
200 ;; Known button types.
|
20791
|
201 (defvar easy-menu-button-prefix
|
21745
|
202 '((radio . :radio) (toggle . :toggle)))
|
20791
|
203
|
21745
|
204 (defun easy-menu-do-add-item (menu item &optional before)
|
20791
|
205 ;; Parse an item description and add the item to a keymap. This is
|
|
206 ;; the function that is used for item definition by the other easy-menu
|
|
207 ;; functions.
|
20801
|
208 ;; MENU is a sparse keymap i.e. a list starting with the symbol `keymap'.
|
20791
|
209 ;; ITEM defines an item as in `easy-menu-define'.
|
21745
|
210 ;; Optional argument BEFORE is nil or a key in MENU. If BEFORE is not nil
|
|
211 ;; put item before BEFORE in MENU, otherwise if item is already present in
|
|
212 ;; MENU, just change it, otherwise put it last in MENU.
|
|
213 (let (name command label prop remove)
|
20791
|
214 (cond
|
24987
|
215 ((stringp item) ; An item or separator.
|
|
216 (setq label item))
|
|
217 ((consp item) ; A sub-menu
|
21745
|
218 (setq label (setq name (car item)))
|
|
219 (setq command (cdr item))
|
|
220 (if (not (keymapp command))
|
|
221 (setq command (easy-menu-create-menu name command)))
|
|
222 (if (null command)
|
|
223 ;; Invisible menu item. Don't insert into keymap.
|
|
224 (setq remove t)
|
|
225 (when (and (symbolp command) (setq prop (get command 'menu-prop)))
|
|
226 (when (null (car prop))
|
|
227 (setq label (cadr prop))
|
|
228 (setq prop (cddr prop)))
|
|
229 (setq command (symbol-function command)))))
|
23991
|
230 ((vectorp item) ; An item.
|
22196
|
231 (let* ((ilen (length item))
|
|
232 (active (if (> ilen 2) (or (aref item 2) ''nil) t))
|
|
233 (no-name (not (symbolp (setq command (aref item 1)))))
|
|
234 cache cache-specified)
|
21745
|
235 (setq label (setq name (aref item 0)))
|
|
236 (if no-name (setq command (easy-menu-make-symbol command)))
|
20791
|
237 (if (and (symbolp active) (= ?: (aref (symbol-name active) 0)))
|
21745
|
238 (let ((count 2)
|
|
239 keyword arg suffix visible style selected keys)
|
|
240 (setq active nil)
|
22196
|
241 (while (> ilen count)
|
20791
|
242 (setq keyword (aref item count))
|
|
243 (setq arg (aref item (1+ count)))
|
|
244 (setq count (+ 2 count))
|
|
245 (cond
|
23991
|
246 ((or (eq keyword :included) (eq keyword :visible))
|
|
247 (setq visible (or arg ''nil)))
|
21745
|
248 ((eq keyword :key-sequence)
|
|
249 (setq cache arg cache-specified t))
|
|
250 ((eq keyword :keys) (setq keys arg no-name nil))
|
|
251 ((eq keyword :label) (setq label arg))
|
|
252 ((eq keyword :active) (setq active (or arg ''nil)))
|
|
253 ((eq keyword :suffix) (setq suffix arg))
|
|
254 ((eq keyword :style) (setq style arg))
|
|
255 ((eq keyword :selected) (setq selected (or arg ''nil)))))
|
23991
|
256 (if suffix
|
|
257 (setq label
|
|
258 (if (stringp suffix)
|
|
259 (if (stringp label) (concat label " " suffix)
|
|
260 (list 'concat label (concat " " suffix)))
|
|
261 (if (stringp label)
|
|
262 (list 'concat (concat label " ") suffix)
|
|
263 (list 'concat label " " suffix)))))
|
|
264 (cond
|
|
265 ((eq style 'button)
|
|
266 (setq label (if (stringp label) (concat "[" label "]")
|
|
267 (list 'concat "[" label "]"))))
|
|
268 ((and selected
|
|
269 (setq style (assq style easy-menu-button-prefix)))
|
|
270 (setq prop (cons :button
|
|
271 (cons (cons (cdr style) selected) prop)))))
|
21745
|
272 (when (stringp keys)
|
|
273 (if (string-match "^[^\\]*\\(\\\\\\[\\([^]]+\\)]\\)[^\\]*$"
|
|
274 keys)
|
|
275 (let ((prefix
|
|
276 (if (< (match-beginning 0) (match-beginning 1))
|
|
277 (substring keys 0 (match-beginning 1))))
|
|
278 (postfix
|
|
279 (if (< (match-end 1) (match-end 0))
|
|
280 (substring keys (match-end 1))))
|
|
281 (cmd (intern (substring keys (match-beginning 2)
|
|
282 (match-end 2)))))
|
22196
|
283 (setq keys (and (or prefix postfix)
|
|
284 (cons prefix postfix)))
|
21745
|
285 (setq keys
|
22196
|
286 (and (or keys (not (eq command cmd)))
|
|
287 (cons cmd keys))))
|
21745
|
288 (setq cache-specified nil))
|
|
289 (if keys (setq prop (cons :keys (cons keys prop)))))
|
|
290 (if (and visible (not (easy-menu-always-true visible)))
|
|
291 (if (equal visible ''nil)
|
|
292 ;; Invisible menu item. Don't insert into keymap.
|
|
293 (setq remove t)
|
|
294 (setq prop (cons :visible (cons visible prop)))))))
|
|
295 (if (and active (not (easy-menu-always-true active)))
|
|
296 (setq prop (cons :enable (cons active prop))))
|
|
297 (if (and (or no-name cache-specified)
|
|
298 (or (null cache) (stringp cache) (vectorp cache)))
|
|
299 (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
|
300 (t (error "Invalid menu item in easymenu")))
|
23991
|
301 (easy-menu-define-key-intern menu name
|
|
302 (and (not remove)
|
|
303 (cons 'menu-item
|
|
304 (cons label
|
|
305 (and name
|
|
306 (cons command prop)))))
|
|
307 before)))
|
|
308
|
|
309 (defun easy-menu-define-key-intern (menu key item &optional before)
|
|
310 ;; This is the same as easy-menu-define-key, but it interns KEY and
|
|
311 ;; BEFORE if they are strings.
|
|
312 (easy-menu-define-key menu (if (stringp key) (intern key) key) item
|
|
313 (if (stringp before) (intern before) before)))
|
21745
|
314
|
|
315 (defun easy-menu-define-key (menu key item &optional before)
|
|
316 ;; Add binding in MENU for KEY => ITEM. Similar to `define-key-after'.
|
|
317 ;; If KEY is not nil then delete any duplications. If ITEM is nil, then
|
|
318 ;; don't insert, only delete.
|
|
319 ;; Optional argument BEFORE is nil or a key in MENU. If BEFORE is not nil
|
|
320 ;; put binding before BEFORE in MENU, otherwise if binding is already
|
|
321 ;; present in MENU, just change it, otherwise put it last in MENU.
|
23991
|
322 ;; KEY and BEFORE don't have to be symbols, comparison is done with equal
|
|
323 ;; not with eq.
|
21745
|
324 (let ((inserted (null item)) ; Fake already inserted.
|
21807
|
325 tail done)
|
20801
|
326 (while (not done)
|
|
327 (cond
|
|
328 ((or (setq done (or (null (cdr menu)) (keymapp (cdr menu))))
|
21745
|
329 (and before (equal (car-safe (cadr menu)) before)))
|
|
330 ;; If key is nil, stop here, otherwise keep going past the
|
20801
|
331 ;; inserted element so we can delete any duplications that come
|
|
332 ;; later.
|
21745
|
333 (if (null key) (setq done t))
|
20801
|
334 (unless inserted ; Don't insert more than once.
|
21745
|
335 (setcdr menu (cons (cons key item) (cdr menu)))
|
20801
|
336 (setq inserted t)
|
21807
|
337 (setq menu (cdr menu)))
|
|
338 (setq menu (cdr menu)))
|
21745
|
339 ((and key (equal (car-safe (cadr menu)) key))
|
21807
|
340 (if (or inserted ; Already inserted or
|
|
341 (and before ; wanted elsewhere and
|
|
342 (setq tail (cddr menu)) ; not last item and not
|
|
343 (not (keymapp tail))
|
|
344 (not (equal (car-safe (car tail)) before)))) ; in position
|
21745
|
345 (setcdr menu (cddr menu)) ; Remove item.
|
|
346 (setcdr (cadr menu) item) ; Change item.
|
21807
|
347 (setq inserted t)
|
|
348 (setq menu (cdr menu))))
|
|
349 (t (setq menu (cdr menu)))))))
|
|
350
|
21745
|
351 (defun easy-menu-always-true (x)
|
|
352 ;; Return true if X never evaluates to nil.
|
|
353 (if (consp x) (and (eq (car x) 'quote) (cadr x))
|
|
354 (or (eq x t) (not (symbolp x)))))
|
20791
|
355
|
|
356 (defvar easy-menu-item-count 0)
|
|
357
|
21745
|
358 (defun easy-menu-make-symbol (callback)
|
20791
|
359 ;; Return a unique symbol with CALLBACK as function value.
|
|
360 (let ((command
|
|
361 (make-symbol (format "menu-function-%d" easy-menu-item-count))))
|
|
362 (setq easy-menu-item-count (1+ easy-menu-item-count))
|
|
363 (fset command
|
21745
|
364 (if (keymapp callback) callback
|
|
365 `(lambda () (interactive) ,callback)))
|
20791
|
366 command))
|
|
367
|
22033
|
368 ;;;###autoload
|
20791
|
369 (defun easy-menu-change (path name items &optional before)
|
8085
|
370 "Change menu found at PATH as item NAME to contain ITEMS.
|
25224
|
371 PATH is a list of strings for locating the menu that
|
|
372 should contain a submenu named NAME.
|
|
373 ITEMS is a list of menu items, as in `easy-menu-define'.
|
|
374 These items entirely replace the previous items in that submenu.
|
|
375
|
|
376 If the menu located by PATH has no submenu named NAME, add one.
|
|
377 If the optional argument BEFORE is present, add it just before
|
|
378 the submenu named BEFORE, otherwise add it at the end of the menu.
|
8085
|
379
|
20791
|
380 Either call this from `menu-bar-update-hook' or use a menu filter,
|
|
381 to implement dynamic menus."
|
|
382 (easy-menu-add-item nil path (cons name items) before))
|
8085
|
383
|
20791
|
384 ;; XEmacs needs the following two functions to add and remove menus.
|
|
385 ;; In Emacs this is done automatically when switching keymaps, so
|
22196
|
386 ;; here easy-menu-remove is a noop and easy-menu-add only precalculates
|
|
387 ;; equivalent keybindings (if easy-menu-precalculate-equivalent-keybindings
|
|
388 ;; is on).
|
9733
|
389 (defun easy-menu-remove (menu))
|
6600
|
390
|
22196
|
391 (defun easy-menu-add (menu &optional map)
|
|
392 "Maybe precalculate equivalent key bindings.
|
|
393 Do it if `easy-menu-precalculate-equivalent-keybindings' is on,"
|
|
394 (when easy-menu-precalculate-equivalent-keybindings
|
|
395 (if (and (symbolp menu) (not (keymapp menu)) (boundp menu))
|
|
396 (setq menu (symbol-value menu)))
|
|
397 (if (keymapp menu) (x-popup-menu nil menu))))
|
6600
|
398
|
23939
|
399 (defun easy-menu-add-item (map path item &optional before)
|
23991
|
400 "To the submenu of MAP with path PATH, add ITEM.
|
25224
|
401
|
|
402 If an item with the same name is already present in this submenu,
|
|
403 then ITEM replaces it. Otherwise, ITEM is added to this submenu.
|
|
404 In the latter case, ITEM is normally added at the end of the submenu.
|
|
405 However, if BEFORE is a string and there is an item in the submenu
|
|
406 with that name, then ITEM is added before that item.
|
23939
|
407
|
|
408 MAP should normally be a keymap; nil stands for the global menu-bar keymap.
|
|
409 It can also be a symbol, which has earlier been used as the first
|
|
410 argument in a call to `easy-menu-define', or the value of such a symbol.
|
|
411
|
20791
|
412 PATH is a list of strings for locating the submenu where ITEM is to be
|
23939
|
413 added. If PATH is nil, MAP itself is used. Otherwise, the first
|
|
414 element should be the name of a submenu directly under MAP. This
|
20791
|
415 submenu is then traversed recursively with the remaining elements of PATH.
|
23991
|
416
|
|
417 ITEM is either defined as in `easy-menu-define' or a non-nil value returned
|
|
418 by `easy-menu-item-present-p' or `easy-menu-remove-item' or a menu defined
|
|
419 earlier by `easy-menu-define' or `easy-menu-create-menu'."
|
25224
|
420 (setq map (easy-menu-get-map map path
|
|
421 (and (null map) (null path)
|
|
422 (stringp (car-safe item))
|
|
423 (car item))))
|
23991
|
424 (if (and (consp item) (consp (cdr item)) (eq (cadr item) 'menu-item))
|
|
425 ;; This is a value returned by `easy-menu-item-present-p' or
|
|
426 ;; `easy-menu-remove-item'.
|
|
427 (easy-menu-define-key-intern map (car item) (cdr item) before)
|
|
428 (if (or (keymapp item)
|
|
429 (and (symbolp item) (keymapp (symbol-value item))))
|
|
430 ;; Item is a keymap, find the prompt string and use as item name.
|
|
431 (let ((tail (easy-menu-get-map item nil)) name)
|
|
432 (if (not (keymapp item)) (setq item tail))
|
|
433 (while (and (null name) (consp (setq tail (cdr tail)))
|
|
434 (not (keymapp tail)))
|
|
435 (if (stringp (car tail)) (setq name (car tail)) ; Got a name.
|
|
436 (setq tail (cdr tail))))
|
|
437 (setq item (cons name item))))
|
|
438 (easy-menu-do-add-item map item before)))
|
20791
|
439
|
23939
|
440 (defun easy-menu-item-present-p (map path name)
|
|
441 "In submenu of MAP with path PATH, return true iff item NAME is present.
|
|
442 MAP and PATH are defined as in `easy-menu-add-item'.
|
20791
|
443 NAME should be a string, the name of the element to be looked for."
|
23991
|
444 (easy-menu-return-item (easy-menu-get-map map path) name))
|
20791
|
445
|
23939
|
446 (defun easy-menu-remove-item (map path name)
|
|
447 "From submenu of MAP with path PATH remove item NAME.
|
|
448 MAP and PATH are defined as in `easy-menu-add-item'.
|
20791
|
449 NAME should be a string, the name of the element to be removed."
|
23991
|
450 (setq map (easy-menu-get-map map path))
|
|
451 (let ((ret (easy-menu-return-item map name)))
|
|
452 (if ret (easy-menu-define-key-intern map name nil))
|
|
453 ret))
|
|
454
|
|
455 (defun easy-menu-return-item (menu name)
|
|
456 ;; In menu MENU try to look for menu item with name NAME.
|
|
457 ;; If a menu item is found, return (NAME . item), otherwise return nil.
|
|
458 ;; If item is an old format item, a new format item is returned.
|
|
459 (let ((item (lookup-key menu (vector (intern name))))
|
|
460 ret enable cache label)
|
|
461 (cond
|
|
462 ((or (keymapp item) (eq (car-safe item) 'menu-item))
|
|
463 (cons name item)) ; Keymap or new menu format
|
|
464 ((stringp (car-safe item))
|
|
465 ;; This is the old menu format. Convert it to new format.
|
|
466 (setq label (car item))
|
|
467 (when (stringp (car (setq item (cdr item)))) ; Got help string
|
|
468 (setq ret (list :help (car item)))
|
|
469 (setq item (cdr item)))
|
|
470 (when (and (consp item) (consp (car item))
|
|
471 (or (null (caar item)) (numberp (caar item))))
|
|
472 (setq cache (car item)) ; Got cache
|
|
473 (setq item (cdr item)))
|
|
474 (and (symbolp item) (setq enable (get item 'menu-enable)) ; Got enable
|
|
475 (setq ret (cons :enable (cons enable ret))))
|
|
476 (if cache (setq ret (cons cache ret)))
|
|
477 (cons name (cons 'menu-enable (cons label (cons item ret))))))))
|
20791
|
478
|
25224
|
479 (defun easy-menu-get-map-look-for-name (name submap)
|
|
480 (while (and submap (not (or (equal (car-safe (cdr-safe (car submap))) name)
|
|
481 (equal (car-safe (cdr-safe (cdr-safe (car submap)))) name))))
|
|
482 (setq submap (cdr submap)))
|
|
483 submap)
|
|
484
|
|
485 (defun easy-menu-get-map (map path &optional to-modify)
|
20791
|
486 ;; Return a sparse keymap in which to add or remove an item.
|
23939
|
487 ;; MAP and PATH are as defined in `easy-menu-add-item'.
|
25224
|
488
|
|
489 ;; TO-MODIFY, if non-nil, is the name of the item the caller
|
|
490 ;; wants to modify in the map that we return.
|
|
491 ;; In some cases we use that to select between the local and global maps.
|
23939
|
492 (if (null map)
|
24341
9028f3cd0a5e
(easy-menu-get-map): Don't crash if (current-local-map) is nil.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
493 (let ((local (and (current-local-map)
|
9028f3cd0a5e
(easy-menu-get-map): Don't crash if (current-local-map) is nil.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
494 (lookup-key (current-local-map)
|
9028f3cd0a5e
(easy-menu-get-map): Don't crash if (current-local-map) is nil.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
495 (vconcat '(menu-bar) (mapcar 'intern path)))))
|
24075
|
496 (global (lookup-key global-map
|
|
497 (vconcat '(menu-bar) (mapcar 'intern path)))))
|
25224
|
498 (cond ((and to-modify local (not (integerp local))
|
|
499 (easy-menu-get-map-look-for-name to-modify local))
|
|
500 (setq map local))
|
|
501 ((and to-modify global (not (integerp global))
|
|
502 (easy-menu-get-map-look-for-name to-modify global))
|
|
503 (setq map global))
|
|
504 ((and local local (not (integerp local)))
|
|
505 (setq map local))
|
|
506 ((and global (not (integerp global)))
|
|
507 (setq map global))
|
|
508 (t
|
|
509 (setq map (make-sparse-keymap))
|
|
510 (define-key (current-local-map)
|
|
511 (vconcat '(menu-bar) (mapcar 'intern path)) map))))
|
23939
|
512 (if (and (symbolp map) (not (keymapp map)))
|
|
513 (setq map (symbol-value map)))
|
|
514 (if path (setq map (lookup-key map (vconcat (mapcar 'intern path))))))
|
|
515 (while (and (symbolp map) (keymapp map))
|
|
516 (setq map (symbol-function map)))
|
23955
9f9e1b450ff5
(easy-menu-get-map): Change global map only if this menu exists in the
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
517 (unless map
|
9f9e1b450ff5
(easy-menu-get-map): Change global map only if this menu exists in the
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
518 (error "Menu specified in easy-menu is not defined"))
|
23939
|
519 (or (keymapp map) (error "Malformed menu in easy-menu: (%s)" map))
|
|
520 map)
|
20791
|
521
|
6529
|
522 (provide 'easymenu)
|
|
523
|
|
524 ;;; easymenu.el ends here
|