diff options
| -rw-r--r-- | lisp/emacs-lisp/easymenu.el | 59 |
1 files changed, 38 insertions, 21 deletions
diff --git a/lisp/emacs-lisp/easymenu.el b/lisp/emacs-lisp/easymenu.el index fe4a44e833d..51b2c3b91e4 100644 --- a/lisp/emacs-lisp/easymenu.el +++ b/lisp/emacs-lisp/easymenu.el | |||
| @@ -42,7 +42,7 @@ menus, turn this variable off, otherwise it is probably better to keep it on." | |||
| 42 | :version "20.3") | 42 | :version "20.3") |
| 43 | 43 | ||
| 44 | (defsubst easy-menu-intern (s) | 44 | (defsubst easy-menu-intern (s) |
| 45 | (if (stringp s) (intern s) s)) | 45 | (if (stringp s) (intern (downcase s)) s)) |
| 46 | 46 | ||
| 47 | ;;;###autoload | 47 | ;;;###autoload |
| 48 | (put 'easy-menu-define 'lisp-indent-function 'defun) | 48 | (put 'easy-menu-define 'lisp-indent-function 'defun) |
| @@ -243,7 +243,7 @@ possibly preceded by keyword pairs as described in `easy-menu-define'." | |||
| 243 | 243 | ||
| 244 | (defun easy-menu-do-add-item (menu item &optional before) | 244 | (defun easy-menu-do-add-item (menu item &optional before) |
| 245 | (setq item (easy-menu-convert-item item)) | 245 | (setq item (easy-menu-convert-item item)) |
| 246 | (easy-menu-define-key-intern menu (car item) (cdr item) before)) | 246 | (easy-menu-define-key menu (easy-menu-intern (car item)) (cdr item) before)) |
| 247 | 247 | ||
| 248 | (defvar easy-menu-converted-items-table (make-hash-table :test 'equal)) | 248 | (defvar easy-menu-converted-items-table (make-hash-table :test 'equal)) |
| 249 | 249 | ||
| @@ -366,26 +366,24 @@ MENU, just change it, otherwise put it last in MENU." | |||
| 366 | (and name | 366 | (and name |
| 367 | (cons command prop)))))))) | 367 | (cons command prop)))))))) |
| 368 | 368 | ||
| 369 | (defun easy-menu-define-key-intern (menu key item &optional before) | ||
| 370 | "Like easy-menu-define-key, but interns KEY and BEFORE if they are strings." | ||
| 371 | (easy-menu-define-key menu (easy-menu-intern key) item | ||
| 372 | (easy-menu-intern before))) | ||
| 373 | |||
| 374 | (defun easy-menu-define-key (menu key item &optional before) | 369 | (defun easy-menu-define-key (menu key item &optional before) |
| 375 | "Add binding in MENU for KEY => ITEM. Similar to `define-key-after'. | 370 | "Add binding in MENU for KEY => ITEM. Similar to `define-key-after'. |
| 376 | If KEY is not nil then delete any duplications. If ITEM is nil, then | 371 | If KEY is not nil then delete any duplications. |
| 377 | don't insert, only delete. | 372 | If ITEM is nil, then delete the definition of KEY. |
| 378 | Optional argument BEFORE is nil or a key in MENU. If BEFORE is not nil | 373 | |
| 379 | put binding before BEFORE in MENU, otherwise if binding is already | 374 | Optional argument BEFORE is nil or a key in MENU. If BEFORE is not nil, |
| 380 | present in MENU, just change it, otherwise put it last in MENU. | 375 | put binding before the item in MENU named BEFORE; otherwise, |
| 381 | KEY and BEFORE don't have to be symbols, comparison is done with equal | 376 | if a binding for KEY is already present in MENU, just change it; |
| 382 | not with eq." | 377 | 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." | ||
| 383 | (let ((inserted (null item)) ; Fake already inserted. | 381 | (let ((inserted (null item)) ; Fake already inserted. |
| 384 | tail done) | 382 | tail done) |
| 385 | (while (not done) | 383 | (while (not done) |
| 386 | (cond | 384 | (cond |
| 387 | ((or (setq done (or (null (cdr menu)) (keymapp (cdr menu)))) | 385 | ((or (setq done (or (null (cdr menu)) (keymapp (cdr menu)))) |
| 388 | (and before (equal (car-safe (cadr menu)) before))) | 386 | (and before (easy-menu-name-match before (cadr menu)))) |
| 389 | ;; If key is nil, stop here, otherwise keep going past the | 387 | ;; If key is nil, stop here, otherwise keep going past the |
| 390 | ;; inserted element so we can delete any duplications that come | 388 | ;; inserted element so we can delete any duplications that come |
| 391 | ;; later. | 389 | ;; later. |
| @@ -400,15 +398,25 @@ not with eq." | |||
| 400 | (and before ; wanted elsewhere and | 398 | (and before ; wanted elsewhere and |
| 401 | (setq tail (cddr menu)) ; not last item and not | 399 | (setq tail (cddr menu)) ; not last item and not |
| 402 | (not (keymapp tail)) | 400 | (not (keymapp tail)) |
| 403 | (not (equal (car-safe (car tail)) before)))) ; in position | 401 | (not (easy-menu-name-match |
| 402 | before (car tail))))) ; in position | ||
| 404 | (setcdr menu (cddr menu)) ; Remove item. | 403 | (setcdr menu (cddr menu)) ; Remove item. |
| 405 | (setcdr (cadr menu) item) ; Change item. | 404 | (setcdr (cadr menu) item) ; Change item. |
| 406 | (setq inserted t) | 405 | (setq inserted t) |
| 407 | (setq menu (cdr menu)))) | 406 | (setq menu (cdr menu)))) |
| 408 | (t (setq menu (cdr menu))))))) | 407 | (t (setq menu (cdr menu))))))) |
| 409 | 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 | |||
| 410 | (defun easy-menu-always-true (x) | 418 | (defun easy-menu-always-true (x) |
| 411 | "Return true if X never evaluates to nil." | 419 | "Return true if form X never evaluates to nil." |
| 412 | (if (consp x) (and (eq (car x) 'quote) (cadr x)) | 420 | (if (consp x) (and (eq (car x) 'quote) (cadr x)) |
| 413 | (or (eq x t) (not (symbolp x))))) | 421 | (or (eq x t) (not (symbolp x))))) |
| 414 | 422 | ||
| @@ -457,6 +465,15 @@ Do it if `easy-menu-precalculate-equivalent-keybindings' is on," | |||
| 457 | (setq menu (symbol-value menu))) | 465 | (setq menu (symbol-value menu))) |
| 458 | (if (keymapp menu) (x-popup-menu nil menu)))) | 466 | (if (keymapp menu) (x-popup-menu nil menu)))) |
| 459 | 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 | |||
| 460 | (defun easy-menu-add-item (map path item &optional before) | 477 | (defun easy-menu-add-item (map path item &optional before) |
| 461 | "To the submenu of MAP with path PATH, add ITEM. | 478 | "To the submenu of MAP with path PATH, add ITEM. |
| 462 | 479 | ||
| @@ -485,7 +502,8 @@ earlier by `easy-menu-define' or `easy-menu-create-menu'." | |||
| 485 | (if (and (consp item) (consp (cdr item)) (eq (cadr item) 'menu-item)) | 502 | (if (and (consp item) (consp (cdr item)) (eq (cadr item) 'menu-item)) |
| 486 | ;; This is a value returned by `easy-menu-item-present-p' or | 503 | ;; This is a value returned by `easy-menu-item-present-p' or |
| 487 | ;; `easy-menu-remove-item'. | 504 | ;; `easy-menu-remove-item'. |
| 488 | (easy-menu-define-key-intern map (car item) (cdr item) before) | 505 | (easy-menu-define-key map (easy-menu-intern (car item)) |
| 506 | (cdr item) before) | ||
| 489 | (if (or (keymapp item) | 507 | (if (or (keymapp item) |
| 490 | (and (symbolp item) (keymapp (symbol-value item)))) | 508 | (and (symbolp item) (keymapp (symbol-value item)))) |
| 491 | ;; Item is a keymap, find the prompt string and use as item name. | 509 | ;; Item is a keymap, find the prompt string and use as item name. |
| @@ -510,7 +528,7 @@ MAP and PATH are defined as in `easy-menu-add-item'. | |||
| 510 | NAME should be a string, the name of the element to be removed." | 528 | NAME should be a string, the name of the element to be removed." |
| 511 | (setq map (easy-menu-get-map map path)) | 529 | (setq map (easy-menu-get-map map path)) |
| 512 | (let ((ret (easy-menu-return-item map name))) | 530 | (let ((ret (easy-menu-return-item map name))) |
| 513 | (if ret (easy-menu-define-key-intern map name nil)) | 531 | (if ret (easy-menu-define-key map (easy-menu-intern name) nil)) |
| 514 | ret)) | 532 | ret)) |
| 515 | 533 | ||
| 516 | (defun easy-menu-return-item (menu name) | 534 | (defun easy-menu-return-item (menu name) |
| @@ -539,8 +557,7 @@ If item is an old format item, a new format item is returned." | |||
| 539 | ))) | 557 | ))) |
| 540 | 558 | ||
| 541 | (defun easy-menu-get-map-look-for-name (name submap) | 559 | (defun easy-menu-get-map-look-for-name (name submap) |
| 542 | (while (and submap (not (or (equal (car-safe (cdr-safe (car submap))) name) | 560 | (while (and submap (not (easy-menu-name-match name (car submap)))) |
| 543 | (equal (car-safe (cdr-safe (cdr-safe (car submap)))) name)))) | ||
| 544 | (setq submap (cdr submap))) | 561 | (setq submap (cdr submap))) |
| 545 | submap) | 562 | submap) |
| 546 | 563 | ||