/[emacs]/emacs/lisp/emacs-lisp/easymenu.el
ViewVC logotype

Diff of /emacs/lisp/emacs-lisp/easymenu.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.66 by rms, Tue Nov 2 09:26:28 2004 UTC revision 1.67 by monnier, Sat Nov 6 10:01:56 2004 UTC
# Line 242  possibly preceded by keyword pairs as de Line 242  possibly preceded by keyword pairs as de
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))))
# Line 363  ITEM defines an item as in `easy-menu-de Line 363  ITEM defines an item as in `easy-menu-de
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)))
# Line 426  KEY does not have to be a symbol, and co Line 426  KEY does not have to be a symbol, and co
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)
# Line 439  NAME can be either a string, or a symbol Line 440  NAME can be either a string, or a symbol
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)))))
# Line 591  If item is an old format item, a new for Line 592  If item is an old format item, a new for
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.
# Line 605  wants to modify in the map that we retur Line 620  wants to modify in the map that we retur
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))
# Line 640  In some cases we use that to select betw Line 655  In some cases we use that to select betw
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

Legend:
Removed from v.1.66  
changed lines
  Added in v.1.67

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26