/[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.50.2.6 by miles, Thu Nov 4 13:12:43 2004 UTC revision 1.50.2.7 by miles, Fri Nov 12 04:21:19 2004 UTC
# Line 42  menus, turn this variable off, otherwise Line 42  menus, turn this variable off, otherwise
42    :version "20.3")    :version "20.3")
43    
44  (defsubst easy-menu-intern (s)  (defsubst easy-menu-intern (s)
45    (if (stringp s)    (if (stringp s) (intern s) s))
       (let ((copy (copy-sequence s))  
             (pos 0)  
             found)  
         ;; For each letter that starts a word, flip its case.  
         ;; This way, the usual convention for menu strings (capitalized)  
         ;; corresponds to the usual convention for menu item event types  
         ;; (all lower case).  It's a 1-1 mapping so causes no conflicts.  
         (while (setq found (string-match "\\<\\sw" copy pos))  
           (setq pos (match-end 0))  
           (unless (= (upcase (aref copy found))  
                      (downcase (aref copy found)))  
             (aset copy found  
                   (if (= (upcase (aref copy found))  
                          (aref copy found))  
                       (downcase (aref copy found))  
                     (upcase (aref copy found))))))  
          (intern copy))  
     s))  
46    
47  ;;;###autoload  ;;;###autoload
48  (put 'easy-menu-define 'lisp-indent-function 'defun)  (put 'easy-menu-define 'lisp-indent-function 'defun)
# Line 242  possibly preceded by keyword pairs as de Line 224  possibly preceded by keyword pairs as de
224          (setq visible (or arg ''nil)))))          (setq visible (or arg ''nil)))))
225      (if (equal visible ''nil)      (if (equal visible ''nil)
226          nil                             ; Invisible menu entry, return nil.          nil                             ; Invisible menu entry, return nil.
227        (if (and visible (not (easy-menu-always-true visible)))        (if (and visible (not (easy-menu-always-true-p visible)))
228            (setq prop (cons :visible (cons visible prop))))            (setq prop (cons :visible (cons visible prop))))
229        (if (and enable (not (easy-menu-always-true enable)))        (if (and enable (not (easy-menu-always-true-p enable)))
230            (setq prop (cons :enable (cons enable prop))))            (setq prop (cons :enable (cons enable prop))))
231        (if filter (setq prop (cons :filter (cons filter prop))))        (if filter (setq prop (cons :filter (cons filter prop))))
232        (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 345  ITEM defines an item as in `easy-menu-de
345                                    (cons cmd keys))))                                    (cons cmd keys))))
346                     (setq cache-specified nil))                     (setq cache-specified nil))
347                   (if keys (setq prop (cons :keys (cons keys prop)))))                   (if keys (setq prop (cons :keys (cons keys prop)))))
348                (if (and visible (not (easy-menu-always-true visible)))                (if (and visible (not (easy-menu-always-true-p visible)))
349                    (if (equal visible ''nil)                    (if (equal visible ''nil)
350                        ;; Invisible menu item. Don't insert into keymap.                        ;; Invisible menu item. Don't insert into keymap.
351                        (setq remove t)                        (setq remove t)
352                      (setq prop (cons :visible (cons visible prop)))))))                      (setq prop (cons :visible (cons visible prop)))))))
353          (if (and active (not (easy-menu-always-true active)))          (if (and active (not (easy-menu-always-true-p active)))
354              (setq prop (cons :enable (cons active prop))))              (setq prop (cons :enable (cons active prop))))
355          (if (and (or no-name cache-specified)          (if (and (or no-name cache-specified)
356                   (or (null cache) (stringp cache) (vectorp cache)))                   (or (null cache) (stringp cache) (vectorp cache)))
# Line 396  otherwise put the new binding last in ME Line 378  otherwise put the new binding last in ME
378  BEFORE can be either a string (menu item name) or a symbol  BEFORE can be either a string (menu item name) or a symbol
379  \(the fake function key for the menu item).  \(the fake function key for the menu item).
380  KEY does not have to be a symbol, and comparison is done with equal."  KEY does not have to be a symbol, and comparison is done with equal."
381      (if (symbolp menu) (setq menu (indirect-function menu)))
382    (let ((inserted (null item))          ; Fake already inserted.    (let ((inserted (null item))          ; Fake already inserted.
383          tail done)          tail done)
384      (while (not done)      (while (not done)
# Line 426  KEY does not have to be a symbol, and co Line 409  KEY does not have to be a symbol, and co
409    
410  (defun easy-menu-name-match (name item)  (defun easy-menu-name-match (name item)
411    "Return t if NAME is the name of menu item ITEM.    "Return t if NAME is the name of menu item ITEM.
412  NAME can be either a string, or a symbol."  NAME can be either a string, or a symbol.
413    ITEM should be a keymap binding of the form (KEY . MENU-ITEM)."
414    (if (consp item)    (if (consp item)
415        (if (symbolp name)        (if (symbolp name)
416            (eq (car-safe item) name)            (eq (car-safe item) name)
# Line 436  NAME can be either a string, or a symbol Line 420  NAME can be either a string, or a symbol
420                    (error nil))          ;`item' might not be a proper list.                    (error nil))          ;`item' might not be a proper list.
421                  ;; Also check the string version of the symbol name,                  ;; Also check the string version of the symbol name,
422                  ;; for backwards compatibility.                  ;; for backwards compatibility.
423                  (eq (car-safe item) (intern name))                  (eq (car-safe item) (intern name)))))))
                 (eq (car-safe item) (easy-menu-intern name)))))))  
