/[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.46 by monnier, Thu Dec 13 19:03:12 2001 UTC revision 1.47 by rms, Wed Apr 24 23:18:42 2002 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) (intern s) s))    (if (stringp s) (intern (downcase s)) s))
46    
47  ;;;###autoload  ;;;###autoload
48  (put 'easy-menu-define 'lisp-indent-function 'defun)  (put 'easy-menu-define 'lisp-indent-function 'defun)
# Line 243  possibly preceded by keyword pairs as de Line 243  possibly preceded by keyword pairs as de
243    
244  (defun easy-menu-do-add-item (menu item &optional before)  (defun easy-menu-do-add-item (menu item &optional before)
245    (setq item (easy-menu-convert-item item))    (setq item (easy-menu-convert-item item))
246    (easy-menu-define-key-intern menu (car item) (cdr item) before))    (easy-menu-define-key menu (easy-menu-intern (car item)) (cdr item) before))
247    
248  (defvar easy-menu-converted-items-table (make-hash-table :test 'equal))  (defvar easy-menu-converted-items-table (make-hash-table :test 'equal))
249    
# Line 366  MENU, just change it, otherwise put it l Line 366  MENU, just change it, otherwise put it l
366                             (and name                             (and name
367                                  (cons command prop))))))))                                  (cons command prop))))))))
368    
 (defun easy-menu-define-key-intern (menu key item &optional before)  
   "Like easy-menu-define-key, but interns KEY and BEFORE if they are strings."  
   (easy-menu-define-key menu (easy-menu-intern key) item  
                         (easy-menu-intern before)))  
   
