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