Download
(defgroup icicles nil
"Minibuffer input completion and cycling of completion candidates."
:prefix "icicle-"
:group 'completion :group 'convenience)
(defvar icicle-menu-items nil
"Alist of menu-items and their corresponding commands.")
(defun icicle-execute-menu-command ()
"Execute a menu-bar menu command.
Type a menu item. Completion is available."
(interactive)
(let* (
(icicle-menu-items-alist (icicle-get-a-menu-item-alist current-menubar))
(menu-item (completing-read "Menu command: " icicle-menu-items-alist))
(cmd (cdr (assoc menu-item icicle-menu-items-alist))))
(cond ((listp cmd) (eval cmd))
((commandp cmd) (command-execute cmd))
((symbolp cmd) (funcall cmd))
(t (error "No such menu command")))))
(defun icicle-get-a-menu-item-alist (menu)
"Alist of pairs (MENU-ITEM . COMMAND) defined by KEYMAP.
KEYMAP is any keymap that has menu items.
MENU-ITEM is a menu item, with ancestor-menu prefixes.
Example: `(\"Files > Insert File...\" . insert-file)'.
COMMAND is the command bound to the menu item."
(setq icicle-menu-items nil)
(icicle-get-a-menu-item-alist-1 menu)
(nreverse icicle-menu-items))
(defun icicle-menu-get-keyword (menu-item keyword &optional defret)
"From MENU-ITEM get KEYWORD value.
If KEYWORD not found DEFRET returned."
(let* ((mi-list (if (listp menu-item) menu-item (append menu-item nil)))
(ckword (car mi-list))
(kw-retval defret))
(while mi-list
(if (eq ckword keyword)
(progn
(setq kw-retval (cadr mi-list))
(setq mi-list nil)))
(setq mi-list (cdr mi-list))
(setq ckword (car mi-list)))
kw-retval))
(defun icicle-menu-remove-keyword (menu-item keyword)
"From MENU-ITEM get KEYWORD value.
If KEYWORD not found DEFRET returned."
(let* ((mi-list (if (listp menu-item) menu-item (append menu-item nil)))
(ckword (car mi-list))
(kw-retval nil))
(while mi-list
(if (not (eq ckword keyword))
(progn
(setq kw-retval (append kw-retval (list ckword)))
(setq mi-list (cdr mi-list))
(setq ckword (car mi-list)))
(setq mi-list (cddr mi-list))
(setq ckword (car mi-list))))
kw-retval))
(defun icicle-get-a-menu-item-alist-1 (menu &optional root)
"Helper function for `icicle-get-a-menu-item-alist'.
This calls itself recursively, to process submenus."
(let ((scan menu))
(setq root (or root))
(while (consp scan)
(let ((defn (car scan))
composite-name)
(when (and (listp defn) (icicle-menu-get-keyword defn :filter))
(when (stringp (car defn))
(setq composite-name (concat root (and root " > ") (car defn)))
(setq composite-name (replace-in-string composite-name "%_" "" composite-name)))
(setq defn (funcall (icicle-menu-get-keyword defn :filter) defn)))
(cond
((vectorp defn)
(let* ((included (eval (icicle-menu-get-keyword defn :included t)))
(active (if included (eval (icicle-menu-get-keyword defn :active t)) nil))
(name (if (not (equal "" (elt defn 0)))
(elt defn 0)
(elt defn (1- (length defn))))))
(if active
(progn
(setq composite-name (concat root (and root " > ") name))
(setq composite-name (replace-in-string composite-name "%_" "" composite-name))
(setq defn (elt defn 1)))))))
(when (listp defn)
(if (stringp (car defn))
(progn
(setq composite-name (concat root (and root " > ") (car defn)))
(setq composite-name (replace-in-string composite-name "%_" "" composite-name))
(if (not (string-match "(Customize)" composite-name))
(icicle-get-a-menu-item-alist-1 (cdr defn) composite-name)))
(icicle-get-a-menu-item-alist-1 defn composite-name)))
(when (and root
(or (and (listp defn)
(not (or (stringp (car defn))
(vectorp (car defn)))))
(commandp defn)
(symbolp defn))
composite-name)
(setq icicle-menu-items
(cons
(cons composite-name
defn)
icicle-menu-items))))
(when (consp scan) (setq scan (cdr scan))))
icicle-menu-items))
(provide 'icicles-menu-xmas)