diff options
| author | Stefan Monnier | 2004-11-06 10:01:56 +0000 |
|---|---|---|
| committer | Stefan Monnier | 2004-11-06 10:01:56 +0000 |
| commit | 242399cd0380fc0ddafd7853a08336d0982e8401 (patch) | |
| tree | 41a687e2b2d68d7b79bf59376d058e4a714c1ece | |
| parent | df470e3b0bd5b8cf6922197dddb69b64816638c2 (diff) | |
| download | emacs-242399cd0380fc0ddafd7853a08336d0982e8401.tar.gz emacs-242399cd0380fc0ddafd7853a08336d0982e8401.zip | |
(easy-menu-get-map-look-for-name): Remove.
(easy-menu-lookup-name): New fun to replace it.
(easy-menu-get-map): Use it to obey menu item names (rather than just
keys) when looking up `path'.
(easy-menu-always-true-p): Rename from easy-menu-always-true.
(easy-menu-convert-item-1): Adjust to new name.
| -rw-r--r-- | lisp/emacs-lisp/easymenu.el | 73 |
1 files changed, 44 insertions, 29 deletions
diff --git a/lisp/emacs-lisp/easymenu.el b/lisp/emacs-lisp/easymenu.el index e039b80aee5..91de4e670f7 100644 --- a/lisp/emacs-lisp/easymenu.el +++ b/lisp/emacs-lisp/easymenu.el | |||
| @@ -242,9 +242,9 @@ possibly preceded by keyword pairs as described in `easy-menu-define'." | |||
| 242 | (setq visible (or arg ''nil))))) | 242 | (setq visible (or arg ''nil))))) |
| 243 | (if (equal visible ''nil) | 243 | (if (equal visible ''nil) |
| 244 | nil ; Invisible menu entry, return nil. | 244 | nil ; Invisible menu entry, return nil. |
| 245 | (if (and visible (not (easy-menu-always-true visible))) | 245 | (if (and visible (not (easy-menu-always-true-p visible))) |
| 246 | (setq prop (cons :visible (cons visible prop)))) | 246 | (setq prop (cons :visible (cons visible prop)))) |
| 247 | (if (and enable (not (easy-menu-always-true enable))) | 247 | (if (and enable (not (easy-menu-always-true-p enable))) |
| 248 | (setq prop (cons :enable (cons enable prop)))) | 248 | (setq prop (cons :enable (cons enable prop)))) |
| 249 | (if filter (setq prop (cons :filter (cons filter prop)))) | 249 | (if filter (setq prop (cons :filter (cons filter prop)))) |
| 250 | (if help (setq prop (cons :help (cons help prop)))) | 250 | (if help (setq prop (cons :help (cons help prop)))) |
| @@ -363,12 +363,12 @@ ITEM defines an item as in `easy-menu-define'." | |||
| 363 | (cons cmd keys)))) | 363 | (cons cmd keys)))) |
| 364 | (setq cache-specified nil)) | 364 | (setq cache-specified nil)) |
| 365 | (if keys (setq prop (cons :keys (cons keys prop))))) | 365 | (if keys (setq prop (cons :keys (cons keys prop))))) |
| 366 | (if (and visible (not (easy-menu-always-true visible))) | 366 | (if (and visible (not (easy-menu-always-true-p visible))) |
| 367 | (if (equal visible ''nil) | 367 | (if (equal visible ''nil) |
| 368 | ;; Invisible menu item. Don't insert into keymap. | 368 | ;; Invisible menu item. Don't insert into keymap. |
| 369 | (setq remove t) | 369 | (setq remove t) |
| 370 | (setq prop (cons :visible (cons visible prop))))))) | 370 | (setq prop (cons :visible (cons visible prop))))))) |
| 371 | (if (and active (not (easy-menu-always-true active))) | 371 | (if (and active (not (easy-menu-always-true-p active))) |
| 372 | (setq prop (cons :enable (cons active prop)))) | 372 | (setq prop (cons :enable (cons active prop)))) |
| 373 | (if (and (or no-name cache-specified) | 373 | (if (and (or no-name cache-specified) |
| 374 | (or (null cache) (stringp cache) (vectorp cache))) | 374 | (or (null cache) (stringp cache) (vectorp cache))) |
| @@ -426,7 +426,8 @@ KEY does not have to be a symbol, and comparison is done with equal." | |||
| 426 | 426 | ||
| 427 | (defun easy-menu-name-match (name item) | 427 | (defun easy-menu-name-match (name item) |
| 428 | "Return t if NAME is the name of menu item ITEM. | 428 | "Return t if NAME is the name of menu item ITEM. |
| 429 | NAME can be either a string, or a symbol." | 429 | NAME can be either a string, or a symbol. |
| 430 | ITEM should be a keymap binding of the form (KEY . MENU-ITEM)." | ||
| 430 | (if (consp item) | 431 | (if (consp item) |
| 431 | (if (symbolp name) | 432 | (if (symbolp name) |
| 432 | (eq (car-safe item) name) | 433 | (eq (car-safe item) name) |
| @@ -439,7 +440,7 @@ NAME can be either a string, or a symbol." | |||
| 439 | (eq (car-safe item) (intern name)) | 440 | (eq (car-safe item) (intern name)) |
| 440 | (eq (car-safe item) (easy-menu-intern name))))))) | 441 | (eq (car-safe item) (easy-menu-intern name))))))) |
| 441 | 442 | ||
| 442 | (defun easy-menu-always-true (x) | 443 | (defun easy-menu-always-true-p (x) |
| 443 | "Return true if form X never evaluates to nil." | 444 | "Return true if form X never evaluates to nil." |
| 444 | (if (consp x) (and (eq (car x) 'quote) (cadr x)) | 445 | (if (consp x) (and (eq (car x) 'quote) (cadr x)) |
| 445 | (or (eq x t) (not (symbolp x))))) | 446 | (or (eq x t) (not (symbolp x))))) |
| @@ -591,10 +592,24 @@ If item is an old format item, a new format item is returned." | |||
| 591 | (cons name item)) ; Keymap or new menu format | 592 | (cons name item)) ; Keymap or new menu format |
| 592 | ))) | 593 | ))) |
| 593 | 594 | ||
| 594 | (defun easy-menu-get-map-look-for-name (name submap) | 595 | (defun easy-menu-lookup-name (map name) |
| 595 | (while (and submap (not (easy-menu-name-match name (car submap)))) | 596 | "Lookup menu item NAME in keymap MAP. |
| 596 | (setq submap (cdr submap))) | 597 | Like `lookup-key' except that NAME is not an array but just a single key |
| 597 | submap) | 598 | and that NAME can be a string representing the menu item's name." |
| 599 | (or (lookup-key map (vector (easy-menu-intern name))) | ||
| 600 | (when (stringp name) | ||
| 601 | ;; `lookup-key' failed and we have a menu item name: look at the | ||
| 602 | ;; actual menu entries's names. | ||
| 603 | (catch 'found | ||
| 604 | (map-keymap (lambda (key item) | ||
| 605 | (if (condition-case nil (member name item) | ||
| 606 | (error nil)) | ||
| 607 | ;; Found it!! Look for it again with | ||
| 608 | ;; `lookup-key' so as to handle inheritance and | ||
| 609 | ;; to extract the actual command/keymap bound to | ||
| 610 | ;; `name' from the item (via get_keyelt). | ||
| 611 | (throw 'found (lookup-key map (vector key))))) | ||
| 612 | map))))) | ||
| 598 | 613 | ||
| 599 | (defun easy-menu-get-map (map path &optional to-modify) | 614 | (defun easy-menu-get-map (map path &optional to-modify) |
| 600 | "Return a sparse keymap in which to add or remove an item. | 615 | "Return a sparse keymap in which to add or remove an item. |
| @@ -605,34 +620,34 @@ wants to modify in the map that we return. | |||
| 605 | In some cases we use that to select between the local and global maps." | 620 | In some cases we use that to select between the local and global maps." |
| 606 | (setq map | 621 | (setq map |
| 607 | (catch 'found | 622 | (catch 'found |
| 608 | (let* ((key (vconcat (unless map '(menu-bar)) | 623 | (if (and map (symbolp map) (not (keymapp map))) |
| 609 | (mapcar 'easy-menu-intern path))) | 624 | (setq map (symbol-value map))) |
| 610 | (maps (mapcar (lambda (map) | 625 | (let ((maps (or map (current-active-maps)))) |
| 611 | (setq map (lookup-key map key)) | 626 | ;; Look for PATH in each map. |
| 612 | (while (and (symbolp map) (keymapp map)) | 627 | (unless map (push 'menu-bar path)) |
| 613 | (setq map (symbol-function map))) | 628 | (dolist (name path) |
| 614 | map) | 629 | (setq maps |
| 615 | (if map | 630 | (delq nil (mapcar (lambda (map) |
| 616 | (list (if (and (symbolp map) | 631 | (setq map (easy-menu-lookup-name |
| 617 | (not (keymapp map))) | 632 | map name)) |
| 618 | (symbol-value map) map)) | 633 | (and (keymapp map) map)) |
| 619 | (current-active-maps))))) | 634 | maps)))) |
| 635 | |||
| 620 | ;; Prefer a map that already contains the to-be-modified entry. | 636 | ;; Prefer a map that already contains the to-be-modified entry. |
| 621 | (when to-modify | 637 | (when to-modify |
| 622 | (dolist (map maps) | 638 | (dolist (map maps) |
| 623 | (when (and (keymapp map) | 639 | (when (easy-menu-lookup-name map to-modify) |
| 624 | (easy-menu-get-map-look-for-name to-modify map)) | ||
| 625 | (throw 'found map)))) | 640 | (throw 'found map)))) |
| 626 | ;; Use the first valid map. | 641 | ;; Use the first valid map. |
| 627 | (dolist (map maps) | 642 | (when maps (throw 'found (car maps))) |
| 628 | (when (keymapp map) | 643 | |
| 629 | (throw 'found map))) | ||
| 630 | ;; Otherwise, make one up. | 644 | ;; Otherwise, make one up. |
| 631 | ;; Hardcoding current-local-map is lame, but it's difficult | 645 | ;; Hardcoding current-local-map is lame, but it's difficult |
| 632 | ;; to know what the caller intended for us to do ;-( | 646 | ;; to know what the caller intended for us to do ;-( |
| 633 | (let* ((name (if path (format "%s" (car (reverse path))))) | 647 | (let* ((name (if path (format "%s" (car (reverse path))))) |
| 634 | (newmap (make-sparse-keymap name))) | 648 | (newmap (make-sparse-keymap name))) |
| 635 | (define-key (or map (current-local-map)) key | 649 | (define-key (or map (current-local-map)) |
| 650 | (apply 'vector (mapcar 'easy-menu-intern path)) | ||
| 636 | (if name (cons name newmap) newmap)) | 651 | (if name (cons name newmap) newmap)) |
| 637 | newmap)))) | 652 | newmap)))) |
| 638 | (or (keymapp map) (error "Malformed menu in easy-menu: (%s)" map)) | 653 | (or (keymapp map) (error "Malformed menu in easy-menu: (%s)" map)) |
| @@ -640,5 +655,5 @@ In some cases we use that to select between the local and global maps." | |||
| 640 | 655 | ||
| 641 | (provide 'easymenu) | 656 | (provide 'easymenu) |
| 642 | 657 | ||
| 643 | ;;; arch-tag: 2a04020d-90d2-476d-a7c6-71e072007a4a | 658 | ;; arch-tag: 2a04020d-90d2-476d-a7c6-71e072007a4a |
| 644 | ;;; easymenu.el ends here | 659 | ;;; easymenu.el ends here |