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