;;; 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:
: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.
(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))
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 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))
(catch 'found
(if (and map (symbolp map) (not (keymapp map)))
(setq map (symbol-value map)))
- (let ((maps (if map (list map) (current-active-maps))))
+ (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)