;;; 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, 2001, 2002, 2003,
+;; 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
;; Keywords: emulations
;; Author: Richard Stallman <rms@gnu.org>
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; 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
,(if symbol `(defvar ,symbol nil ,doc))
(easy-menu-do-define (quote ,symbol) ,maps ,doc ,menu)))
+(defun easy-menu-binding (menu &optional item-name)
+ "Return a binding suitable to pass to `define-key'.
+This is expected to be bound to a mouse event."
+ ;; Under Emacs this is almost trivial, whereas under XEmacs this may
+ ;; involve defining a function that calls popup-menu.
+ (let ((props (if (symbolp menu)
+ (prog1 (get menu 'menu-prop)
+ (setq menu (symbol-function menu))))))
+ (cons 'menu-item
+ (cons (or item-name
+ (if (keymapp menu)
+ (keymap-prompt menu))
+ "")
+ (cons menu props)))))
+
;;;###autoload
(defun easy-menu-do-define (symbol maps doc menu)
;; We can't do anything that might differ between Emacs dialects in
(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)))))
- (mapcar (lambda (map)
- (define-key map (vector 'menu-bar (easy-menu-intern (car menu)))
- (cons 'menu-item
- (cons (car menu)
- (if (not (symbolp keymap))
- (list keymap)
- (cons (symbol-function keymap)
- (get keymap 'menu-prop)))))))
- (if (keymapp maps) (list maps) maps))))
+ (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)))))
+ (dolist (map (if (keymapp maps) (list maps) maps))
+ (define-key map
+ (vector 'menu-bar (easy-menu-intern (car menu)))
+ (easy-menu-binding keymap (car menu))))))
(defun easy-menu-filter-return (menu &optional name)
"Convert MENU to the right thing to return from a menu filter.
(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))))
(defvar easy-menu-button-prefix
'((radio . :radio) (toggle . :toggle)))
-(defun easy-menu-do-add-item (menu item &optional before)
- (setq item (easy-menu-convert-item item))
- (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)
(defun easy-menu-convert-item-1 (item)
"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)
+ (let (name command label prop remove)
(cond
((stringp item) ; An item or separator.
(setq label item))
(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)))))
command))
;;;###autoload
-(defun easy-menu-change (path name items &optional before)
+(defun easy-menu-change (path name items &optional before map)
"Change menu found at PATH as item NAME to contain ITEMS.
PATH is a list of strings for locating the menu that
should contain a submenu named NAME.
ITEMS is a list of menu items, as in `easy-menu-define'.
These items entirely replace the previous items in that submenu.
+If MAP is specified, it 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 the menu located by PATH has no submenu named NAME, add one.
If the optional argument BEFORE is present, add it just before
the submenu named BEFORE, otherwise add it at the end of the menu.
-Either call this from `menu-bar-update-hook' or use a menu filter,
-to implement dynamic menus."
- (easy-menu-add-item nil path (easy-menu-create-menu name items) before))
+To implement dynamic menus, either call this from
+`menu-bar-update-hook' or use a menu filter."
+ (easy-menu-add-item map 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
(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))))
- (easy-menu-do-add-item map item before)))
+ (setq item (cons (keymap-prompt item) item)))
+ (setq item (easy-menu-convert-item item))
+ (easy-menu-define-key map (easy-menu-intern (car item)) (cdr 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 if 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 (if (keymapp map) (list map) 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