424    
425  (defun easy-menu-always-true (x)  (defun easy-menu-always-true-p (x)
426    "Return true if form X never evaluates to nil."    "Return true if form X never evaluates to nil."
427    (if (consp x) (and (eq (car x) 'quote) (cadr x))    (if (consp x) (and (eq (car x) 'quote) (cadr x))
428      (or (eq x t) (not (symbolp x)))))      (or (eq x t) (not (symbolp x)))))
# Line 540  earlier by `easy-menu-define' or `easy-m Line 523  earlier by `easy-menu-define' or `easy-m
523        (easy-menu-define-key map (easy-menu-intern (car item))        (easy-menu-define-key map (easy-menu-intern (car item))
524                              (cdr item) before)                              (cdr item) before)
525      (if (or (keymapp item)      (if (or (keymapp item)
526              (and (symbolp item) (keymapp (symbol-value item))))              (and (symbolp item) (keymapp (symbol-value item))
527                     (setq item (symbol-value item))))
528          ;; Item is a keymap, find the prompt string and use as item name.          ;; Item is a keymap, find the prompt string and use as item name.
529          (let ((tail (easy-menu-get-map item nil)) name)          (setq item (cons (keymap-prompt item) item)))
           (if (not (keymapp item)) (setq item tail))  
           (while (and (null name) (consp (setq tail (cdr tail)))  
                       (not (keymapp tail)))  
             (if (stringp (car tail)) (setq name (car tail)) ; Got a name.  
               (setq tail (cdr tail))))  
           (setq item (cons name item))))  
