X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/89fd3098d88e6e2f41bd56a0629f609f02b6c42f..03deb635e5f09d262b7659c7e7572e62a504d99e:/lisp/emacs-lisp/easymenu.el diff --git a/lisp/emacs-lisp/easymenu.el b/lisp/emacs-lisp/easymenu.el index 045a559069..b0f3b9b9d3 100644 --- a/lisp/emacs-lisp/easymenu.el +++ b/lisp/emacs-lisp/easymenu.el @@ -1,6 +1,6 @@ ;;; easymenu.el --- support the easymenu interface for defining a menu -;; Copyright (C) 1994, 1996, 1998, 1999, 2000 Free Software Foundation, Inc. +;; Copyright (C) 1994,96,98,1999,2000,2004 Free Software Foundation, Inc. ;; Keywords: emulations ;; Author: Richard Stallman @@ -42,23 +42,25 @@ menus, turn this variable off, otherwise it is probably better to keep it on." :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) ;;;###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 @@ -146,7 +148,7 @@ as a solid horizontal line. 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 @@ -156,19 +158,20 @@ A menu item can be a list with the same format as MENU. This is a submenu." ;; 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) + (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 @@ -187,11 +190,15 @@ In Emacs a menu filter must return a menu (a keymap), in XEmacs a filter must 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) @@ -217,9 +224,9 @@ possibly preceded by keyword pairs as described in `easy-menu-define'." (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)))) @@ -259,14 +266,8 @@ would always fail because the key is `equal' but not `eq'." 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. @@ -336,8 +337,7 @@ MENU, just change it, otherwise put it last in MENU." (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 @@ -345,12 +345,12 @@ MENU, just change it, otherwise put it last in MENU." (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))) @@ -378,6 +378,7 @@ 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) @@ -408,18 +409,20 @@ KEY does not have to be a symbol, and comparison is done with equal." (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) (if (stringp name) ;; Match against the text that is displayed to the user. - (or (member-ignore-case name item) + (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 (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))))) @@ -452,22 +455,33 @@ 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 (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). -(defalias 'easy-menu-remove 'ignore) +(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. + "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." (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. @@ -487,7 +501,7 @@ In the latter case, ITEM is normally added at the end of the submenu. 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. @@ -509,15 +523,10 @@ earlier by `easy-menu-define' or `easy-menu-create-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) @@ -560,19 +569,24 @@ If item is an old format item, a new format item is returned." (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) - -;; 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))) +(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. @@ -583,53 +597,40 @@ 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 - (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)) - (easy-menu-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 map (not (integerp 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 (and map (not (integerp 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)) map) -(defun easy-menu-popup-menu (menu &optional event) - "Pop up a menu and run a command according to user's selection. -MENU is a menu description as in `easy-menu-define'. -EVENT is a mouse button event and determines where to pop up the menu. -If EVENT is nil, pop up menu at the current mouse position." - (let ((map (easy-menu-create-menu (car menu) (cdr menu)))) - (if (symbolp map) - (let ((f (memq :filter (get map 'menu-prop)))) - (setq map (symbol-function map)) - (if f (setq map (funcall (cadr f) map))))) - (let* ((sel (x-popup-menu (or event t) map)) - (f (if (consp sel) (lookup-key map (apply 'vector sel))))) - (if (commandp f) (call-interactively f))))) - (provide 'easymenu) +;; arch-tag: 2a04020d-90d2-476d-a7c6-71e072007a4a ;;; easymenu.el ends here