Mercurial > emacs
comparison lisp/emacs-lisp/easymenu.el @ 57966:13661731eef0
(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.
| author | Stefan Monnier <monnier@iro.umontreal.ca> |
|---|---|
| date | Sat, 06 Nov 2004 10:01:56 +0000 |
| parents | 4e4baf7bbf77 |
| children | 3141e565abf7 |
comparison
equal
deleted
inserted
replaced
| 57965:9b14127a651a | 57966:13661731eef0 |
|---|---|
| 240 ((eq keyword :help) (setq help arg)) | 240 ((eq keyword :help) (setq help arg)) |
| 241 ((or (eq keyword :included) (eq keyword :visible)) | 241 ((or (eq keyword :included) (eq keyword :visible)) |
| 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)))) |
| 251 (if label (setq prop (cons nil (cons label prop)))) | 251 (if label (setq prop (cons nil (cons label prop)))) |
| 252 (if filter | 252 (if filter |
| 361 (setq keys | 361 (setq keys |
| 362 (and (or keys (not (eq command cmd))) | 362 (and (or keys (not (eq command cmd))) |
| 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))) |
| 375 (setq prop (cons :key-sequence (cons cache prop)))))) | 375 (setq prop (cons :key-sequence (cons cache prop)))))) |
| 376 (t (error "Invalid menu item in easymenu"))) | 376 (t (error "Invalid menu item in easymenu"))) |
| 424 (setq menu (cdr menu)))) | 424 (setq menu (cdr menu)))) |
| 425 (t (setq menu (cdr menu))))))) | 425 (t (setq menu (cdr menu))))))) |
| 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) |
| 433 (if (stringp name) | 434 (if (stringp name) |
| 434 ;; Match against the text that is displayed to the user. | 435 ;; Match against the text that is displayed to the user. |
| 437 ;; Also check the string version of the symbol name, | 438 ;; Also check the string version of the symbol name, |
| 438 ;; for backwards compatibility. | 439 ;; for backwards compatibility. |
| 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))))) |
| 446 | 447 |
| 447 (defvar easy-menu-item-count 0) | 448 (defvar easy-menu-item-count 0) |
| 589 (cons name (cons 'menu-enable (cons label (cons item ret))))) | 590 (cons name (cons 'menu-enable (cons label (cons item ret))))) |
| 590 (item ; (or (symbolp item) (keymapp item) (eq (car-safe item) 'menu-item)) | 591 (item ; (or (symbolp item) (keymapp item) (eq (car-safe item) 'menu-item)) |
| 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. |
| 601 MAP and PATH are as defined in `easy-menu-add-item'. | 616 MAP and PATH are as defined in `easy-menu-add-item'. |
| 602 | 617 |
| 603 TO-MODIFY, if non-nil, is the name of the item the caller | 618 TO-MODIFY, if non-nil, is the name of the item the caller |
| 604 wants to modify in the map that we return. | 619 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)) |
| 639 map) | 654 map) |
| 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 |