49 |
;;;###autoload |
;;;###autoload |
50 |
(defmacro easy-menu-define (symbol maps doc menu) |
(defmacro easy-menu-define (symbol maps doc menu) |
51 |
"Define a menu bar submenu in maps MAPS, according to MENU. |
"Define a menu bar submenu in maps MAPS, according to MENU. |
52 |
The menu keymap is stored in symbol SYMBOL, both as its value |
|
53 |
and as its function definition. DOC is used as the doc string for SYMBOL. |
If SYMBOL is non-nil, store the menu keymap in the value of SYMBOL, |
54 |
|
and define SYMBOL as a function to pop up the menu, with DOC as its doc string. |
55 |
|
If SYMBOL is nil, just store the menu keymap into MAPS. |
56 |
|
|
57 |
The first element of MENU must be a string. It is the menu bar item name. |
The first element of MENU must be a string. It is the menu bar item name. |
58 |
It may be followed by the following keyword argument pairs |
It may be followed by the following keyword argument pairs |
148 |
|
|
149 |
A menu item can be a list with the same format as MENU. This is a submenu." |
A menu item can be a list with the same format as MENU. This is a submenu." |
150 |
`(progn |
`(progn |
151 |
(defvar ,symbol nil ,doc) |
,(if symbol `(defvar ,symbol nil ,doc)) |
152 |
(easy-menu-do-define (quote ,symbol) ,maps ,doc ,menu))) |
(easy-menu-do-define (quote ,symbol) ,maps ,doc ,menu))) |
153 |
|
|
154 |
;;;###autoload |
;;;###autoload |
158 |
;; compatible. Therefore everything interesting is done in this |
;; compatible. Therefore everything interesting is done in this |
159 |
;; function. |
;; function. |
160 |
(let ((keymap (easy-menu-create-menu (car menu) (cdr menu)))) |
(let ((keymap (easy-menu-create-menu (car menu) (cdr menu)))) |
161 |
(set symbol keymap) |
(when symbol |
162 |
(fset symbol |
(set symbol keymap) |
163 |
`(lambda (event) ,doc (interactive "@e") |
(fset symbol |
164 |
;; FIXME: XEmacs uses popup-menu which calls the binding |
`(lambda (event) ,doc (interactive "@e") |
165 |
;; while x-popup-menu only returns the selection. |
;; FIXME: XEmacs uses popup-menu which calls the binding |
166 |
(x-popup-menu event |
;; while x-popup-menu only returns the selection. |
167 |
(or (and (symbolp ,symbol) |
(x-popup-menu event |
168 |
(funcall |
(or (and (symbolp ,symbol) |
169 |
(or (plist-get (get ,symbol 'menu-prop) |
(funcall |
170 |
:filter) |
(or (plist-get (get ,symbol 'menu-prop) |
171 |
'identity) |
:filter) |
172 |
(symbol-function ,symbol))) |
'identity) |
173 |
,symbol)))) |
(symbol-function ,symbol))) |
174 |
|
,symbol))))) |
175 |
(mapcar (lambda (map) |
(mapcar (lambda (map) |
176 |
(define-key map (vector 'menu-bar (easy-menu-intern (car menu))) |
(define-key map (vector 'menu-bar (easy-menu-intern (car menu))) |
177 |
(cons 'menu-item |
(cons 'menu-item |
190 |
return a menu items list (without menu name and keywords). |
return a menu items list (without menu name and keywords). |
191 |
This function returns the right thing in the two cases. |
This function returns the right thing in the two cases. |
192 |
If NAME is provided, it is used for the keymap." |
If NAME is provided, it is used for the keymap." |
193 |
(when (and (not (keymapp menu)) (consp menu)) |
(cond |
194 |
|
((and (not (keymapp menu)) (consp menu)) |
195 |
;; If it's a cons but not a keymap, then it can't be right |
;; If it's a cons but not a keymap, then it can't be right |
196 |
;; unless it's an XEmacs menu. |
;; unless it's an XEmacs menu. |
197 |
(setq menu (easy-menu-create-menu (or name "") menu))) |
(setq menu (easy-menu-create-menu (or name "") menu))) |
198 |
(easy-menu-get-map menu nil)) ; Get past indirections. |
((vectorp menu) |
199 |
|
;; It's just a menu entry. |
200 |
|
(setq menu (cdr (easy-menu-convert-item menu))))) |
201 |
|
menu) |
202 |
|
|
203 |
;;;###autoload |
;;;###autoload |
204 |
(defun easy-menu-create-menu (menu-name menu-items) |
(defun easy-menu-create-menu (menu-name menu-items) |
266 |
easy-menu-converted-items-table))) |
easy-menu-converted-items-table))) |
267 |
|
|
268 |
(defun easy-menu-convert-item-1 (item) |
(defun easy-menu-convert-item-1 (item) |
269 |
"Parse an item description and add the item to a keymap. |
"Parse an item description and convert it to a menu keymap element. |
270 |
This is the function that is used for item definition by the other easy-menu |
ITEM defines an item as in `easy-menu-define'." |
|
functions. |
|
|
MENU is a sparse keymap i.e. a list starting with the symbol `keymap'. |
|
|
ITEM defines an item as in `easy-menu-define'. |
|
|
Optional argument BEFORE is nil or a key in MENU. If BEFORE is not nil |
|
|
put item before BEFORE in MENU, otherwise if item is already present in |
|
|
MENU, just change it, otherwise put it last in MENU." |
|
271 |
(let (name command label prop remove help) |
(let (name command label prop remove help) |
272 |
(cond |
(cond |
273 |
((stringp item) ; An item or separator. |
((stringp item) ; An item or separator. |
337 |
(postfix |
(postfix |
338 |
(if (< (match-end 1) (match-end 0)) |
(if (< (match-end 1) (match-end 0)) |
339 |
(substring keys (match-end 1)))) |
(substring keys (match-end 1)))) |
340 |
(cmd (intern (substring keys (match-beginning 2) |
(cmd (intern (match-string 2 keys)))) |
|
(match-end 2))))) |
|
341 |
(setq keys (and (or prefix postfix) |
(setq keys (and (or prefix postfix) |
342 |
(cons prefix postfix))) |
(cons prefix postfix))) |
343 |
(setq keys |
(setq keys |
414 |
(eq (car-safe item) name) |
(eq (car-safe item) name) |
415 |
(if (stringp name) |
(if (stringp name) |
416 |
;; Match against the text that is displayed to the user. |
;; Match against the text that is displayed to the user. |
417 |
(or (member-ignore-case name item) |
(or (condition-case nil (member-ignore-case name item) |
418 |
|
(error nil)) ;`item' might not be a proper list. |
419 |
;; Also check the string version of the symbol name, |
;; Also check the string version of the symbol name, |
420 |
;; for backwards compatibility. |
;; for backwards compatibility. |
421 |
(eq (car-safe item) (intern name))))))) |
(eq (car-safe item) (intern name)) |
422 |
|
(eq (car-safe item) (easy-menu-intern name))))))) |
423 |
|
|
424 |
(defun easy-menu-always-true (x) |
(defun easy-menu-always-true (x) |
425 |
"Return true if form X never evaluates to nil." |
"Return true if form X never evaluates to nil." |
454 |
|
|
455 |
Either call this from `menu-bar-update-hook' or use a menu filter, |
Either call this from `menu-bar-update-hook' or use a menu filter, |
456 |
to implement dynamic menus." |
to implement dynamic menus." |
457 |
(easy-menu-add-item nil path (cons name items) before)) |
(easy-menu-add-item nil path (easy-menu-create-menu name items) before)) |
458 |
|
|
459 |
;; XEmacs needs the following two functions to add and remove menus. |
;; XEmacs needs the following two functions to add and remove menus. |
460 |
;; In Emacs this is done automatically when switching keymaps, so |
;; In Emacs this is done automatically when switching keymaps, so |
461 |
;; here easy-menu-remove is a noop and easy-menu-add only precalculates |
;; here easy-menu-remove is a noop and easy-menu-add only precalculates |
462 |
;; equivalent keybindings (if easy-menu-precalculate-equivalent-keybindings |
;; equivalent keybindings (if easy-menu-precalculate-equivalent-keybindings |
463 |
;; is on). |
;; is on). |
464 |
(defalias 'easy-menu-remove 'ignore) |
(defalias 'easy-menu-remove 'ignore |
465 |
|
"Remove MENU from the current menu bar. |
466 |
|
Contrary to XEmacs, this is a nop on Emacs since menus are automatically |
467 |
|
\(de)activated when the corresponding keymap is (de)activated. |
468 |
|
|
469 |
|
\(fn MENU)") |
470 |
|
|
471 |
(defun easy-menu-add (menu &optional map) |
(defun easy-menu-add (menu &optional map) |
472 |
"Maybe precalculate equivalent key bindings. |
"Add the menu to the menubar. |
473 |
|
This is a nop on Emacs since menus are automatically activated when the |
474 |
|
corresponding keymap is activated. On XEmacs this is needed to actually |
475 |
|
add the menu to the current menubar. |
476 |
|
Maybe precalculate equivalent key bindings. |
477 |
Do it only if `easy-menu-precalculate-equivalent-keybindings' is on." |
Do it only if `easy-menu-precalculate-equivalent-keybindings' is on." |
478 |
(when easy-menu-precalculate-equivalent-keybindings |
(when easy-menu-precalculate-equivalent-keybindings |
479 |
(if (and (symbolp menu) (not (keymapp menu)) (boundp menu)) |
(if (and (symbolp menu) (not (keymapp menu)) (boundp menu)) |
498 |
However, if BEFORE is a string and there is an item in the submenu |
However, if BEFORE is a string and there is an item in the submenu |
499 |
with that name, then ITEM is added before that item. |
with that name, then ITEM is added before that item. |
500 |
|
|
501 |
MAP should normally be a keymap; nil stands for the global menu-bar keymap. |
MAP should normally be a keymap; nil stands for the local menu-bar keymap. |
502 |
It can also be a symbol, which has earlier been used as the first |
It can also be a symbol, which has earlier been used as the first |
503 |
argument in a call to `easy-menu-define', or the value of such a symbol. |
argument in a call to `easy-menu-define', or the value of such a symbol. |
504 |
|
|
576 |
(setq submap (cdr submap))) |
(setq submap (cdr submap))) |
577 |
submap) |
submap) |
578 |
|
|
|
;; This should really be in keymap.c |
|
|
(defun easy-menu-current-active-maps () |
|
|
(let ((maps (list (current-local-map) global-map))) |
|
|
(dolist (minor minor-mode-map-alist) |
|
|
(when (and (boundp (car minor)) |
|
|
(symbol-value (car minor))) |
|
|
(push (cdr minor) maps))) |
|
|
(delq nil maps))) |
|
|
|
|
579 |
(defun easy-menu-get-map (map path &optional to-modify) |
(defun easy-menu-get-map (map path &optional to-modify) |
580 |
"Return a sparse keymap in which to add or remove an item. |
"Return a sparse keymap in which to add or remove an item. |
581 |
MAP and PATH are as defined in `easy-menu-add-item'. |
MAP and PATH are as defined in `easy-menu-add-item'. |
596 |
(list (if (and (symbolp map) |
(list (if (and (symbolp map) |
597 |
(not (keymapp map))) |
(not (keymapp map))) |
598 |
(symbol-value map) map)) |
(symbol-value map) map)) |
599 |
(easy-menu-current-active-maps))))) |
(current-active-maps))))) |
600 |
;; Prefer a map that already contains the to-be-modified entry. |
;; Prefer a map that already contains the to-be-modified entry. |
601 |
(when to-modify |
(when to-modify |
602 |
(dolist (map maps) |
(dolist (map maps) |