- ;; Return a sparse keymap in which to add or remove an item.
- ;; MAP and PATH are as defined in `easy-menu-add-item'.
-
- ;; TO-MODIFY, if non-nil, is the name of the item the caller
- ;; wants to modify in the map that we return.
- ;; In some cases we use that to select between the local and global maps.
- (if (null map)
- (let ((local (and (current-local-map)
- (lookup-key (current-local-map)
- (vconcat '(menu-bar) (mapcar 'intern path)))))
- (global (lookup-key global-map
- (vconcat '(menu-bar) (mapcar 'intern path)))))
- (cond ((and to-modify local (not (integerp local))
- (easy-menu-get-map-look-for-name to-modify local))
- (setq map local))
- ((and to-modify global (not (integerp global))
- (easy-menu-get-map-look-for-name to-modify global))
- (setq map global))
- ((and local local (not (integerp local)))
- (setq map local))
- ((and global (not (integerp global)))
- (setq map global))
- (t
- (setq map (make-sparse-keymap))
- (define-key (current-local-map)
- (vconcat '(menu-bar) (mapcar 'intern path)) map))))
- (if (and (symbolp map) (not (keymapp map)))
- (setq map (symbol-value map)))
- (if path (setq map (lookup-key map (vconcat (mapcar 'intern path))))))
- (while (and (symbolp map) (keymapp map))
- (setq map (symbol-function map)))
- (unless map
- (error "Menu specified in easy-menu is not defined"))
+ "Return a sparse keymap in which to add or remove an item.
+MAP and PATH are as defined in `easy-menu-add-item'.
+
+TO-MODIFY, if non-nil, is the name of the item the caller
+wants to modify in the map that we return.
+In some cases we use that to select between the local and global maps."
+ (setq map
+ (catch 'found
+ (if (and map (symbolp map) (not (keymapp map)))
+ (setq map (symbol-value map)))
+ (let ((maps (if map (if (keymapp map) (list map) map)
+ (current-active-maps))))
+ ;; Look for PATH in each map.
+ (unless map (push 'menu-bar path))
+ (dolist (name path)
+ (setq maps
+ (delq nil (mapcar (lambda (map)
+ (setq map (easy-menu-lookup-name
+ map name))
+ (and (keymapp map) map))
+ maps))))
+
+ ;; Prefer a map that already contains the to-be-modified entry.
+ (when to-modify
+ (dolist (map maps)
+ (when (easy-menu-lookup-name map to-modify)
+ (throw 'found map))))
+ ;; Use the first valid map.
+ (when maps (throw 'found (car maps)))
+
+ ;; Otherwise, make one up.
+ ;; Hardcoding current-local-map is lame, but it's difficult
+ ;; to know what the caller intended for us to do ;-(
+ (let* ((name (if path (format "%s" (car (reverse path)))))
+ (newmap (make-sparse-keymap name)))
+ (define-key (or map (current-local-map))
+ (apply 'vector (mapcar 'easy-menu-intern path))
+ (if name (cons name newmap) newmap))
+ newmap))))