-;;; easymenu.el --- support the easymenu interface for defining a menu.
+;;; easymenu.el --- support the easymenu interface for defining a menu
-;; Copyright (C) 1994, 1996, 1998 Free Software Foundation, Inc.
+;; Copyright (C) 1994, 1996, 1998, 1999, 2000, 2002, 2003, 2004,
+;; 2005 Free Software Foundation, Inc.
;; Keywords: emulations
-;; Author: rms
+;; Author: Richard Stallman <rms@gnu.org>
;; This file is part of GNU Emacs.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
:group 'menu
:version "20.3")
+(defsubst easy-menu-intern (s)
+ (if (stringp s) (intern s) s))
+
+;;;###autoload
+(put 'easy-menu-define 'lisp-indent-function 'defun)
;;;###autoload
(defmacro easy-menu-define (symbol maps doc menu)
"Define a menu bar submenu in maps MAPS, according to MENU.
-The menu keymap is stored in symbol SYMBOL, both as its value
-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,
+and define SYMBOL as a function to pop up the menu, with DOC as its doc string.
+If SYMBOL is nil, just store the menu keymap into MAPS.
The first element of MENU must be a string. It is the menu bar item name.
It may be followed by the following keyword argument pairs
:filter FUNCTION
-FUNCTION is a function with one argument, the menu. It returns the actual
-menu displayed.
+FUNCTION is a function with one argument, the rest of menu items.
+It returns the remaining items of the displayed menu.
:visible INCLUDE
INCLUDE is an expression; this menu is only visible if this
-expression has a non-nil value. `:include' is an alias for `:visible'.
+expression has a non-nil value. `:included' is an alias for `:visible'.
:active ENABLE
ENABLE is an expression; the item is enabled for selection
whenever this expression's value is non-nil.
- :included INCLUDE
+ :visible INCLUDE
INCLUDE is an expression; this item is only visible if this
-expression has a non-nil value.
+expression has a non-nil value. `:included' is an alias for `:visible'.
:suffix FORM
Prepend the name with `(*) ' or `( ) ' depending on if selected or not.
radio: A radio button.
Prepend the name with `[X] ' or `[ ] ' depending on if selected or not.
-button: Surround the name with `[' and `]'. Use this for an item in the
+button: Surround the name with `[' and `]'. Use this for an item in the
menu bar itself.
anything else means an ordinary menu item.
A menu item can be a list with the same format as MENU. This is a submenu."
`(progn
- (defvar ,symbol nil ,doc)
+ ,(if symbol `(defvar ,symbol nil ,doc))
(easy-menu-do-define (quote ,symbol) ,maps ,doc ,menu)))
;;;###autoload
;; compatible. Therefore everything interesting is done in this
;; function.
(let ((keymap (easy-menu-create-menu (car menu) (cdr menu))))
- (set symbol keymap)
- (fset symbol
- `(lambda (event) ,doc (interactive "@e")
- ;; FIXME: XEmacs uses popup-menu which calls the binding
- ;; while x-popup-menu only returns the selection.
- (x-popup-menu event
- (or (and (symbolp ,symbol)
- (funcall
- (or (plist-get (get ,symbol 'menu-prop)
- :filter)
- 'identity)
- (symbol-function ,symbol)))
- ,symbol))))
+ (when symbol
+ (set symbol keymap)
+ (defalias symbol
+ `(lambda (event) ,doc (interactive "@e")
+ ;; FIXME: XEmacs uses popup-menu which calls the binding
+ ;; while x-popup-menu only returns the selection.
+ (x-popup-menu event
+ (or (and (symbolp ,symbol)
+ (funcall
+ (or (plist-get (get ,symbol 'menu-prop)
+ :filter)
+ 'identity)
+ (symbol-function ,symbol)))
+ ,symbol)))))
(mapcar (lambda (map)
- (define-key map (vector 'menu-bar (intern (car menu)))
+ (define-key map (vector 'menu-bar (easy-menu-intern (car menu)))
(cons 'menu-item
(cons (car menu)
(if (not (symbolp keymap))
return a menu items list (without menu name and keywords).
This function returns the right thing in the two cases.
If NAME is provided, it is used for the keymap."
- (when (and (not (keymapp menu)) (consp menu))
+ (cond
+ ((and (not (keymapp menu)) (consp menu))
;; If it's a cons but not a keymap, then it can't be right
;; unless it's an XEmacs menu.
(setq menu (easy-menu-create-menu (or name "") menu)))
- (easy-menu-get-map menu nil)) ; Get past indirections.
+ ((vectorp menu)
+ ;; It's just a menu entry.
+ (setq menu (cdr (easy-menu-convert-item menu)))))
+ menu)
;;;###autoload
(defun easy-menu-create-menu (menu-name menu-items)
((eq keyword :help) (setq help arg))
((or (eq keyword :included) (eq keyword :visible))
(setq visible (or arg ''nil)))))
- (if (equal visible ''nil) nil ; Invisible menu entry, return nil.
- (if (and visible (not (easy-menu-always-true visible)))
+ (if (equal visible ''nil)
+ nil ; Invisible menu entry, return nil.
+ (if (and visible (not (easy-menu-always-true-p visible)))
(setq prop (cons :visible (cons visible prop))))
- (if (and enable (not (easy-menu-always-true enable)))
+ (if (and enable (not (easy-menu-always-true-p enable)))
(setq prop (cons :enable (cons enable prop))))
(if filter (setq prop (cons :filter (cons filter prop))))
(if help (setq prop (cons :help (cons help prop))))
(defun easy-menu-do-add-item (menu item &optional before)
(setq item (easy-menu-convert-item item))
- (easy-menu-define-key-intern menu (car item) (cdr item) before))
+ (easy-menu-define-key menu (easy-menu-intern (car item)) (cdr item) before))
(defvar easy-menu-converted-items-table (make-hash-table :test 'equal))
(defun easy-menu-convert-item (item)
- ;; Memoize easy-menu-convert-item-1.
- ;; This makes key-shortcut-caching work a *lot* better when this
- ;; conversion is done from within a filter.
- ;; This also helps when the NAME of the entry is recreated each time:
- ;; since the menu is built and traversed separately, the lookup
- ;; would always fail because the key is `equal' but not `eq'.
+ "Memoize the value returned by `easy-menu-convert-item-1' called on ITEM.
+This makes key-shortcut-caching work a *lot* better when this
+conversion is done from within a filter.
+This also helps when the NAME of the entry is recreated each time:
+since the menu is built and traversed separately, the lookup
+would always fail because the key is `equal' but not `eq'."
(or (gethash item easy-menu-converted-items-table)
(puthash item (easy-menu-convert-item-1 item)
easy-menu-converted-items-table)))
(defun easy-menu-convert-item-1 (item)
- ;; Parse an item description and add the item to a keymap. This is
- ;; the function that is used for item definition by the other easy-menu
- ;; 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.
+ "Parse an item description and convert it to a menu keymap element.
+ITEM defines an item as in `easy-menu-define'."
(let (name command label prop remove help)
(cond
((stringp item) ; An item or separator.
(postfix
(if (< (match-end 1) (match-end 0))
(substring keys (match-end 1))))
- (cmd (intern (substring keys (match-beginning 2)
- (match-end 2)))))
+ (cmd (intern (match-string 2 keys))))
(setq keys (and (or prefix postfix)
(cons prefix postfix)))
(setq keys
(cons cmd keys))))
(setq cache-specified nil))
(if keys (setq prop (cons :keys (cons keys prop)))))
- (if (and visible (not (easy-menu-always-true visible)))
+ (if (and visible (not (easy-menu-always-true-p visible)))
(if (equal visible ''nil)
;; Invisible menu item. Don't insert into keymap.
(setq remove t)
(setq prop (cons :visible (cons visible prop)))))))
- (if (and active (not (easy-menu-always-true active)))
+ (if (and active (not (easy-menu-always-true-p active)))
(setq prop (cons :enable (cons active prop))))
(if (and (or no-name cache-specified)
(or (null cache) (stringp cache) (vectorp cache)))
(setq prop (cons :key-sequence (cons cache prop))))))
(t (error "Invalid menu item in easymenu")))
- (cons name (and (not remove)
- (cons 'menu-item
- (cons label
- (and name
- (cons command prop))))))))
-
-(defun easy-menu-define-key-intern (menu key item &optional before)
- ;; This is the same as easy-menu-define-key, but it interns KEY and
- ;; BEFORE if they are strings.
- (easy-menu-define-key menu (if (stringp key) (intern key) key) item
- (if (stringp before) (intern before) before)))
+ ;; `intern' the name so as to merge multiple entries with the same name.
+ ;; It also makes it easier/possible to lookup/change menu bindings
+ ;; via keymap functions.
+ (cons (easy-menu-intern name)
+ (and (not remove)
+ (cons 'menu-item
+ (cons label
+ (and name
+ (cons command prop))))))))
(defun easy-menu-define-key (menu key item &optional before)
- ;; Add binding in MENU for KEY => ITEM. Similar to `define-key-after'.
- ;; If KEY is not nil then delete any duplications. If ITEM is nil, then
- ;; don't insert, only delete.
- ;; Optional argument BEFORE is nil or a key in MENU. If BEFORE is not nil
- ;; put binding before BEFORE in MENU, otherwise if binding is already
- ;; present in MENU, just change it, otherwise put it last in MENU.
- ;; KEY and BEFORE don't have to be symbols, comparison is done with equal
- ;; not with eq.
+ "Add binding in MENU for KEY => ITEM. Similar to `define-key-after'.
+If KEY is not nil then delete any duplications.
+If ITEM is nil, then delete the definition of KEY.
+
+Optional argument BEFORE is nil or a key in MENU. If BEFORE is not nil,
+put binding before the item in MENU named BEFORE; otherwise,
+if a binding for KEY is already present in MENU, just change it;
+otherwise put the new binding last in MENU.
+BEFORE can be either a string (menu item name) or a symbol
+\(the fake function key for the menu item).
+KEY does not have to be a symbol, and comparison is done with equal."
+ (if (symbolp menu) (setq menu (indirect-function menu)))
(let ((inserted (null item)) ; Fake already inserted.
tail done)
(while (not done)
(cond
((or (setq done (or (null (cdr menu)) (keymapp (cdr menu))))
- (and before (equal (car-safe (cadr menu)) before)))
+ (and before (easy-menu-name-match before (cadr menu))))
;; If key is nil, stop here, otherwise keep going past the
;; inserted element so we can delete any duplications that come
;; later.
(and before ; wanted elsewhere and
(setq tail (cddr menu)) ; not last item and not
(not (keymapp tail))
- (not (equal (car-safe (car tail)) before)))) ; in position
+ (not (easy-menu-name-match
+ before (car tail))))) ; in position
(setcdr menu (cddr menu)) ; Remove item.
(setcdr (cadr menu) item) ; Change item.
(setq inserted t)
(setq menu (cdr menu))))
(t (setq menu (cdr menu)))))))
-(defun easy-menu-always-true (x)
- ;; Return true if X never evaluates to nil.
+(defun easy-menu-name-match (name item)
+ "Return t if NAME is the name of menu item ITEM.
+NAME can be either a string, or a symbol.
+ITEM should be a keymap binding of the form (KEY . MENU-ITEM)."
+ (if (consp item)
+ (if (symbolp name)
+ (eq (car-safe item) name)
+ (if (stringp name)
+ ;; Match against the text that is displayed to the user.
+ (or (condition-case nil (member-ignore-case name item)
+ (error nil)) ;`item' might not be a proper list.
+ ;; Also check the string version of the symbol name,
+ ;; for backwards compatibility.
+ (eq (car-safe item) (intern name)))))))
+
+(defun easy-menu-always-true-p (x)
+ "Return true if form X never evaluates to nil."
(if (consp x) (and (eq (car x) 'quote) (cadr x))
(or (eq x t) (not (symbolp x)))))
(make-symbol (format "menu-function-%d" easy-menu-item-count))))
(setq easy-menu-item-count (1+ easy-menu-item-count))
(fset command
- (if (or (keymapp callback) noexp) callback
+ (if (or (keymapp callback) (functionp callback) noexp) callback
`(lambda () (interactive) ,callback)))
command))
Either call this from `menu-bar-update-hook' or use a menu filter,
to implement dynamic menus."
- (easy-menu-add-item nil path (cons name items) before))
+ (easy-menu-add-item nil path (easy-menu-create-menu name items) before))
;; XEmacs needs the following two functions to add and remove menus.
;; In Emacs this is done automatically when switching keymaps, so
;; here easy-menu-remove is a noop and easy-menu-add only precalculates
;; equivalent keybindings (if easy-menu-precalculate-equivalent-keybindings
;; is on).
-(defun easy-menu-remove (menu))
+(defalias 'easy-menu-remove 'ignore
+ "Remove MENU from the current menu bar.
+Contrary to XEmacs, this is a nop on Emacs since menus are automatically
+\(de)activated when the corresponding keymap is (de)activated.
+
+\(fn MENU)")
(defun easy-menu-add (menu &optional map)
- "Maybe precalculate equivalent key bindings.
-Do it if `easy-menu-precalculate-equivalent-keybindings' is on,"
+ "Add the menu to the menubar.
+On Emacs, menus are already automatically activated when the
+corresponding keymap is activated. On XEmacs this is needed to
+actually add the menu to the current menubar.
+
+This also precalculates equivalent key bindings when
+`easy-menu-precalculate-equivalent-keybindings' is on.
+
+You should call this once the menu and keybindings are set up
+completely and menu filter functions can be expected to work."
(when easy-menu-precalculate-equivalent-keybindings
(if (and (symbolp menu) (not (keymapp menu)) (boundp menu))
(setq menu (symbol-value menu)))
- (if (keymapp menu) (x-popup-menu nil menu))))
+ (and (keymapp menu) (fboundp 'x-popup-menu)
+ (x-popup-menu nil menu))
+ ))
+
+(defun add-submenu (menu-path submenu &optional before in-menu)
+ "Add submenu SUBMENU in the menu at MENU-PATH.
+If BEFORE is non-nil, add before the item named BEFORE.
+If IN-MENU is non-nil, follow MENU-PATH in IN-MENU.
+This is a compatibility function; use `easy-menu-add-item'."
+ (easy-menu-add-item (or in-menu (current-global-map))
+ (cons "menu-bar" menu-path)
+ submenu before))
(defun easy-menu-add-item (map path item &optional before)
"To the submenu of MAP with path PATH, add ITEM.
However, if BEFORE is a string and there is an item in the submenu
with that name, then ITEM is added before that item.
-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.
It can also be a symbol, which has earlier been used as the first
argument in a call to `easy-menu-define', or the value of such a symbol.
(if (and (consp item) (consp (cdr item)) (eq (cadr item) 'menu-item))
;; This is a value returned by `easy-menu-item-present-p' or
;; `easy-menu-remove-item'.
- (easy-menu-define-key-intern map (car item) (cdr item) before)
+ (easy-menu-define-key map (easy-menu-intern (car item))
+ (cdr item) before)
(if (or (keymapp item)
- (and (symbolp item) (keymapp (symbol-value item))))
+ (and (symbolp item) (keymapp (symbol-value item))
+ (setq item (symbol-value item))))
;; Item is a keymap, find the prompt string and use as item name.
- (let ((tail (easy-menu-get-map item nil)) name)
- (if (not (keymapp item)) (setq item tail))
- (while (and (null name) (consp (setq tail (cdr tail)))
- (not (keymapp tail)))
- (if (stringp (car tail)) (setq name (car tail)) ; Got a name.
- (setq tail (cdr tail))))
- (setq item (cons name item))))
+ (setq item (cons (keymap-prompt item) item)))
(easy-menu-do-add-item map item before)))
(defun easy-menu-item-present-p (map path name)
- "In submenu of MAP with path PATH, return true iff item NAME is present.
+ "In submenu of MAP with path PATH, return non-nil iff item NAME is present.
MAP and PATH are defined as in `easy-menu-add-item'.
NAME should be a string, the name of the element to be looked for."
(easy-menu-return-item (easy-menu-get-map map path) name))
NAME should be a string, the name of the element to be removed."
(setq map (easy-menu-get-map map path))
(let ((ret (easy-menu-return-item map name)))
- (if ret (easy-menu-define-key-intern map name nil))
+ (if ret (easy-menu-define-key map (easy-menu-intern name) nil))
ret))
(defun easy-menu-return-item (menu name)
- ;; In menu MENU try to look for menu item with name NAME.
- ;; If a menu item is found, return (NAME . item), otherwise return nil.
- ;; If item is an old format item, a new format item is returned.
- (let ((item (lookup-key menu (vector (intern name))))
+ "In menu MENU try to look for menu item with name NAME.
+If a menu item is found, return (NAME . item), otherwise return nil.
+If item is an old format item, a new format item is returned."
+ ;; The call to `lookup-key' also calls the C function `get_keyelt' which
+ ;; looks inside a menu-item to only return the actual command. This is
+ ;; not what we want here. We should either add an arg to lookup-key to be
+ ;; able to turn off this "feature", or else we could use map-keymap here.
+ ;; In the mean time, I just use `assq' which is an OK approximation since
+ ;; menus are rarely built from vectors or char-tables.
+ (let ((item (or (cdr (assq name menu))
+ (lookup-key menu (vector (easy-menu-intern name)))))
ret enable cache label)
(cond
- ((or (keymapp item) (eq (car-safe item) 'menu-item))
- (cons name item)) ; Keymap or new menu format
((stringp (car-safe item))
;; This is the old menu format. Convert it to new format.
(setq label (car item))
(and (symbolp item) (setq enable (get item 'menu-enable)) ; Got enable
(setq ret (cons :enable (cons enable ret))))
(if cache (setq ret (cons cache ret)))
- (cons name (cons 'menu-enable (cons label (cons item ret))))))))
-
-(defun easy-menu-get-map-look-for-name (name submap)
- (while (and submap (not (or (equal (car-safe (cdr-safe (car submap))) name)
- (equal (car-safe (cdr-safe (cdr-safe (car submap)))) name))))
- (setq submap (cdr submap)))
- submap)
+ (cons name (cons 'menu-enable (cons label (cons item ret)))))
+ (item ; (or (symbolp item) (keymapp item) (eq (car-safe item) 'menu-item))
+ (cons name item)) ; Keymap or new menu format
+ )))
+
+(defun easy-menu-lookup-name (map name)
+ "Lookup menu item NAME in keymap MAP.
+Like `lookup-key' except that NAME is not an array but just a single key
+and that NAME can be a string representing the menu item's name."
+ (or (lookup-key map (vector (easy-menu-intern name)))
+ (when (stringp name)
+ ;; `lookup-key' failed and we have a menu item name: look at the
+ ;; actual menu entries's names.
+ (catch 'found
+ (map-keymap (lambda (key item)
+ (if (condition-case nil (member name item)
+ (error nil))
+ ;; Found it!! Look for it again with
+ ;; `lookup-key' so as to handle inheritance and
+ ;; to extract the actual command/keymap bound to
+ ;; `name' from the item (via get_keyelt).
+ (throw 'found (lookup-key map (vector key)))))
+ map)))))
(defun easy-menu-get-map (map path &optional to-modify)
- ;; Return a sparse keymap in which to add or remove an item.
- ;; MAP and PATH are as defined in `easy-menu-add-item'.
-
- ;; TO-MODIFY, if non-nil, is the name of the item the caller
- ;; wants to modify in the map that we return.
- ;; In some cases we use that to select between the local and global maps.
- (if (null map)
- (let ((local (and (current-local-map)
- (lookup-key (current-local-map)
- (vconcat '(menu-bar) (mapcar 'intern path)))))
- (global (lookup-key global-map
- (vconcat '(menu-bar) (mapcar 'intern path)))))
- (cond ((and to-modify local (not (integerp local))
- (easy-menu-get-map-look-for-name to-modify local))
- (setq map local))
- ((and to-modify global (not (integerp global))
- (easy-menu-get-map-look-for-name to-modify global))
- (setq map global))
- ((and local local (not (integerp local)))
- (setq map local))
- ((and global (not (integerp global)))
- (setq map global))
- (t
- (setq map (make-sparse-keymap))
- (define-key (current-local-map)
- (vconcat '(menu-bar) (mapcar 'intern path)) map))))
- (if (and (symbolp map) (not (keymapp map)))
- (setq map (symbol-value map)))
- (if path (setq map (lookup-key map (vconcat (mapcar 'intern path))))))
- (while (and (symbolp map) (keymapp map))
- (setq map (symbol-function map)))
- (unless map
- (error "Menu specified in easy-menu is not defined"))
+ "Return a sparse keymap in which to add or remove an item.
+MAP and PATH are as defined in `easy-menu-add-item'.
+
+TO-MODIFY, if non-nil, is the name of the item the caller
+wants to modify in the map that we return.
+In some cases we use that to select between the local and global maps."
+ (setq map
+ (catch 'found
+ (if (and map (symbolp map) (not (keymapp map)))
+ (setq map (symbol-value map)))
+ (let ((maps (if map (list map) (current-active-maps))))
+ ;; Look for PATH in each map.
+ (unless map (push 'menu-bar path))
+ (dolist (name path)
+ (setq maps
+ (delq nil (mapcar (lambda (map)
+ (setq map (easy-menu-lookup-name
+ map name))
+ (and (keymapp map) map))
+ maps))))
+
+ ;; Prefer a map that already contains the to-be-modified entry.
+ (when to-modify
+ (dolist (map maps)
+ (when (easy-menu-lookup-name map to-modify)
+ (throw 'found map))))
+ ;; Use the first valid map.
+ (when maps (throw 'found (car maps)))
+
+ ;; Otherwise, make one up.
+ ;; Hardcoding current-local-map is lame, but it's difficult
+ ;; to know what the caller intended for us to do ;-(
+ (let* ((name (if path (format "%s" (car (reverse path)))))
+ (newmap (make-sparse-keymap name)))
+ (define-key (or map (current-local-map))
+ (apply 'vector (mapcar 'easy-menu-intern path))
+ (if name (cons name newmap) newmap))
+ newmap))))
(or (keymapp map) (error "Malformed menu in easy-menu: (%s)" map))
map)
(provide 'easymenu)
+;; arch-tag: 2a04020d-90d2-476d-a7c6-71e072007a4a
;;; easymenu.el ends here