242 |
(setq visible (or arg ''nil))))) |
(setq visible (or arg ''nil))))) |
243 |
(if (equal visible ''nil) |
(if (equal visible ''nil) |
244 |
nil ; Invisible menu entry, return nil. |
nil ; Invisible menu entry, return nil. |
245 |
(if (and visible (not (easy-menu-always-true visible))) |
(if (and visible (not (easy-menu-always-true-p visible))) |
246 |
(setq prop (cons :visible (cons visible prop)))) |
(setq prop (cons :visible (cons visible prop)))) |
247 |
(if (and enable (not (easy-menu-always-true enable))) |
(if (and enable (not (easy-menu-always-true-p enable))) |
248 |
(setq prop (cons :enable (cons enable prop)))) |
(setq prop (cons :enable (cons enable prop)))) |
249 |
(if filter (setq prop (cons :filter (cons filter prop)))) |
(if filter (setq prop (cons :filter (cons filter prop)))) |
250 |
(if help (setq prop (cons :help (cons help prop)))) |
(if help (setq prop (cons :help (cons help prop)))) |
363 |
(cons cmd keys)))) |
(cons cmd keys)))) |
364 |
(setq cache-specified nil)) |
(setq cache-specified nil)) |
365 |
(if keys (setq prop (cons :keys (cons keys prop))))) |
(if keys (setq prop (cons :keys (cons keys prop))))) |
366 |
(if (and visible (not (easy-menu-always-true visible))) |
(if (and visible (not (easy-menu-always-true-p visible))) |
367 |
(if (equal visible ''nil) |
(if (equal visible ''nil) |
368 |
;; Invisible menu item. Don't insert into keymap. |
;; Invisible menu item. Don't insert into keymap. |
369 |
(setq remove t) |
(setq remove t) |
370 |
(setq prop (cons :visible (cons visible prop))))))) |
(setq prop (cons :visible (cons visible prop))))))) |
371 |
(if (and active (not (easy-menu-always-true active))) |
(if (and active (not (easy-menu-always-true-p active))) |
372 |
(setq prop (cons :enable (cons active prop)))) |
(setq prop (cons :enable (cons active prop)))) |
373 |
(if (and (or no-name cache-specified) |
(if (and (or no-name cache-specified) |
374 |
(or (null cache) (stringp cache) (vectorp cache))) |
(or (null cache) (stringp cache) (vectorp cache))) |
426 |
|
|
427 |
(defun easy-menu-name-match (name item) |
(defun easy-menu-name-match (name item) |
428 |
"Return t if NAME is the name of menu item ITEM. |
"Return t if NAME is the name of menu item ITEM. |
429 |
NAME can be either a string, or a symbol." |
NAME can be either a string, or a symbol. |
430 |
|
ITEM should be a keymap binding of the form (KEY . MENU-ITEM)." |
431 |
(if (consp item) |
(if (consp item) |
432 |
(if (symbolp name) |
(if (symbolp name) |
433 |
(eq (car-safe item) name) |
(eq (car-safe item) name) |
440 |
(eq (car-safe item) (intern name)) |
(eq (car-safe item) (intern name)) |
441 |
(eq (car-safe item) (easy-menu-intern name))))))) |
(eq (car-safe item) (easy-menu-intern name))))))) |
442 |
|
|
443 |
(defun easy-menu-always-true (x) |
(defun easy-menu-always-true-p (x) |
444 |
"Return true if form X never evaluates to nil." |
"Return true if form X never evaluates to nil." |
445 |
(if (consp x) (and (eq (car x) 'quote) (cadr x)) |
(if (consp x) (and (eq (car x) 'quote) (cadr x)) |
446 |
(or (eq x t) (not (symbolp x))))) |
(or (eq x t) (not (symbolp x))))) |
592 |
(cons name item)) ; Keymap or new menu format |
(cons name item)) ; Keymap or new menu format |
593 |
))) |
))) |
594 |
|
|
595 |
(defun easy-menu-get-map-look-for-name (name submap) |
(defun easy-menu-lookup-name (map name) |
596 |
(while (and submap (not (easy-menu-name-match name (car submap)))) |
"Lookup menu item NAME in keymap MAP. |
597 |
(setq submap (cdr submap))) |
Like `lookup-key' except that NAME is not an array but just a single key |
598 |
submap) |
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))))) |
613 |
|
|
614 |
(defun easy-menu-get-map (map path &optional to-modify) |
(defun easy-menu-get-map (map path &optional to-modify) |
615 |
"Return a sparse keymap in which to add or remove an item. |
"Return a sparse keymap in which to add or remove an item. |
620 |
In some cases we use that to select between the local and global maps." |
In some cases we use that to select between the local and global maps." |
621 |
(setq map |
(setq map |
622 |
(catch 'found |
(catch 'found |
623 |
(let* ((key (vconcat (unless map '(menu-bar)) |
(if (and map (symbolp map) (not (keymapp map))) |
624 |
(mapcar 'easy-menu-intern path))) |
(setq map (symbol-value map))) |
625 |
(maps (mapcar (lambda (map) |
(let ((maps (or map (current-active-maps)))) |
626 |
(setq map (lookup-key map key)) |
;; Look for PATH in each map. |
627 |
(while (and (symbolp map) (keymapp map)) |
(unless map (push 'menu-bar path)) |
628 |
(setq map (symbol-function map))) |
(dolist (name path) |
629 |
map) |
(setq maps |
630 |
(if map |
(delq nil (mapcar (lambda (map) |
631 |
(list (if (and (symbolp map) |
(setq map (easy-menu-lookup-name |
632 |
(not (keymapp map))) |
map name)) |
633 |
(symbol-value map) map)) |
(and (keymapp map) map)) |
634 |
(current-active-maps))))) |
maps)))) |
635 |
|
|
636 |
;; Prefer a map that already contains the to-be-modified entry. |
;; Prefer a map that already contains the to-be-modified entry. |
637 |
(when to-modify |
(when to-modify |
638 |
(dolist (map maps) |
(dolist (map maps) |
639 |
(when (and (keymapp map) |
(when (easy-menu-lookup-name map to-modify) |
|
(easy-menu-get-map-look-for-name to-modify map)) |
|
640 |
(throw 'found map)))) |
(throw 'found map)))) |
641 |
;; Use the first valid map. |
;; Use the first valid map. |
642 |
(dolist (map maps) |
(when maps (throw 'found (car maps))) |
643 |
(when (keymapp map) |
|
|
(throw 'found map))) |
|
644 |
;; Otherwise, make one up. |
;; Otherwise, make one up. |
645 |
;; Hardcoding current-local-map is lame, but it's difficult |
;; Hardcoding current-local-map is lame, but it's difficult |
646 |
;; to know what the caller intended for us to do ;-( |
;; to know what the caller intended for us to do ;-( |
647 |
(let* ((name (if path (format "%s" (car (reverse path))))) |
(let* ((name (if path (format "%s" (car (reverse path))))) |
648 |
(newmap (make-sparse-keymap name))) |
(newmap (make-sparse-keymap name))) |
649 |
(define-key (or map (current-local-map)) key |
(define-key (or map (current-local-map)) |
650 |
|
(apply 'vector (mapcar 'easy-menu-intern path)) |
651 |
(if name (cons name newmap) newmap)) |
(if name (cons name newmap) newmap)) |
652 |
newmap)))) |
newmap)))) |
653 |
(or (keymapp map) (error "Malformed menu in easy-menu: (%s)" map)) |
(or (keymapp map) (error "Malformed menu in easy-menu: (%s)" map)) |
655 |
|
|
656 |
(provide 'easymenu) |
(provide 'easymenu) |
657 |
|
|
658 |
;;; arch-tag: 2a04020d-90d2-476d-a7c6-71e072007a4a |
;; arch-tag: 2a04020d-90d2-476d-a7c6-71e072007a4a |
659 |
;;; easymenu.el ends here |
;;; easymenu.el ends here |