369  (defun easy-menu-define-key (menu key item &optional before)  (defun easy-menu-define-key (menu key item &optional before)
370    "Add binding in MENU for KEY => ITEM.  Similar to `define-key-after'.    "Add binding in MENU for KEY => ITEM.  Similar to `define-key-after'.
371  If KEY is not nil then delete any duplications.  If ITEM is nil, then  If KEY is not nil then delete any duplications.
372  don't insert, only delete.  If ITEM is nil, then delete the definition of KEY.
373  Optional argument BEFORE is nil or a key in MENU.  If BEFORE is not nil  
374  put binding before BEFORE in MENU, otherwise if binding is already  Optional argument BEFORE is nil or a key in MENU.  If BEFORE is not nil,
375  present in MENU, just change it, otherwise put it last in MENU.  put binding before the item in MENU named BEFORE; otherwise,
376  KEY and BEFORE don't have to be symbols, comparison is done with equal  if a binding for KEY is already present in MENU, just change it;
377  not with eq."  otherwise put the new binding last in MENU.
378    BEFORE can be either a string (menu item name) or a symbol
379    \(the fake function key for the menu item).
380    KEY does not have to be a symbol, and comparison is done with equal."
381    (let ((inserted (null item))          ; Fake already inserted.    (let ((inserted (null item))          ; Fake already inserted.
382          tail done)          tail done)
383      (while (not done)      (while (not done)
384        (cond        (cond
385         ((or (setq done (or (null (cdr menu)) (keymapp (cdr menu))))         ((or (setq done (or (null (cdr menu)) (keymapp (cdr menu))))
386              (and before (equal (car-safe (cadr menu)) before)))              (and before (easy-menu-name-match before (cadr menu))))
387          ;; If key is nil, stop here, otherwise keep going past the          ;; If key is nil, stop here, otherwise keep going past the
388          ;; inserted element so we can delete any duplications that come          ;; inserted element so we can delete any duplications that come
389          ;; later.          ;; later.
# Line 400  not with eq." Line 398  not with eq."
398                  (and before             ;  wanted elsewhere and                  (and before             ;  wanted elsewhere and
399                       (setq tail (cddr menu)) ; not last item and not                       (setq tail (cddr menu)) ; not last item and not
400                       (not (keymapp tail))                       (not (keymapp tail))
401                       (not (equal (car-safe (car tail)) before)))) ; in position                       (not (easy-menu-name-match
402                               before (car tail))))) ; in position
403              (setcdr menu (cddr menu))   ; Remove item.              (setcdr menu (cddr menu))   ; Remove item.
404            (setcdr (cadr menu) item)     ; Change item.            (setcdr (cadr menu) item)     ; Change item.
405            (setq inserted t)            (setq inserted t)
406            (setq menu (cdr menu))))            (setq menu (cdr menu))))
407         (t (setq menu (cdr menu)))))))         (t (setq menu (cdr menu)))))))
408    
409    (defun easy-menu-name-match (name item)
410      "Return t if NAME is the name of menu item ITEM.
411    NAME can be either a string, or a symbol."
412      (if (consp item)
413          (if (symbolp name)
414              (eq (car-safe item) name)
415            (if (stringp name)
416                (member-ignore-case name item)))))
417    
418  (defun easy-menu-always-true (x)  (defun easy-menu-always-true (x)
419    "Return true if X never evaluates to nil."    "Return true if form X never evaluates to nil."
420    (if (consp x) (and (eq (car x) 'quote) (cadr x))    (if (consp x) (and (eq (car x) 'quote) (cadr x))
421      (or (eq x t) (not (symbolp x)))))      (or (eq x t) (not (symbolp x)))))
422    
# Line 457  Do it if `easy-menu-precalculate-equival Line 465  Do it if `easy-menu-precalculate-equival
465          (setq menu (symbol-value menu)))          (setq menu (symbol-value menu)))
466      (if (keymapp menu) (x-popup-menu nil menu))))      (if (keymapp menu) (x-popup-menu nil menu))))
467    
468    (defun add-submenu (menu-path submenu &optional before in-menu)
469      "Add submenu SUBMENU in the menu at MENU-PATH.
470    If BEFORE is non-nil, add before the item named BEFORE.
471    If IN-MENU is non-nil, follow MENU-PATH in IN-MENU.
472    This is a compatibility function; use `easy-menu-add-item'."
473      (easy-menu-add-item (or in-menu (current-global-map))
474                          (cons "menu-bar" menu-path)
475                          submenu before))
476    
477  (defun easy-menu-add-item (map path item &optional before)  (defun easy-menu-add-item (map path item &optional before)
478    "To the submenu of MAP with path PATH, add ITEM.    "To the submenu of MAP with path PATH, add ITEM.
479    
# Line 485  earlier by `easy-menu-define' or `easy-m Line 502  earlier by `easy-menu-define' or `easy-m
502    (if (and (consp item) (consp (cdr item)) (eq (cadr item) 'menu-item))    (if (and (consp item) (consp (cdr item)) (eq (cadr item) 'menu-item))
503        ;; This is a value returned by `easy-menu-item-present-p' or        ;; This is a value returned by `easy-menu-item-present-p' or
504        ;; `easy-menu-remove-item'.        ;; `easy-menu-remove-item'.
505        (easy-menu-define-key-intern map (car item) (cdr item) before)        (easy-menu-define-key map (easy-menu-intern (car item))
506                                (cdr item) before)
507      (if (or (keymapp item)      (if (or (keymapp item)
508              (and (symbolp item) (keymapp (symbol-value item))))              (and (symbolp item) (keymapp (symbol-value item))))
509          ;; 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.
# Line 510  MAP and PATH are defined as in `easy-men Line 528  MAP and PATH are defined as in `easy-men
528  NAME should be a string, the name of the element to be removed."  NAME should be a string, the name of the element to be removed."
529    (setq map (easy-menu-get-map map path))    (setq map (easy-menu-get-map map path))
530    (let ((ret (easy-menu-return-item map name)))    (let ((ret (easy-menu-return-item map name)))
531      (if ret (easy-menu-define-key-intern map name nil))      (if ret (easy-menu-define-key map (easy-menu-intern name) nil))
532      ret))      ret))
533    
534  (defun easy-menu-return-item (menu name)  (defun easy-menu-return-item (menu name)
# Line 539  If item is an old format item, a new for Line 557  If item is an old format item, a new for
557       )))       )))
558    
559  (defun easy-menu-get-map-look-for-name (name submap)  (defun easy-menu-get-map-look-for-name (name submap)
560    (while (and submap (not (or (equal (car-safe (cdr-safe (car submap))) name)    (while (and submap (not (easy-menu-name-match name (car submap))))
                               (equal (car-safe (cdr-safe (cdr-safe (car submap)))) name))))  
561      (setq submap (cdr submap)))      (setq submap (cdr submap)))
562    submap)    submap)
563    

Legend:
Removed from v.1.46  
changed lines
  Added in v.1.47

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