aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2004-11-06 10:01:56 +0000
committerStefan Monnier2004-11-06 10:01:56 +0000
commit242399cd0380fc0ddafd7853a08336d0982e8401 (patch)
tree41a687e2b2d68d7b79bf59376d058e4a714c1ece
parentdf470e3b0bd5b8cf6922197dddb69b64816638c2 (diff)
downloademacs-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.el73
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.
429NAME can be either a string, or a symbol." 429NAME can be either a string, or a symbol.
430ITEM 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))) 597Like `lookup-key' except that NAME is not an array but just a single key
597 submap) 598and 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.
605In some cases we use that to select between the local and global maps." 620In 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