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) |
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 |
|
|
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. |
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 |
|
|
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 |
|
|
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. |
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) |
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 |
|
|