;;; easymenu.el --- support the easymenu interface for defining a menu
-;; Copyright (C) 1994,96,98,1999,2000,2004 Free Software Foundation, Inc.
+;; Copyright (C) 1994, 1996, 1998, 1999, 2000, 2002, 2003, 2004,
+;; 2005 Free Software Foundation, Inc.
;; Keywords: emulations
;; Author: Richard Stallman <rms@gnu.org>
;; 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:
:version "20.3")
(defsubst easy-menu-intern (s)
- (if (stringp s) (intern (downcase s)) s))
+ (if (stringp s) (intern s) s))
;;;###autoload
(put 'easy-menu-define 'lisp-indent-function 'defun)
: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
(let ((keymap (easy-menu-create-menu (car menu) (cdr menu))))
(when symbol
(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)))))
+ (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 (easy-menu-intern (car menu)))
(cons 'menu-item
(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 (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))))
(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)))
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)
(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."
+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)
(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))
- (eq (car-safe item) (easy-menu-intern name)))))))
+ (eq (car-safe item) (intern name)))))))
-(defun easy-menu-always-true (x)
+(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)))))
(defun easy-menu-add (menu &optional map)
"Add the menu to the menubar.
-This is a nop on Emacs since menus are automatically activated when the
-corresponding keymap is activated. On XEmacs this is needed to actually
-add the menu to the current menubar.
-Maybe precalculate equivalent key bindings.
-Do it only if `easy-menu-precalculate-equivalent-keybindings' is on."
+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)))
(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))
"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 (easy-menu-intern name))))
+ ;; 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
((stringp (car-safe item))
(cons name item)) ; Keymap or new menu format
)))
-(defun easy-menu-get-map-look-for-name (name submap)
- (while (and submap (not (easy-menu-name-match name (car submap))))
- (setq submap (cdr submap)))
- submap)
+(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.
In some cases we use that to select between the local and global maps."
(setq map
(catch 'found
- (let* ((key (vconcat (unless map '(menu-bar))
- (mapcar 'easy-menu-intern path)))
- (maps (mapcar (lambda (map)
- (setq map (lookup-key map key))
- (while (and (symbolp map) (keymapp map))
- (setq map (symbol-function map)))
- map)
- (if map
- (list (if (and (symbolp map)
- (not (keymapp map)))
- (symbol-value map) map))
- (current-active-maps)))))
+ (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 (and (keymapp map)
- (easy-menu-get-map-look-for-name to-modify map))
+ (when (easy-menu-lookup-name map to-modify)
(throw 'found map))))
;; Use the first valid map.
- (dolist (map maps)
- (when (keymapp map)
- (throw 'found 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)) key
+ (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))
(provide 'easymenu)
-;;; arch-tag: 2a04020d-90d2-476d-a7c6-71e072007a4a
+;; arch-tag: 2a04020d-90d2-476d-a7c6-71e072007a4a
;;; easymenu.el ends here