530      (easy-menu-do-add-item map item before)))      (easy-menu-do-add-item map item before)))
531    
532  (defun easy-menu-item-present-p (map path name)  (defun easy-menu-item-present-p (map path name)
# Line 591  If item is an old format item, a new for Line 569  If item is an old format item, a new for
569        (cons name item))                 ; Keymap or new menu format        (cons name item))                 ; Keymap or new menu format
570       )))       )))
571    
572  (defun easy-menu-get-map-look-for-name (name submap)  (defun easy-menu-lookup-name (map name)
573    (while (and submap (not (easy-menu-name-match name (car submap))))    "Lookup menu item NAME in keymap MAP.
574      (setq submap (cdr submap)))  Like `lookup-key' except that NAME is not an array but just a single key
575    submap)  and that NAME can be a string representing the menu item's name."
576      (or (lookup-key map (vector (easy-menu-intern name)))
577          (when (stringp name)
578            ;; `lookup-key' failed and we have a menu item name: look at the
579            ;; actual menu entries's names.
580            (catch 'found
581              (map-keymap (lambda (key item)
582                            (if (condition-case nil (member name item)
583                                  (error nil))
584                                ;; Found it!!  Look for it again with
585                                ;; `lookup-key' so as to handle inheritance and
586                                ;; to extract the actual command/keymap bound to
587                                ;; `name' from the item (via get_keyelt).
588                                (throw 'found (lookup-key map (vector key)))))
589                          map)))))
590    
591  (defun easy-menu-get-map (map path &optional to-modify)  (defun easy-menu-get-map (map path &optional to-modify)
592    "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 597  wants to modify in the map that we retur
597  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."
598    (setq map    (setq map
599          (catch 'found          (catch 'found
600            (let* ((key (vconcat (unless map '(menu-bar))            (if (and map (symbolp map) (not (keymapp map)))
601                                 (mapcar 'easy-menu-intern path)))                (setq map (symbol-value map)))
602                   (maps (mapcar (lambda (map)            (let ((maps (if map (list map) (current-active-maps))))
603                                   (setq map (lookup-key map key))              ;; Look for PATH in each map.
604                                   (while (and (symbolp map) (keymapp map))              (unless map (push 'menu-bar path))
605                                     (setq map (symbol-function map)))              (dolist (name path)
606                                   map)                (setq maps
607                                 (if map                      (delq nil (mapcar (lambda (map)
608                                     (list (if (and (symbolp map)                                          (setq map (easy-menu-lookup-name
609                                                    (not (keymapp map)))                                                     map name))
610                                               (symbol-value map) map))                                          (and (keymapp map) map))
611                                   (current-active-maps)))))                                        maps))))
612    
613              ;; Prefer a map that already contains the to-be-modified entry.              ;; Prefer a map that already contains the to-be-modified entry.
614              (when to-modify              (when to-modify
615                (dolist (map maps)                (dolist (map maps)
616                  (when (and (keymapp map)                  (when (easy-menu-lookup-name map to-modify)
                            (easy-menu-get-map-look-for-name to-modify map))  
617                    (throw 'found map))))                    (throw 'found map))))
618              ;; Use the first valid map.              ;; Use the first valid map.
619              (dolist (map maps)              (when maps (throw 'found (car maps)))
620                (when (keymapp map)  
                 (throw 'found map)))  
621              ;; Otherwise, make one up.              ;; Otherwise, make one up.
622              ;; Hardcoding current-local-map is lame, but it's difficult              ;; Hardcoding current-local-map is lame, but it's difficult
623              ;; to know what the caller intended for us to do ;-(              ;; to know what the caller intended for us to do ;-(
624              (let* ((name (if path (format "%s" (car (reverse path)))))              (let* ((name (if path (format "%s" (car (reverse path)))))
625                     (newmap (make-sparse-keymap name)))                     (newmap (make-sparse-keymap name)))
626                (define-key (or map (current-local-map)) key                (define-key (or map (current-local-map))
627                    (apply 'vector (mapcar 'easy-menu-intern path))
628                  (if name (cons name newmap) newmap))                  (if name (cons name newmap) newmap))
629                newmap))))                newmap))))
630    (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 632  In some cases we use that to select betw
632    
633  (provide 'easymenu)  (provide 'easymenu)
634    
635  ;;; arch-tag: 2a04020d-90d2-476d-a7c6-71e072007a4a  ;; arch-tag: 2a04020d-90d2-476d-a7c6-71e072007a4a
636  ;;; easymenu.el ends here  ;;; easymenu.el ends here

Legend:
Removed from v.1.50.2.6  
changed lines
  Added in v.1.50.2.7

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