Commit | Line | Data |
---|---|---|
029b623a RS |
1 | ;;; easymenu.el --- support the easymenu interface for defining a menu. |
2 | ||
5e5b3d41 | 3 | ;; Copyright (C) 1994, 1996, 1998, 1999, 2000 Free Software Foundation, Inc. |
029b623a | 4 | |
8df69fb0 RS |
5 | ;; Keywords: emulations |
6 | ;; Author: rms | |
7 | ||
029b623a RS |
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 | |
b578f267 EN |
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. | |
029b623a | 24 | |
b578f267 EN |
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. | |
029b623a RS |
30 | |
31 | ;;; Code: | |
32 | ||
545128a8 RS |
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 | ||
5edf6b55 SM |
44 | ;;;###autoload |
45 | (put 'easy-menu-define 'lisp-indent-function 'defun) | |
a8226f67 | 46 | ;;;###autoload |
8df69fb0 | 47 | (defmacro easy-menu-define (symbol maps doc menu) |
029b623a | 48 | "Define a menu bar submenu in maps MAPS, according to MENU. |
819fefed RS |
49 | The menu keymap is stored in symbol SYMBOL, both as its value |
50 | and as its function definition. DOC is used as the doc string for SYMBOL. | |
029b623a RS |
51 | |
52 | The first element of MENU must be a string. It is the menu bar item name. | |
3de63fb6 RS |
53 | It may be followed by the following keyword argument pairs |
54 | ||
024bda02 | 55 | :filter FUNCTION |
3de63fb6 | 56 | |
024bda02 RS |
57 | FUNCTION is a function with one argument, the menu. It returns the actual |
58 | menu displayed. | |
59 | ||
3de63fb6 RS |
60 | :visible INCLUDE |
61 | ||
62 | INCLUDE is an expression; this menu is only visible if this | |
63 | expression has a non-nil value. `:include' is an alias for `:visible'. | |
64 | ||
65 | :active ENABLE | |
66 | ||
67 | ENABLE is an expression; the menu is enabled for selection | |
68 | whenever this expression's value is non-nil. | |
69 | ||
70 | The rest of the elements in MENU, are menu items. | |
029b623a | 71 | |
8df69fb0 | 72 | A menu item is usually a vector of three elements: [NAME CALLBACK ENABLE] |
029b623a | 73 | |
a8226f67 | 74 | NAME is a string--the menu item name. |
029b623a | 75 | |
a8226f67 RS |
76 | CALLBACK is a command to run when the item is chosen, |
77 | or a list to evaluate when the item is chosen. | |
029b623a | 78 | |
5a51e0a6 RS |
79 | ENABLE is an expression; the item is enabled for selection |
80 | whenever this expression's value is non-nil. | |
8df69fb0 | 81 | |
6c2599ed | 82 | Alternatively, a menu item may have the form: |
1ba15fe6 RS |
83 | |
84 | [ NAME CALLBACK [ KEYWORD ARG ] ... ] | |
85 | ||
024bda02 | 86 | Where KEYWORD is one of the symbols defined below. |
1ba15fe6 RS |
87 | |
88 | :keys KEYS | |
89 | ||
90 | KEYS is a string; a complex keyboard equivalent to this menu item. | |
91 | This is normally not needed because keyboard equivalents are usually | |
92 | computed automatically. | |
3de63fb6 RS |
93 | KEYS is expanded with `substitute-command-keys' before it is used. |
94 | ||
95 | :key-sequence KEYS | |
96 | ||
d0acce1e | 97 | KEYS is nil, a string or a vector; nil or a keyboard equivalent to this |
3de63fb6 | 98 | menu item. |
d0acce1e | 99 | This is a hint that will considerably speed up Emacs' first display of |
3de63fb6 RS |
100 | a menu. Use `:key-sequence nil' when you know that this menu item has no |
101 | keyboard equivalent. | |
1ba15fe6 RS |
102 | |
103 | :active ENABLE | |
104 | ||
105 | ENABLE is an expression; the item is enabled for selection | |
106 | whenever this expression's value is non-nil. | |
107 | ||
3de63fb6 RS |
108 | :included INCLUDE |
109 | ||
110 | INCLUDE is an expression; this item is only visible if this | |
111 | expression has a non-nil value. | |
112 | ||
d0acce1e | 113 | :suffix FORM |
1ba15fe6 | 114 | |
d0acce1e SM |
115 | FORM is an expression that will be dynamically evaluated and whose |
116 | value will be concatenated to the menu entry's NAME. | |
1ba15fe6 | 117 | |
41e6ca7a | 118 | :style STYLE |
6c2599ed | 119 | |
1ba15fe6 | 120 | STYLE is a symbol describing the type of menu item. The following are |
6c2599ed | 121 | defined: |
1ba15fe6 | 122 | |
e6a6d697 | 123 | toggle: A checkbox. |
3de63fb6 | 124 | Prepend the name with `(*) ' or `( ) ' depending on if selected or not. |
e6a6d697 | 125 | radio: A radio button. |
3de63fb6 | 126 | Prepend the name with `[X] ' or `[ ] ' depending on if selected or not. |
4d6d04b5 | 127 | button: Surround the name with `[' and `]'. Use this for an item in the |
3de63fb6 RS |
128 | menu bar itself. |
129 | anything else means an ordinary menu item. | |
1ba15fe6 RS |
130 | |
131 | :selected SELECTED | |
132 | ||
133 | SELECTED is an expression; the checkbox or radio button is selected | |
134 | whenever this expression's value is non-nil. | |
1ba15fe6 | 135 | |
25112054 GM |
136 | :help HELP |
137 | ||
138 | HELP is a string, the help to display for the menu item. | |
139 | ||
a8226f67 RS |
140 | A menu item can be a string. Then that string appears in the menu as |
141 | unselectable text. A string consisting solely of hyphens is displayed | |
142 | as a solid horizontal line. | |
029b623a | 143 | |
3de63fb6 | 144 | A menu item can be a list with the same format as MENU. This is a submenu." |
024bda02 RS |
145 | `(progn |
146 | (defvar ,symbol nil ,doc) | |
147 | (easy-menu-do-define (quote ,symbol) ,maps ,doc ,menu))) | |
1ba15fe6 | 148 | |
f39223a6 | 149 | ;;;###autoload |
1ba15fe6 RS |
150 | (defun easy-menu-do-define (symbol maps doc menu) |
151 | ;; We can't do anything that might differ between Emacs dialects in | |
152 | ;; `easy-menu-define' in order to make byte compiled files | |
153 | ;; compatible. Therefore everything interesting is done in this | |
6c2599ed | 154 | ;; function. |
d0acce1e SM |
155 | (let ((keymap (easy-menu-create-menu (car menu) (cdr menu)))) |
156 | (set symbol keymap) | |
157 | (fset symbol | |
158 | `(lambda (event) ,doc (interactive "@e") | |
159 | ;; FIXME: XEmacs uses popup-menu which calls the binding | |
160 | ;; while x-popup-menu only returns the selection. | |
161 | (x-popup-menu event | |
162 | (or (and (symbolp ,symbol) | |
163 | (funcall | |
164 | (or (plist-get (get ,symbol 'menu-prop) | |
165 | :filter) | |
166 | 'identity) | |
167 | (symbol-function ,symbol))) | |
168 | ,symbol)))) | |
169 | (mapcar (lambda (map) | |
170 | (define-key map (vector 'menu-bar (intern (car menu))) | |
171 | (cons 'menu-item | |
172 | (cons (car menu) | |
173 | (if (not (symbolp keymap)) | |
174 | (list keymap) | |
175 | (cons (symbol-function keymap) | |
176 | (get keymap 'menu-prop))))))) | |
177 | (if (keymapp maps) (list maps) maps)))) | |
178 | ||
179 | (defun easy-menu-filter-return (menu &optional name) | |
024bda02 RS |
180 | "Convert MENU to the right thing to return from a menu filter. |
181 | MENU is a menu as computed by `easy-menu-define' or `easy-menu-create-menu' or | |
182 | a symbol whose value is such a menu. | |
183 | In Emacs a menu filter must return a menu (a keymap), in XEmacs a filter must | |
3de63fb6 | 184 | return a menu items list (without menu name and keywords). |
d0acce1e SM |
185 | This function returns the right thing in the two cases. |
186 | If NAME is provided, it is used for the keymap." | |
187 | (when (and (not (keymapp menu)) (consp menu)) | |
188 | ;; If it's a cons but not a keymap, then it can't be right | |
189 | ;; unless it's an XEmacs menu. | |
190 | (setq menu (easy-menu-create-menu (or name "") menu))) | |
024bda02 | 191 | (easy-menu-get-map menu nil)) ; Get past indirections. |
029b623a | 192 | |
815d2127 | 193 | ;;;###autoload |
024bda02 RS |
194 | (defun easy-menu-create-menu (menu-name menu-items) |
195 | "Create a menu called MENU-NAME with items described in MENU-ITEMS. | |
196 | MENU-NAME is a string, the name of the menu. MENU-ITEMS is a list of items | |
197 | possibly preceded by keyword pairs as described in `easy-menu-define'." | |
198 | (let ((menu (make-sparse-keymap menu-name)) | |
25112054 | 199 | prop keyword arg label enable filter visible help) |
024bda02 | 200 | ;; Look for keywords. |
b9f5db90 DL |
201 | (while (and menu-items |
202 | (cdr menu-items) | |
203 | (keywordp (setq keyword (car menu-items)))) | |
c78fb6a6 RS |
204 | (setq arg (cadr menu-items)) |
205 | (setq menu-items (cddr menu-items)) | |
206 | (cond | |
d0acce1e SM |
207 | ((eq keyword :filter) |
208 | (setq filter `(lambda (menu) | |
209 | (easy-menu-filter-return (,arg menu) ,menu-name)))) | |
3de63fb6 RS |
210 | ((eq keyword :active) (setq enable (or arg ''nil))) |
211 | ((eq keyword :label) (setq label arg)) | |
25112054 | 212 | ((eq keyword :help) (setq help arg)) |
3de63fb6 RS |
213 | ((or (eq keyword :included) (eq keyword :visible)) |
214 | (setq visible (or arg ''nil))))) | |
4d6d04b5 DL |
215 | (if (equal visible ''nil) |
216 | nil ; Invisible menu entry, return nil. | |
c78fb6a6 RS |
217 | (if (and visible (not (easy-menu-always-true visible))) |
218 | (setq prop (cons :visible (cons visible prop)))) | |
219 | (if (and enable (not (easy-menu-always-true enable))) | |
220 | (setq prop (cons :enable (cons enable prop)))) | |
221 | (if filter (setq prop (cons :filter (cons filter prop)))) | |
25112054 | 222 | (if help (setq prop (cons :help (cons help prop)))) |
c78fb6a6 | 223 | (if label (setq prop (cons nil (cons label prop)))) |
d0acce1e SM |
224 | (if filter |
225 | ;; The filter expects the menu in its XEmacs form and the pre-filter | |
226 | ;; form will only be passed to the filter anyway, so we'd better | |
227 | ;; not convert it at all (it will be converted on the fly by | |
228 | ;; easy-menu-filter-return). | |
229 | (setq menu menu-items) | |
230 | (setq menu (append menu (mapcar 'easy-menu-convert-item menu-items)))) | |
c78fb6a6 | 231 | (when prop |
d0acce1e | 232 | (setq menu (easy-menu-make-symbol menu 'noexp)) |
c78fb6a6 RS |
233 | (put menu 'menu-prop prop)) |
234 | menu))) | |
029b623a | 235 | |
024bda02 | 236 | |
3de63fb6 | 237 | ;; Known button types. |
024bda02 | 238 | (defvar easy-menu-button-prefix |
c78fb6a6 | 239 | '((radio . :radio) (toggle . :toggle))) |
024bda02 | 240 | |
c78fb6a6 | 241 | (defun easy-menu-do-add-item (menu item &optional before) |
d0acce1e SM |
242 | (setq item (easy-menu-convert-item item)) |
243 | (easy-menu-define-key-intern menu (car item) (cdr item) before)) | |
244 | ||
245 | (defvar easy-menu-converted-items-table (make-hash-table :test 'equal)) | |
246 | ||
247 | (defun easy-menu-convert-item (item) | |
4d6d04b5 DL |
248 | "Memoize the value returned by `easy-menu-convert-item-1' called on ITEM. |
249 | This makes key-shortcut-caching work a *lot* better when this | |
250 | conversion is done from within a filter. | |
251 | This also helps when the NAME of the entry is recreated each time: | |
252 | since the menu is built and traversed separately, the lookup | |
253 | would always fail because the key is `equal' but not `eq'." | |
d0acce1e SM |
254 | (or (gethash item easy-menu-converted-items-table) |
255 | (puthash item (easy-menu-convert-item-1 item) | |
256 | easy-menu-converted-items-table))) | |
257 | ||
258 | (defun easy-menu-convert-item-1 (item) | |
4d6d04b5 DL |
259 | "Parse an item description and add the item to a keymap. |
260 | This is the function that is used for item definition by the other easy-menu | |
261 | functions. | |
262 | MENU is a sparse keymap i.e. a list starting with the symbol `keymap'. | |
263 | ITEM defines an item as in `easy-menu-define'. | |
264 | Optional argument BEFORE is nil or a key in MENU. If BEFORE is not nil | |
265 | put item before BEFORE in MENU, otherwise if item is already present in | |
266 | MENU, just change it, otherwise put it last in MENU." | |
25112054 | 267 | (let (name command label prop remove help) |
024bda02 | 268 | (cond |
2c5c9cb9 GM |
269 | ((stringp item) ; An item or separator. |
270 | (setq label item)) | |
271 | ((consp item) ; A sub-menu | |
c78fb6a6 RS |
272 | (setq label (setq name (car item))) |
273 | (setq command (cdr item)) | |
274 | (if (not (keymapp command)) | |
275 | (setq command (easy-menu-create-menu name command))) | |
276 | (if (null command) | |
277 | ;; Invisible menu item. Don't insert into keymap. | |
278 | (setq remove t) | |
279 | (when (and (symbolp command) (setq prop (get command 'menu-prop))) | |
280 | (when (null (car prop)) | |
281 | (setq label (cadr prop)) | |
282 | (setq prop (cddr prop))) | |
283 | (setq command (symbol-function command))))) | |
3de63fb6 | 284 | ((vectorp item) ; An item. |
545128a8 RS |
285 | (let* ((ilen (length item)) |
286 | (active (if (> ilen 2) (or (aref item 2) ''nil) t)) | |
287 | (no-name (not (symbolp (setq command (aref item 1))))) | |
288 | cache cache-specified) | |
c78fb6a6 RS |
289 | (setq label (setq name (aref item 0))) |
290 | (if no-name (setq command (easy-menu-make-symbol command))) | |
b9f5db90 | 291 | (if (keywordp active) |
c78fb6a6 RS |
292 | (let ((count 2) |
293 | keyword arg suffix visible style selected keys) | |
294 | (setq active nil) | |
545128a8 | 295 | (while (> ilen count) |
024bda02 RS |
296 | (setq keyword (aref item count)) |
297 | (setq arg (aref item (1+ count))) | |
298 | (setq count (+ 2 count)) | |
299 | (cond | |
3de63fb6 RS |
300 | ((or (eq keyword :included) (eq keyword :visible)) |
301 | (setq visible (or arg ''nil))) | |
c78fb6a6 RS |
302 | ((eq keyword :key-sequence) |
303 | (setq cache arg cache-specified t)) | |
304 | ((eq keyword :keys) (setq keys arg no-name nil)) | |
305 | ((eq keyword :label) (setq label arg)) | |
306 | ((eq keyword :active) (setq active (or arg ''nil))) | |
25112054 | 307 | ((eq keyword :help) (setq prop (cons :help (cons arg prop)))) |
c78fb6a6 RS |
308 | ((eq keyword :suffix) (setq suffix arg)) |
309 | ((eq keyword :style) (setq style arg)) | |
310 | ((eq keyword :selected) (setq selected (or arg ''nil))))) | |
3de63fb6 RS |
311 | (if suffix |
312 | (setq label | |
313 | (if (stringp suffix) | |
314 | (if (stringp label) (concat label " " suffix) | |
315 | (list 'concat label (concat " " suffix))) | |
316 | (if (stringp label) | |
317 | (list 'concat (concat label " ") suffix) | |
318 | (list 'concat label " " suffix))))) | |
319 | (cond | |
320 | ((eq style 'button) | |
321 | (setq label (if (stringp label) (concat "[" label "]") | |
322 | (list 'concat "[" label "]")))) | |
323 | ((and selected | |
324 | (setq style (assq style easy-menu-button-prefix))) | |
325 | (setq prop (cons :button | |
326 | (cons (cons (cdr style) selected) prop))))) | |
c78fb6a6 RS |
327 | (when (stringp keys) |
328 | (if (string-match "^[^\\]*\\(\\\\\\[\\([^]]+\\)]\\)[^\\]*$" | |
329 | keys) | |
330 | (let ((prefix | |
331 | (if (< (match-beginning 0) (match-beginning 1)) | |
332 | (substring keys 0 (match-beginning 1)))) | |
333 | (postfix | |
334 | (if (< (match-end 1) (match-end 0)) | |
335 | (substring keys (match-end 1)))) | |
336 | (cmd (intern (substring keys (match-beginning 2) | |
337 | (match-end 2))))) | |
545128a8 RS |
338 | (setq keys (and (or prefix postfix) |
339 | (cons prefix postfix))) | |
c78fb6a6 | 340 | (setq keys |
545128a8 RS |
341 | (and (or keys (not (eq command cmd))) |
342 | (cons cmd keys)))) | |
c78fb6a6 RS |
343 | (setq cache-specified nil)) |
344 | (if keys (setq prop (cons :keys (cons keys prop))))) | |
345 | (if (and visible (not (easy-menu-always-true visible))) | |
346 | (if (equal visible ''nil) | |
347 | ;; Invisible menu item. Don't insert into keymap. | |
348 | (setq remove t) | |
349 | (setq prop (cons :visible (cons visible prop))))))) | |
350 | (if (and active (not (easy-menu-always-true active))) | |
351 | (setq prop (cons :enable (cons active prop)))) | |
352 | (if (and (or no-name cache-specified) | |
353 | (or (null cache) (stringp cache) (vectorp cache))) | |
354 | (setq prop (cons :key-sequence (cons cache prop)))))) | |
a2c896c3 | 355 | (t (error "Invalid menu item in easymenu"))) |
3a4f3f86 SM |
356 | ;; `intern' the name so as to merge multiple entries with the same name. |
357 | ;; It also makes it easier/possible to lookup/change menu bindings | |
358 | ;; via keymap functions. | |
115f38ae | 359 | (cons (if (stringp name) (intern name) name) |
3a4f3f86 SM |
360 | (and (not remove) |
361 | (cons 'menu-item | |
362 | (cons label | |
363 | (and name | |
364 | (cons command prop)))))))) | |
3de63fb6 RS |
365 | |
366 | (defun easy-menu-define-key-intern (menu key item &optional before) | |
4d6d04b5 | 367 | "Like easy-menu-define-key, but interns KEY and BEFORE if they are strings." |
3de63fb6 RS |
368 | (easy-menu-define-key menu (if (stringp key) (intern key) key) item |
369 | (if (stringp before) (intern before) before))) | |
c78fb6a6 RS |
370 | |
371 | (defun easy-menu-define-key (menu key item &optional before) | |
4d6d04b5 DL |
372 | "Add binding in MENU for KEY => ITEM. Similar to `define-key-after'. |
373 | If KEY is not nil then delete any duplications. If ITEM is nil, then | |
374 | don't insert, only delete. | |
375 | Optional argument BEFORE is nil or a key in MENU. If BEFORE is not nil | |
376 | put binding before BEFORE in MENU, otherwise if binding is already | |
377 | present in MENU, just change it, otherwise put it last in MENU. | |
378 | KEY and BEFORE don't have to be symbols, comparison is done with equal | |
379 | not with eq." | |
c78fb6a6 | 380 | (let ((inserted (null item)) ; Fake already inserted. |
d8868253 | 381 | tail done) |
d5660985 RS |
382 | (while (not done) |
383 | (cond | |
384 | ((or (setq done (or (null (cdr menu)) (keymapp (cdr menu)))) | |
c78fb6a6 RS |
385 | (and before (equal (car-safe (cadr menu)) before))) |
386 | ;; If key is nil, stop here, otherwise keep going past the | |
d5660985 RS |
387 | ;; inserted element so we can delete any duplications that come |
388 | ;; later. | |
c78fb6a6 | 389 | (if (null key) (setq done t)) |
d5660985 | 390 | (unless inserted ; Don't insert more than once. |
c78fb6a6 | 391 | (setcdr menu (cons (cons key item) (cdr menu))) |
d5660985 | 392 | (setq inserted t) |
d8868253 RS |
393 | (setq menu (cdr menu))) |
394 | (setq menu (cdr menu))) | |
c78fb6a6 | 395 | ((and key (equal (car-safe (cadr menu)) key)) |
d8868253 RS |
396 | (if (or inserted ; Already inserted or |
397 | (and before ; wanted elsewhere and | |
398 | (setq tail (cddr menu)) ; not last item and not | |
399 | (not (keymapp tail)) | |
400 | (not (equal (car-safe (car tail)) before)))) ; in position | |
c78fb6a6 RS |
401 | (setcdr menu (cddr menu)) ; Remove item. |
402 | (setcdr (cadr menu) item) ; Change item. | |
d8868253 RS |
403 | (setq inserted t) |
404 | (setq menu (cdr menu)))) | |
405 | (t (setq menu (cdr menu))))))) | |
6c2599ed | 406 | |
c78fb6a6 | 407 | (defun easy-menu-always-true (x) |
4d6d04b5 | 408 | "Return true if X never evaluates to nil." |
c78fb6a6 RS |
409 | (if (consp x) (and (eq (car x) 'quote) (cadr x)) |
410 | (or (eq x t) (not (symbolp x))))) | |
024bda02 RS |
411 | |
412 | (defvar easy-menu-item-count 0) | |
413 | ||
d0acce1e SM |
414 | (defun easy-menu-make-symbol (callback &optional noexp) |
415 | "Return a unique symbol with CALLBACK as function value. | |
416 | When non-nil, NOEXP indicates that CALLBACK cannot be an expression | |
417 | \(i.e. does not need to be turned into a function)." | |
024bda02 RS |
418 | (let ((command |
419 | (make-symbol (format "menu-function-%d" easy-menu-item-count)))) | |
420 | (setq easy-menu-item-count (1+ easy-menu-item-count)) | |
421 | (fset command | |
d0acce1e | 422 | (if (or (keymapp callback) noexp) callback |
c78fb6a6 | 423 | `(lambda () (interactive) ,callback))) |
024bda02 RS |
424 | command)) |
425 | ||
168b2d0d | 426 | ;;;###autoload |
024bda02 | 427 | (defun easy-menu-change (path name items &optional before) |
88153c47 | 428 | "Change menu found at PATH as item NAME to contain ITEMS. |
fd43ede0 KH |
429 | PATH is a list of strings for locating the menu that |
430 | should contain a submenu named NAME. | |
431 | ITEMS is a list of menu items, as in `easy-menu-define'. | |
432 | These items entirely replace the previous items in that submenu. | |
433 | ||
434 | If the menu located by PATH has no submenu named NAME, add one. | |
435 | If the optional argument BEFORE is present, add it just before | |
436 | the submenu named BEFORE, otherwise add it at the end of the menu. | |
88153c47 | 437 | |
024bda02 RS |
438 | Either call this from `menu-bar-update-hook' or use a menu filter, |
439 | to implement dynamic menus." | |
440 | (easy-menu-add-item nil path (cons name items) before)) | |
88153c47 | 441 | |
024bda02 RS |
442 | ;; XEmacs needs the following two functions to add and remove menus. |
443 | ;; In Emacs this is done automatically when switching keymaps, so | |
545128a8 RS |
444 | ;; here easy-menu-remove is a noop and easy-menu-add only precalculates |
445 | ;; equivalent keybindings (if easy-menu-precalculate-equivalent-keybindings | |
446 | ;; is on). | |
4d6d04b5 | 447 | (defalias 'easy-menu-remove 'ignore) |
8df69fb0 | 448 | |
545128a8 RS |
449 | (defun easy-menu-add (menu &optional map) |
450 | "Maybe precalculate equivalent key bindings. | |
451 | Do it if `easy-menu-precalculate-equivalent-keybindings' is on," | |
452 | (when easy-menu-precalculate-equivalent-keybindings | |
453 | (if (and (symbolp menu) (not (keymapp menu)) (boundp menu)) | |
454 | (setq menu (symbol-value menu))) | |
455 | (if (keymapp menu) (x-popup-menu nil menu)))) | |
8df69fb0 | 456 | |
5e6656e0 | 457 | (defun easy-menu-add-item (map path item &optional before) |
3de63fb6 | 458 | "To the submenu of MAP with path PATH, add ITEM. |
fd43ede0 KH |
459 | |
460 | If an item with the same name is already present in this submenu, | |
461 | then ITEM replaces it. Otherwise, ITEM is added to this submenu. | |
462 | In the latter case, ITEM is normally added at the end of the submenu. | |
463 | However, if BEFORE is a string and there is an item in the submenu | |
464 | with that name, then ITEM is added before that item. | |
5e6656e0 RS |
465 | |
466 | MAP should normally be a keymap; nil stands for the global menu-bar keymap. | |
467 | It can also be a symbol, which has earlier been used as the first | |
468 | argument in a call to `easy-menu-define', or the value of such a symbol. | |
469 | ||
024bda02 | 470 | PATH is a list of strings for locating the submenu where ITEM is to be |
5e6656e0 RS |
471 | added. If PATH is nil, MAP itself is used. Otherwise, the first |
472 | element should be the name of a submenu directly under MAP. This | |
024bda02 | 473 | submenu is then traversed recursively with the remaining elements of PATH. |
3de63fb6 RS |
474 | |
475 | ITEM is either defined as in `easy-menu-define' or a non-nil value returned | |
476 | by `easy-menu-item-present-p' or `easy-menu-remove-item' or a menu defined | |
477 | earlier by `easy-menu-define' or `easy-menu-create-menu'." | |
fd43ede0 KH |
478 | (setq map (easy-menu-get-map map path |
479 | (and (null map) (null path) | |
480 | (stringp (car-safe item)) | |
481 | (car item)))) | |
3de63fb6 RS |
482 | (if (and (consp item) (consp (cdr item)) (eq (cadr item) 'menu-item)) |
483 | ;; This is a value returned by `easy-menu-item-present-p' or | |
484 | ;; `easy-menu-remove-item'. | |
485 | (easy-menu-define-key-intern map (car item) (cdr item) before) | |
486 | (if (or (keymapp item) | |
487 | (and (symbolp item) (keymapp (symbol-value item)))) | |
488 | ;; Item is a keymap, find the prompt string and use as item name. | |
489 | (let ((tail (easy-menu-get-map item nil)) name) | |
490 | (if (not (keymapp item)) (setq item tail)) | |
491 | (while (and (null name) (consp (setq tail (cdr tail))) | |
492 | (not (keymapp tail))) | |
493 | (if (stringp (car tail)) (setq name (car tail)) ; Got a name. | |
494 | (setq tail (cdr tail)))) | |
495 | (setq item (cons name item)))) | |
496 | (easy-menu-do-add-item map item before))) | |
024bda02 | 497 | |
5e6656e0 RS |
498 | (defun easy-menu-item-present-p (map path name) |
499 | "In submenu of MAP with path PATH, return true iff item NAME is present. | |
500 | MAP and PATH are defined as in `easy-menu-add-item'. | |
024bda02 | 501 | NAME should be a string, the name of the element to be looked for." |
3de63fb6 | 502 | (easy-menu-return-item (easy-menu-get-map map path) name)) |
024bda02 | 503 | |
5e6656e0 RS |
504 | (defun easy-menu-remove-item (map path name) |
505 | "From submenu of MAP with path PATH remove item NAME. | |
506 | MAP and PATH are defined as in `easy-menu-add-item'. | |
024bda02 | 507 | NAME should be a string, the name of the element to be removed." |
3de63fb6 RS |
508 | (setq map (easy-menu-get-map map path)) |
509 | (let ((ret (easy-menu-return-item map name))) | |
510 | (if ret (easy-menu-define-key-intern map name nil)) | |
511 | ret)) | |
512 | ||
513 | (defun easy-menu-return-item (menu name) | |
4d6d04b5 DL |
514 | "In menu MENU try to look for menu item with name NAME. |
515 | If a menu item is found, return (NAME . item), otherwise return nil. | |
516 | If item is an old format item, a new format item is returned." | |
3de63fb6 RS |
517 | (let ((item (lookup-key menu (vector (intern name)))) |
518 | ret enable cache label) | |
519 | (cond | |
520 | ((or (keymapp item) (eq (car-safe item) 'menu-item)) | |
521 | (cons name item)) ; Keymap or new menu format | |
522 | ((stringp (car-safe item)) | |
523 | ;; This is the old menu format. Convert it to new format. | |
524 | (setq label (car item)) | |
525 | (when (stringp (car (setq item (cdr item)))) ; Got help string | |
526 | (setq ret (list :help (car item))) | |
527 | (setq item (cdr item))) | |
528 | (when (and (consp item) (consp (car item)) | |
529 | (or (null (caar item)) (numberp (caar item)))) | |
530 | (setq cache (car item)) ; Got cache | |
531 | (setq item (cdr item))) | |
532 | (and (symbolp item) (setq enable (get item 'menu-enable)) ; Got enable | |
533 | (setq ret (cons :enable (cons enable ret)))) | |
534 | (if cache (setq ret (cons cache ret))) | |
535 | (cons name (cons 'menu-enable (cons label (cons item ret)))))))) | |
024bda02 | 536 | |
fd43ede0 KH |
537 | (defun easy-menu-get-map-look-for-name (name submap) |
538 | (while (and submap (not (or (equal (car-safe (cdr-safe (car submap))) name) | |
539 | (equal (car-safe (cdr-safe (cdr-safe (car submap)))) name)))) | |
540 | (setq submap (cdr submap))) | |
541 | submap) | |
542 | ||
5edf6b55 SM |
543 | ;; This should really be in keymap.c |
544 | (defun easy-menu-current-active-maps () | |
545 | (let ((maps (list (current-local-map) global-map))) | |
546 | (dolist (minor minor-mode-map-alist) | |
5e5b3d41 GM |
547 | (when (and (boundp (car minor)) |
548 | (symbol-value (car minor))) | |
549 | (push (cdr minor) maps))) | |
5edf6b55 SM |
550 | (delq nil maps))) |
551 | ||
fd43ede0 | 552 | (defun easy-menu-get-map (map path &optional to-modify) |
4d6d04b5 DL |
553 | "Return a sparse keymap in which to add or remove an item. |
554 | MAP and PATH are as defined in `easy-menu-add-item'. | |
fd43ede0 | 555 | |
4d6d04b5 DL |
556 | TO-MODIFY, if non-nil, is the name of the item the caller |
557 | wants to modify in the map that we return. | |
558 | In some cases we use that to select between the local and global maps." | |
5edf6b55 SM |
559 | (setq map |
560 | (catch 'found | |
561 | (let* ((key (vconcat (unless map '(menu-bar)) (mapcar 'intern path))) | |
562 | (maps (mapcar (lambda (map) | |
563 | (setq map (lookup-key map key)) | |
564 | (while (and (symbolp map) (keymapp map)) | |
565 | (setq map (symbol-function map))) | |
566 | map) | |
567 | (if map | |
568 | (list (if (and (symbolp map) | |
569 | (not (keymapp map))) | |
570 | (symbol-value map) map)) | |
571 | (easy-menu-current-active-maps))))) | |
572 | ;; Prefer a map that already contains the to-be-modified entry. | |
573 | (when to-modify | |
574 | (dolist (map maps) | |
575 | (when (and map (not (integerp map)) | |
576 | (easy-menu-get-map-look-for-name to-modify map)) | |
577 | (throw 'found map)))) | |
578 | ;; Use the first valid map. | |
579 | (dolist (map maps) | |
580 | (when (and map (not (integerp map))) | |
581 | (throw 'found map))) | |
582 | ;; Otherwise, make one up. | |
583 | ;; Hardcoding current-local-map is lame, but it's difficult | |
584 | ;; to know what the caller intended for us to do ;-( | |
585 | (let* ((name (if path (format "%s" (car (reverse path))))) | |
586 | (newmap (make-sparse-keymap name))) | |
587 | (define-key (or map (current-local-map)) key | |
588 | (if name (cons name newmap) newmap)) | |
589 | newmap)))) | |
5e6656e0 RS |
590 | (or (keymapp map) (error "Malformed menu in easy-menu: (%s)" map)) |
591 | map) | |
024bda02 | 592 | |
029b623a RS |
593 | (provide 'easymenu) |
594 | ||
595 | ;;; easymenu.el ends here |