Commit | Line | Data |
---|---|---|
029b623a RS |
1 | ;;; easymenu.el --- support the easymenu interface for defining a menu. |
2 | ||
024bda02 | 3 | ;; Copyright (C) 1994, 1996, 1998 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 | ||
a8226f67 | 33 | ;;;###autoload |
8df69fb0 | 34 | (defmacro easy-menu-define (symbol maps doc menu) |
029b623a | 35 | "Define a menu bar submenu in maps MAPS, according to MENU. |
819fefed RS |
36 | The menu keymap is stored in symbol SYMBOL, both as its value |
37 | and as its function definition. DOC is used as the doc string for SYMBOL. | |
029b623a RS |
38 | |
39 | The first element of MENU must be a string. It is the menu bar item name. | |
024bda02 RS |
40 | It may be followed by the keyword argument pair |
41 | :filter FUNCTION | |
42 | FUNCTION is a function with one argument, the menu. It returns the actual | |
43 | menu displayed. | |
44 | ||
029b623a RS |
45 | The rest of the elements are menu items. |
46 | ||
8df69fb0 | 47 | A menu item is usually a vector of three elements: [NAME CALLBACK ENABLE] |
029b623a | 48 | |
a8226f67 | 49 | NAME is a string--the menu item name. |
029b623a | 50 | |
a8226f67 RS |
51 | CALLBACK is a command to run when the item is chosen, |
52 | or a list to evaluate when the item is chosen. | |
029b623a | 53 | |
5a51e0a6 RS |
54 | ENABLE is an expression; the item is enabled for selection |
55 | whenever this expression's value is non-nil. | |
8df69fb0 | 56 | |
1ba15fe6 RS |
57 | Alternatively, a menu item may have the form: |
58 | ||
59 | [ NAME CALLBACK [ KEYWORD ARG ] ... ] | |
60 | ||
024bda02 | 61 | Where KEYWORD is one of the symbols defined below. |
1ba15fe6 RS |
62 | |
63 | :keys KEYS | |
64 | ||
65 | KEYS is a string; a complex keyboard equivalent to this menu item. | |
66 | This is normally not needed because keyboard equivalents are usually | |
67 | computed automatically. | |
68 | ||
69 | :active ENABLE | |
70 | ||
71 | ENABLE is an expression; the item is enabled for selection | |
72 | whenever this expression's value is non-nil. | |
73 | ||
74 | :suffix NAME | |
75 | ||
76 | NAME is a string; the name of an argument to CALLBACK. | |
77 | ||
41e6ca7a | 78 | :style STYLE |
1ba15fe6 RS |
79 | |
80 | STYLE is a symbol describing the type of menu item. The following are | |
81 | defined: | |
82 | ||
e6a6d697 RS |
83 | toggle: A checkbox. |
84 | Prepend the name with '(*) ' or '( ) ' depending on if selected or not. | |
85 | radio: A radio button. | |
86 | Prepend the name with '[X] ' or '[ ] ' depending on if selected or not. | |
1ba15fe6 RS |
87 | nil: An ordinary menu item. |
88 | ||
89 | :selected SELECTED | |
90 | ||
91 | SELECTED is an expression; the checkbox or radio button is selected | |
92 | whenever this expression's value is non-nil. | |
1ba15fe6 | 93 | |
a8226f67 RS |
94 | A menu item can be a string. Then that string appears in the menu as |
95 | unselectable text. A string consisting solely of hyphens is displayed | |
96 | as a solid horizontal line. | |
029b623a | 97 | |
a8226f67 | 98 | A menu item can be a list. It is treated as a submenu. |
029b623a | 99 | The first element should be the submenu name. That's used as the |
024bda02 RS |
100 | menu item name in the top-level menu. It may be followed by the :filter |
101 | FUNCTION keyword argument pair. The rest of the submenu list are menu items, | |
102 | as above." | |
103 | `(progn | |
104 | (defvar ,symbol nil ,doc) | |
105 | (easy-menu-do-define (quote ,symbol) ,maps ,doc ,menu))) | |
1ba15fe6 | 106 | |
f39223a6 | 107 | ;;;###autoload |
1ba15fe6 RS |
108 | (defun easy-menu-do-define (symbol maps doc menu) |
109 | ;; We can't do anything that might differ between Emacs dialects in | |
110 | ;; `easy-menu-define' in order to make byte compiled files | |
111 | ;; compatible. Therefore everything interesting is done in this | |
112 | ;; function. | |
024bda02 | 113 | (set symbol (easy-menu-create-menu (car menu) (cdr menu))) |
1ba15fe6 | 114 | (fset symbol (` (lambda (event) (, doc) (interactive "@e") |
94ddbbff | 115 | (x-popup-menu event (, symbol))))) |
1ba15fe6 RS |
116 | (mapcar (function (lambda (map) |
117 | (define-key map (vector 'menu-bar (intern (car menu))) | |
118 | (cons (car menu) (symbol-value symbol))))) | |
119 | (if (keymapp maps) (list maps) maps))) | |
a8226f67 | 120 | |
024bda02 RS |
121 | (defun easy-menu-filter-return (menu) |
122 | "Convert MENU to the right thing to return from a menu filter. | |
123 | MENU is a menu as computed by `easy-menu-define' or `easy-menu-create-menu' or | |
124 | a symbol whose value is such a menu. | |
125 | In Emacs a menu filter must return a menu (a keymap), in XEmacs a filter must | |
126 | return a menu items list (without menu name and keywords). This function | |
127 | returns the right thing in the two cases." | |
128 | (easy-menu-get-map menu nil)) ; Get past indirections. | |
029b623a | 129 | |
815d2127 | 130 | ;;;###autoload |
024bda02 RS |
131 | (defun easy-menu-create-menu (menu-name menu-items) |
132 | "Create a menu called MENU-NAME with items described in MENU-ITEMS. | |
133 | MENU-NAME is a string, the name of the menu. MENU-ITEMS is a list of items | |
134 | possibly preceded by keyword pairs as described in `easy-menu-define'." | |
135 | (let ((menu (make-sparse-keymap menu-name)) | |
136 | keyword filter have-buttons) | |
137 | ;; Look for keywords. | |
138 | (while (and menu-items (cdr menu-items) | |
139 | (symbolp (setq keyword (car menu-items))) | |
140 | (= ?: (aref (symbol-name keyword) 0))) | |
141 | (if (eq keyword ':filter) (setq filter (cadr menu-items))) | |
142 | (setq menu-items (cddr menu-items))) | |
029b623a RS |
143 | ;; Process items in reverse order, |
144 | ;; since the define-key loop reverses them again. | |
145 | (setq menu-items (reverse menu-items)) | |
146 | (while menu-items | |
024bda02 RS |
147 | (setq have-buttons |
148 | (easy-menu-do-add-item menu (car menu-items) have-buttons)) | |
029b623a | 149 | (setq menu-items (cdr menu-items))) |
024bda02 RS |
150 | (when filter |
151 | (setq menu (easy-menu-make-symbol menu nil)) | |
152 | (put menu 'menu-enable | |
153 | `(easy-menu-filter (quote ,menu) (quote ,filter)))) | |
029b623a RS |
154 | menu)) |
155 | ||
024bda02 RS |
156 | |
157 | ;; Button prefixes. | |
158 | (defvar easy-menu-button-prefix | |
159 | '((radio ?* . "( ) ") (toggle ?X . "[ ] "))) | |
160 | ||
161 | (defun easy-menu-do-add-item (menu item have-buttons &optional prev top) | |
162 | ;; Parse an item description and add the item to a keymap. This is | |
163 | ;; the function that is used for item definition by the other easy-menu | |
164 | ;; functions. | |
165 | ;; MENU is a sparse keymap. | |
166 | ;; ITEM defines an item as in `easy-menu-define'. | |
167 | ;; HAVE-BUTTONS is a string or nil. If not nil, use as item prefix for | |
168 | ;; items that are not toggle or radio buttons to compensate for the | |
169 | ;; button prefix. | |
170 | ;; PREV is nil or a tail in MENU. If PREV is not nil put item after | |
171 | ;; PREV in MENU, otherwise put it first in MENU. | |
172 | ;; If TOP is true, this is an item in the menu bar itself so | |
173 | ;; don't use prefix. In this case HAVE-BUTTONS will be nil. | |
174 | (let (command name item-string is-button) | |
175 | (cond | |
176 | ((stringp item) | |
177 | (setq item | |
178 | (if (string-match ; If an XEmacs separator | |
179 | "^\\(-+\\|\ | |
180 | --:\\(\\(no\\|\\(sing\\|doub\\)le\\(Dashed\\)?\\)Line\\|\ | |
181 | shadow\\(Double\\)?Etched\\(In\\|Out\\)\\(Dash\\)?\\)\\)$" | |
182 | item) "" ; use a single line separator. | |
183 | (concat have-buttons item))) | |
184 | ;; Handle inactive strings specially, | |
185 | ;; allow any number of identical ones. | |
186 | (cond | |
187 | (prev (setq menu prev)) | |
188 | ((and (consp (cdr menu)) (stringp (cadr menu))) (setq menu (cdr menu)))) | |
189 | (setcdr menu (cons (list nil item) (cdr menu)))) | |
190 | ((consp item) | |
191 | (setq name (setq item-string (car item))) | |
192 | (setq command (if (keymapp (setq item (cdr item))) item | |
193 | (easy-menu-create-menu name item)))) | |
194 | ((vectorp item) | |
195 | (setq name (setq item-string (aref item 0))) | |
196 | (setq command (easy-menu-make-symbol (aref item 1) t)) | |
197 | (let ((active (aref item 2)) | |
198 | (count 2) | |
199 | style selected) | |
200 | (if (and (symbolp active) (= ?: (aref (symbol-name active) 0))) | |
201 | (let ((count 2) keyword arg suffix keys) | |
202 | (setq active nil) | |
203 | (while (> (length item) count) | |
204 | (setq keyword (aref item count)) | |
205 | (setq arg (aref item (1+ count))) | |
206 | (setq count (+ 2 count)) | |
207 | (cond | |
208 | ((eq keyword ':keys) (setq keys arg)) | |
209 | ((eq keyword ':active) (setq active arg)) | |
210 | ((eq keyword ':suffix) (setq suffix arg)) | |
211 | ((eq keyword ':style) (setq style arg)) | |
212 | ((eq keyword ':selected) (setq selected arg)))) | |
213 | (if suffix (setq item-string (concat item-string " " suffix))) | |
214 | (if keys | |
215 | (setq item-string (concat item-string " (" keys ")"))) | |
216 | (when (and selected | |
217 | (setq style (assq style easy-menu-button-prefix))) | |
218 | ;; Simulate checkboxes and radio buttons. | |
219 | (setq item-string (concat (cddr style) item-string)) | |
220 | (put command 'menu-enable | |
221 | `(easy-menu-update-button ,item-string | |
222 | ,(cadr style) | |
223 | ,selected | |
224 | ,(or active t))) | |
225 | (setq is-button t) | |
226 | (setq active nil) ; Already taken care of active. | |
227 | (when (not (or have-buttons top)) | |
228 | (setq have-buttons " ") | |
229 | ;; Add prefix to menu items defined so far. | |
230 | (easy-menu-change-prefix menu t))))) | |
231 | (if active (put command 'menu-enable active))))) | |
232 | (when name | |
233 | (and (not is-button) have-buttons | |
234 | (setq item-string (concat have-buttons item-string))) | |
235 | (setq item (cons item-string command)) | |
236 | (setq name (vector (intern name))) | |
237 | (if prev (define-key-after menu name item (vector (caar prev))) | |
238 | (define-key menu name item))) | |
239 | have-buttons)) | |
240 | ||
241 | (defvar easy-menu-item-count 0) | |
242 | ||
243 | (defun easy-menu-make-symbol (callback call) | |
244 | ;; Return a unique symbol with CALLBACK as function value. | |
245 | ;; If CALL is false then this is a keymap, not a function. | |
246 | ;; Else if CALLBACK is a symbol, avoid the indirection when looking for | |
247 | ;; key-bindings in menu. | |
248 | ;; Else make a lambda expression of CALLBACK. | |
249 | (let ((command | |
250 | (make-symbol (format "menu-function-%d" easy-menu-item-count)))) | |
251 | (setq easy-menu-item-count (1+ easy-menu-item-count)) | |
252 | (fset command | |
253 | (cond | |
254 | ((not call) callback) | |
255 | ((symbolp callback) | |
256 | ;; Try find key-bindings for callback instead of for command | |
257 | (put command 'menu-alias t) ; when displaying menu. | |
258 | callback) | |
259 | (t `(lambda () (interactive) ,callback)))) | |
260 | command)) | |
261 | ||
262 | (defun easy-menu-filter (name filter) | |
263 | "Used as menu-enable property to filter menus. | |
264 | A call to this function is used as the menu-enable property for a menu with | |
265 | a filter function. | |
266 | NAME is a symbol with a keymap as function value. Call the function FILTER | |
267 | with this keymap as argument. FILTER must return a keymap which becomes the | |
268 | new function value for NAME. Use `easy-menu-filter-return' to return the | |
269 | correct value in a way portable to XEmacs. If the new keymap is `eq' the old, | |
270 | then the menu is not updated." | |
271 | (let* ((old (symbol-function name)) | |
272 | (new (funcall filter old))) | |
273 | (or (eq old new) ; No change | |
274 | (and (fset name new) | |
275 | ;; Make sure the menu gets updated by returning a | |
276 | ;; different value than last time to cheat the cache. | |
277 | (random))))) | |
278 | ||
e6a6d697 RS |
279 | (defun easy-menu-update-button (item ch selected active) |
280 | "Used as menu-enable property to update buttons. | |
281 | A call to this function is used as the menu-enable property for buttons. | |
024bda02 RS |
282 | ITEM is the item-string into which CH or ` ' is inserted depending on if |
283 | SELECTED is true or not. The menu entry in enabled iff ACTIVE is true." | |
e6a6d697 RS |
284 | (let ((new (if selected ch ? )) |
285 | (old (aref item 1))) | |
286 | (if (eq new old) | |
287 | ;; No change, just use the active value. | |
288 | active | |
289 | ;; It has changed. Update the entry. | |
290 | (aset item 1 new) | |
291 | ;; If the entry is active, make sure the menu gets updated by | |
292 | ;; returning a different value than last time to cheat the cache. | |
293 | (and active | |
294 | (random))))) | |
295 | ||
024bda02 | 296 | (defun easy-menu-change (path name items &optional before) |
88153c47 RS |
297 | "Change menu found at PATH as item NAME to contain ITEMS. |
298 | PATH is a list of strings for locating the menu containing NAME in the | |
299 | menu bar. ITEMS is a list of menu items, as in `easy-menu-define'. | |
300 | These items entirely replace the previous items in that map. | |
024bda02 RS |
301 | If NAME is not present in the menu located by PATH, then add item NAME to |
302 | that menu. If the optional argument BEFORE is present add NAME in menu | |
303 | just before BEFORE, otherwise add at end of menu. | |
88153c47 | 304 | |
024bda02 RS |
305 | Either call this from `menu-bar-update-hook' or use a menu filter, |
306 | to implement dynamic menus." | |
307 | (easy-menu-add-item nil path (cons name items) before)) | |
88153c47 | 308 | |
024bda02 RS |
309 | ;; XEmacs needs the following two functions to add and remove menus. |
310 | ;; In Emacs this is done automatically when switching keymaps, so | |
311 | ;; here these functions are noops. | |
1ba15fe6 | 312 | (defun easy-menu-remove (menu)) |
8df69fb0 | 313 | |
1ba15fe6 | 314 | (defun easy-menu-add (menu &optional map)) |
8df69fb0 | 315 | |
024bda02 RS |
316 | (defun easy-menu-add-item (menu path item &optional before) |
317 | "At the end of the submenu of MENU with path PATH add ITEM. | |
318 | If ITEM is already present in this submenu, then this item will be changed. | |
319 | otherwise ITEM will be added at the end of the submenu, unless the optional | |
320 | argument BEFORE is present, in which case ITEM will instead be added | |
321 | before the item named BEFORE. | |
322 | MENU is either a symbol, which have earlier been used as the first | |
323 | argument in a call to `easy-menu-define', or the value of such a symbol | |
324 | i.e. a menu, or nil which stands for the menu-bar itself. | |
325 | PATH is a list of strings for locating the submenu where ITEM is to be | |
326 | added. If PATH is nil, MENU itself is used. Otherwise, the first | |
327 | element should be the name of a submenu directly under MENU. This | |
328 | submenu is then traversed recursively with the remaining elements of PATH. | |
329 | ITEM is either defined as in `easy-menu-define' or a menu defined earlier | |
330 | by `easy-menu-define' or `easy-menu-create-menu'." | |
331 | (let ((top (not (or menu path))) | |
332 | tmp prev next) | |
333 | (setq menu (easy-menu-get-map menu path)) | |
334 | (or (lookup-key menu (vector (intern (elt item 0)))) | |
335 | (and menu (keymapp (cdr menu))) | |
336 | (setq tmp (cdr menu))) | |
337 | (while (and tmp (not (keymapp tmp)) | |
338 | (not (and (consp (car tmp)) (symbolp (caar tmp))))) | |
339 | (setq tmp (cdr tmp))) | |
340 | (and before (setq before (intern before))) | |
341 | (if (or (null tmp) (keymapp tmp) (eq (setq prev (caar tmp)) before)) | |
342 | (setq prev nil) | |
343 | (while (and tmp (not (keymapp tmp)) | |
344 | (not (and (consp (car tmp)) | |
345 | (eq (caar (setq next tmp)) before)))) | |
346 | (if next (setq prev next)) | |
347 | (setq next nil) | |
348 | (setq tmp (cdr tmp)))) | |
349 | (when (or (keymapp item) | |
350 | (and (symbolp item) (keymapp (symbol-value item)))) | |
351 | ;; Item is a keymap, find the prompt string and use as item name. | |
352 | (setq next (easy-menu-get-map item nil)) | |
353 | (if (not (keymapp item)) (setq item next)) | |
354 | (setq tmp nil) ; No item name yet. | |
355 | (while (and (null tmp) (consp (setq next (cdr next))) | |
356 | (not (keymapp next))) | |
357 | (if (stringp (car next)) (setq tmp (car next)) ; Got a name. | |
358 | (setq next (cdr next)))) | |
359 | (setq item (cons tmp item))) | |
360 | (easy-menu-do-add-item menu item | |
361 | (and (not top) (easy-menu-have-button menu) " ") | |
362 | prev top))) | |
363 | ||
364 | (defun easy-menu-item-present-p (menu path name) | |
365 | "In submenu of MENU with path PATH, return true iff item NAME is present. | |
366 | MENU and PATH are defined as in `easy-menu-add-item'. | |
367 | NAME should be a string, the name of the element to be looked for." | |
368 | (lookup-key (easy-menu-get-map menu path) (vector (intern name)))) | |
369 | ||
370 | (defun easy-menu-remove-item (menu path name) | |
371 | "From submenu of MENU with path PATH remove item NAME. | |
372 | MENU and PATH are defined as in `easy-menu-add-item'. | |
373 | NAME should be a string, the name of the element to be removed." | |
374 | (let ((item (vector (intern name))) | |
375 | (top (not (or menu path))) | |
376 | tmp) | |
377 | (setq menu (easy-menu-get-map menu path)) | |
378 | (when (setq tmp (lookup-key menu item)) | |
379 | (define-key menu item nil) | |
380 | (and (not top) | |
381 | (easy-menu-is-button tmp) ; Removed item was a button and | |
382 | (not (easy-menu-have-button menu)) ; no buttons left then | |
383 | ;; remove prefix from items in menu | |
384 | (easy-menu-change-prefix menu nil))))) | |
385 | ||
386 | (defun easy-menu-get-map (menu path) | |
387 | ;; Return a sparse keymap in which to add or remove an item. | |
388 | ;; MENU and PATH are as defined in `easy-menu-remove-item'. | |
389 | (if (null menu) | |
390 | (setq menu (key-binding (vconcat '(menu-bar) (mapcar 'intern path)))) | |
391 | (if (and (symbolp menu) (not (keymapp menu))) | |
392 | (setq menu (symbol-value menu))) | |
393 | (if path (setq menu (lookup-key menu (vconcat (mapcar 'intern path)))))) | |
394 | (while (and (symbolp menu) (keymapp menu)) | |
395 | (setq menu (symbol-function menu))) | |
396 | (or (keymapp menu) (error "Malformed menu in easy-menu: (%s)" menu)) | |
397 | menu) | |
398 | ||
399 | (defun easy-menu-is-button (val) | |
400 | ;; VAL is a real menu binding. Return true iff it is a toggle or | |
401 | ;; radio button. | |
402 | (and (symbolp val) | |
403 | (consp (setq val (get val 'menu-enable))) | |
404 | (eq (car val) 'easy-menu-update-button))) | |
405 | ||
406 | (defun easy-menu-have-button (map) | |
407 | ;; MAP is a sparse keymap. Return true iff there is any toggle or radio | |
408 | ;; button in MAP. | |
409 | (let ((have nil) tmp) | |
410 | (while (and (consp map) (not have)) | |
411 | (and (consp (setq tmp (car map))) | |
412 | (consp (setq tmp (cdr tmp))) | |
413 | (stringp (car tmp)) | |
414 | (setq have (easy-menu-is-button (easy-menu-real-binding tmp)))) | |
415 | (setq map (cdr map))) | |
416 | have)) | |
417 | ||
418 | (defun easy-menu-real-binding (val) | |
419 | ;; Val is a menu keymap binding. Skip item string. | |
420 | ;; Also skip a possible help string and/or key-binding cache. | |
421 | (if (and (consp (setq val (cdr val))) (stringp (car val))) | |
422 | (setq val (cdr val))) ; Skip help string. | |
423 | (if (and (consp val) (consp (car val)) | |
424 | (or (null (caar val)) (vectorp (caar val)))) | |
425 | (setq val (cdr val))) ; Skip key-binding cache. | |
426 | val) | |
427 | ||
428 | (defun easy-menu-change-prefix (map add) | |
429 | ;; MAP is a sparse keymap. | |
430 | ;; If ADD is true add a button compensating prefix to each menu item in MAP. | |
431 | ;; Else remove prefix instead. | |
432 | (let (tmp val) | |
433 | (while (consp map) | |
434 | (when (and (consp (setq tmp (car map))) | |
435 | (consp (setq tmp (cdr tmp))) | |
436 | (stringp (car tmp))) | |
437 | (cond | |
438 | (add (setcar tmp (concat " " (car tmp)))) | |
439 | ((string-match "$ " (car tmp)) | |
440 | (setcar tmp (substring (car tmp) (match-end 0)))))) | |
441 | (setq map (cdr map))))) | |
442 | ||
029b623a RS |
443 | (provide 'easymenu) |
444 | ||
445 | ;;; easymenu.el ends here |