diff options
Diffstat (limited to 'lisp/emacs-lisp/easymenu.el')
| -rw-r--r-- | lisp/emacs-lisp/easymenu.el | 112 |
1 files changed, 73 insertions, 39 deletions
diff --git a/lisp/emacs-lisp/easymenu.el b/lisp/emacs-lisp/easymenu.el index 37083ac800a..ca5151fa984 100644 --- a/lisp/emacs-lisp/easymenu.el +++ b/lisp/emacs-lisp/easymenu.el @@ -116,10 +116,15 @@ whenever this expression's value is non-nil. INCLUDE is an expression; this item is only visible if this expression has a non-nil value. `:included' is an alias for `:visible'. + :label FORM + +FORM is an expression that will be dynamically evaluated and whose +value will be used for the menu entry's text label (the default is NAME). + :suffix FORM FORM is an expression that will be dynamically evaluated and whose -value will be concatenated to the menu entry's NAME. +value will be concatenated to the menu entry's label. :style STYLE @@ -152,6 +157,21 @@ A menu item can be a list with the same format as MENU. This is a submenu." ,(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 @@ -173,15 +193,10 @@ A menu item can be a list with the same format as MENU. This is a submenu." '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)))) + (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. @@ -201,12 +216,18 @@ If NAME is provided, it is used for the keymap." (setq menu (cdr (easy-menu-convert-item menu))))) menu) +(defvar easy-menu-avoid-duplicate-keys t + "Dynamically scoped var to register already used keys in a menu. +If it holds a list, this is expected to be a list of keys already seen in the +menu we're processing. Else it means we're not processing a menu.") + ;;;###autoload (defun easy-menu-create-menu (menu-name menu-items) "Create a menu called MENU-NAME with items described in MENU-ITEMS. MENU-NAME is a string, the name of the menu. MENU-ITEMS is a list of items possibly preceded by keyword pairs as described in `easy-menu-define'." (let ((menu (make-sparse-keymap menu-name)) + (easy-menu-avoid-duplicate-keys nil) prop keyword arg label enable filter visible help) ;; Look for keywords. (while (and menu-items @@ -249,10 +270,6 @@ possibly preceded by keyword pairs as described in `easy-menu-define'." (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) @@ -269,7 +286,7 @@ would always fail because the key is `equal' but not `eq'." (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)) @@ -330,22 +347,22 @@ ITEM defines an item as in `easy-menu-define'." (setq prop (cons :button (cons (cons (cdr style) selected) prop))))) (when (stringp keys) - (if (string-match "^[^\\]*\\(\\\\\\[\\([^]]+\\)]\\)[^\\]*$" - keys) - (let ((prefix - (if (< (match-beginning 0) (match-beginning 1)) - (substring keys 0 (match-beginning 1)))) - (postfix - (if (< (match-end 1) (match-end 0)) - (substring keys (match-end 1)))) - (cmd (intern (match-string 2 keys)))) - (setq keys (and (or prefix postfix) - (cons prefix postfix))) - (setq keys - (and (or keys (not (eq command cmd))) - (cons cmd keys)))) - (setq cache-specified nil)) - (if keys (setq prop (cons :keys (cons keys prop))))) + (if (string-match "^[^\\]*\\(\\\\\\[\\([^]]+\\)]\\)[^\\]*$" + keys) + (let ((prefix + (if (< (match-beginning 0) (match-beginning 1)) + (substring keys 0 (match-beginning 1)))) + (postfix + (if (< (match-end 1) (match-end 0)) + (substring keys (match-end 1)))) + (cmd (intern (match-string 2 keys)))) + (setq keys (and (or prefix postfix) + (cons prefix postfix))) + (setq keys + (and (or keys (not (eq command cmd))) + (cons cmd keys)))) + (setq cache-specified nil)) + (if keys (setq prop (cons :keys (cons keys prop))))) (if (and visible (not (easy-menu-always-true-p visible))) (if (equal visible ''nil) ;; Invisible menu item. Don't insert into keymap. @@ -360,12 +377,27 @@ ITEM defines an item as in `easy-menu-define'." ;; `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)))))))) + (let ((key (easy-menu-intern name))) + (when (listp easy-menu-avoid-duplicate-keys) + ;; Merging multiple entries with the same name is sometimes what we + ;; want, but not when the entries are actually different (e.g. same + ;; name but different :suffix as seen in cal-menu.el) and appear in + ;; the same menu. So we try to detect and resolve conflicts. + (while (and (stringp name) + (memq key easy-menu-avoid-duplicate-keys)) + ;; We need to use some distinct object, ideally a symbol, ideally + ;; related to the `name'. Uninterned symbols do not work (they + ;; are apparently turned into strings and re-interned later on). + (setq key (intern (format "%s (%d)" (symbol-name key) + (length easy-menu-avoid-duplicate-keys))))) + (push key easy-menu-avoid-duplicate-keys)) + + (cons key + (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'. @@ -536,7 +568,8 @@ earlier by `easy-menu-define' or `easy-menu-create-menu'." (setq item (symbol-value item)))) ;; Item is a keymap, find the prompt string and use as item name. (setq item (cons (keymap-prompt item) item))) - (easy-menu-do-add-item map item before))) + (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 non-nil if item NAME is present. @@ -615,7 +648,8 @@ In some cases we use that to select between the local and global maps." (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) |