New org capture template
[emacs.git] / .emacs.d / elisp / icicle / lacarte.el
1 ;;; lacarte.el --- Execute menu items as commands, with completion.
2 ;;
3 ;; Filename: lacarte.el
4 ;; Description: Execute menu items as commands, with completion.
5 ;; Author: Drew Adams
6 ;; Maintainer: Drew Adams (concat "drew.adams" "@" "oracle" ".com")
7 ;; Copyright (C) 2005-2014, Drew Adams, all rights reserved.
8 ;; Created: Fri Aug 12 17:18:02 2005
9 ;; Version: 0
10 ;; Package-Requires: ()
11 ;; Last-Updated: Sat Feb 1 12:44:20 2014 (-0800)
12 ;; By: dradams
13 ;; Update #: 915
14 ;; URL: http://www.emacswiki.org/lacarte.el
15 ;; Doc URL: http://www.emacswiki.org/LaCarte
16 ;; Keywords: menu-bar, menu, command, help, abbrev, minibuffer, keys,
17 ;; completion, matching, local, internal, extensions,
18 ;; Compatibility: GNU Emacs: 20.x, 21.x, 22.x, 23.x, 24.x
19 ;;
20 ;; Features that might be required by this library:
21 ;;
22 ;; None
23 ;;
24 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
25 ;;
26 ;;; Commentary:
27 ;;
28 ;; Q. When is a menu not a menu? A. When it's a la carte.
29 ;;
30 ;; Library La Carte lets you execute menu items as commands, with
31 ;; completion. You can use it as an alternative to standard library
32 ;; `tmm.el'.
33 ;;
34 ;; Type a menu item. Completion is available. Completion candidates
35 ;; are of the form menu > submenu > subsubmenu > ... > menu item.
36 ;; For example:
37 ;;
38 ;; File > Open Recent > Cleanup list
39 ;; File > Open Recent > Edit list...
40 ;;
41 ;; When you choose a menu-item candidate, the corresponding command
42 ;; is executed.
43 ;;
44 ;; Put this in your init file (~/.emacs):
45 ;;
46 ;; (require 'lacarte)
47 ;;
48 ;; Suggested key bindings:
49 ;;
50 ;; (global-set-key [?\e ?\M-x] 'lacarte-execute-command)
51 ;; (global-set-key [?\M-`] 'lacarte-execute-menu-command)
52 ;; (global-set-key [f10] 'lacarte-execute-menu-command)
53 ;;
54 ;; (The latter two replace standard bindings for `tmm-menubar'. On
55 ;; MS Windows, `f10' is normally bound to `menu-bar-open', which uses
56 ;; the Windows native keyboard access to menus.)
57 ;;
58 ;; To really take advantage of La Carte, use it together with
59 ;; Icicles. Icicles is not required to be able to use La Carte, but
60 ;; it enhances the functionality of `lacarte.el' considerably.
61 ;; (Note: `lacarte.el' was originally called `icicles-menu.el'.)
62 ;;
63 ;; If you use MS Windows keyboard accelerators, consider using
64 ;; `lacarte-remove-w32-keybd-accelerators' as the value of
65 ;; `lacarte-convert-menu-item-function'. It removes any unescaped
66 ;; `&' characters (indicating an accelerator) from the menu items.
67 ;; One library that adds keyboard accelerators to your menu items is
68 ;; `menuacc.el', by Lennart Borgman (< l e n n a r t . b o r g m a n
69 ;; @ g m a i l . c o m >).
70 ;;
71 ;;
72 ;; Commands defined here:
73 ;;
74 ;; `lacarte-execute-command', `lacarte-execute-menu-command'.
75 ;;
76 ;; User options defined here:
77 ;;
78 ;; `lacarte-convert-menu-item-function'.
79 ;;
80 ;; Faces defined here:
81 ;;
82 ;; `lacarte-shortcut'.
83 ;;
84 ;; Non-interactive functions defined here:
85 ;;
86 ;; `lacarte-add-if-menu-item', `lacarte-escape-w32-accel',
87 ;; `lacarte-get-a-menu-item-alist',
88 ;; `lacarte-get-a-menu-item-alist-1',
89 ;; `lacarte-get-a-menu-item-alist-22+',
90 ;; `lacarte-get-a-menu-item-alist-pre-22',
91 ;; `lacarte-get-overall-menu-item-alist',
92 ;; `lacarte-key-description', `lacarte-menu-first-p',
93 ;; `lacarte-propertize', `lacarte-remove-w32-keybd-accelerators',
94 ;; `lacarte-string-match-p'.
95 ;;
96 ;; Internal variables defined here:
97 ;;
98 ;; `lacarte-history', `lacarte-menu-items-alist'.
99 ;;
100 ;;
101 ;; Getting Started
102 ;; ---------------
103 ;;
104 ;; In your init file (`~/.emacs'), bind `ESC M-x' as suggested above:
105 ;;
106 ;; (global-set-key [?\e ?\M-x] 'lacarte-execute-command)
107 ;;
108 ;; Type `ESC M-x' (or `ESC ESC x', which is the same thing). You are
109 ;; prompted for a command or menu command to execute. Just start
110 ;; typing its name. Each menu item's full name, for completion, has
111 ;; its parent menu names as prefixes.
112 ;;
113 ;; ESC M-x
114 ;; Command:
115 ;; Command: t [TAB]
116 ;; Command: Tools >
117 ;; Command: Tools > Compa [TAB]
118 ;; Command: Tools > Compare (Ediff) > Two F [TAB]
119 ;; Command: Tools > Compare (Ediff) > Two Files... [RET]
120 ;;
121 ;;
122 ;; Not Just for Wimps and Noobs Anymore
123 ;; ------------------------------------
124 ;;
125 ;; *You* don't use menus. Nah, they're too slow! Only newbies and
126 ;; wimps use menus. Well not any more. Use the keyboard to access
127 ;; any menu item, without knowing where it is or what its full name
128 ;; is. Type just part of its name and use completion to get the
129 ;; rest: the complete path and item name.
130 ;;
131 ;;
132 ;; Commands and Menu Commands
133 ;; --------------------------
134 ;;
135 ;; You can bind either `lacarte-execute-menu-command' or
136 ;; `lacarte-execute-command' to a key such as `ESC M-x'.
137 ;;
138 ;; `lacarte-execute-menu-command' uses only menu commands.
139 ;; `lacarte-execute-command' lets you choose among ordinary Emacs
140 ;; commands, in addition to menu commands. You can use a prefix arg
141 ;; with `lacarte-execute-command' to get the same effect as
142 ;; `lacarte-execute-menu-command'.
143 ;;
144 ;; Use `lacarte-execute-command' if you don't care whether a command
145 ;; is on a menu. Then, if you want a command that affects a buffer,
146 ;; just type `buf'. This is especially useful if you use Icicles -
147 ;; see below.
148 ;;
149 ;; You can use a prefix arg with `lacarte-execute-menu-command' to
150 ;; have it offer only items from specific keymaps: the local (major
151 ;; mode) keymap, the global keymap, or the minor-mode keymaps.
152 ;;
153 ;; By default, in Icicle mode, `ESC M-x' is bound to
154 ;; `lacarte-execute-command', and `M-`' is bound to
155 ;; `lacarte-execute-menu-command'.
156 ;;
157 ;;
158 ;; Icicles Enhances Dining A La Carte
159 ;; ----------------------------------
160 ;;
161 ;; Use Icicles with La Carte to get more power and convenience.
162 ;;
163 ;; It is Icicles that lets you choose menu items a la carte, in fact.
164 ;; That is, you can access them directly, wherever they might be in
165 ;; the menu hierachy. Without Icicles, you are limited to choosing
166 ;; items by their menu-hierarchy prefixes, and you must complete the
167 ;; entire menu prefix to the item, from the top of the menu on down.
168 ;; With Icicles, you can directly match any parts of a menu item and
169 ;; its hierarchy path. Icicles is here:
170 ;; http://www.emacswiki.org/cgi-bin/wiki/Icicles.
171 ;;
172 ;; Type any part of a menu-item, then use the Page Up and Page Down
173 ;; keys (`prior' and `next') to cycle through all menu commands that
174 ;; contain the text you typed somewhere in their name. You can match
175 ;; within any menu or within all menus; that is, you can match any
176 ;; part(s) of the menu-hierachy prefix.
177 ;;
178 ;; You can use `S-TAB' to show and choose from all such "apropos
179 ;; completions", just as you normally use `TAB' to show all prefix
180 ;; completions (that is, ordinary completions). Vanilla, prefix
181 ;; completion is still available using `TAB', and you can cycle
182 ;; through the prefix completions using the arrow keys.
183 ;;
184 ;; You can use Icicles "progressive completion" to match multiple
185 ;; parts of a menu item separately, in any order. For example, if
186 ;; you want a menu command that has to do with buffers and
187 ;; highlighting, type `buf M-SPC hig S-TAB'.
188 ;;
189 ;; Icicles apropos completion also lets you type a regular expression
190 ;; (regexp) - it is matched against all of the possible menu items.
191 ;; So, for instance, you could type `^e.+buff [next] [next]...' to
192 ;; quickly cycle to menu command `Edit > Go To > Goto End of Buffer'.
193 ;; Or type `.*print.*buf S-TAB' to choose from the list of all menu
194 ;; commands that match `print' followed somewhere by `buf'.
195 ;;
196 ;; If you know how to use regexps, you can easily and quickly get to
197 ;; a menu command you want, or at least narrow the list of candidates
198 ;; for completion and cycling.
199 ;;
200 ;; Additional benefits of using Icicles with La Carte:
201 ;;
202 ;; * When you cycle to a candidate menu item, or you complete to one
203 ;; (entirely), the Emacs command associated with the menu item is
204 ;; shown in the mode line of buffer `*Completions*'.
205 ;;
206 ;; * You can use `M-h' to complete your minibuffer input against
207 ;; commands, including menu-item commands, that you have entered
208 ;; previously. You can also use the standard history keys
209 ;; (e.g. `M-p', `M-r') to access these commands.
210 ;;
211 ;;
212 ;; Menu Organization Helps You Find a Command
213 ;; ------------------------------------------
214 ;;
215 ;; Unlike commands listed in a flat `*Apropos*' page, menu items are
216 ;; organized, grouped logically by common area of application
217 ;; (`File', `Edit',...). This grouping is also available when
218 ;; cycling completion candidates using Icicles, and you can take
219 ;; advantage of it to hasten your search for the right command.
220 ;;
221 ;; You want to execute a command that puts the cursor at the end of a
222 ;; buffer, but you don't remember its name, what menu it might be a
223 ;; part of, or where it might appear in that (possibly complex) menu.
224 ;; With Icicles and La Carte, you type `ESC M-x' and then type
225 ;; `buffer' at the prompt. You use the Page Up and Page Down keys to
226 ;; cycle through all menu items that contain the word `buffer'.
227 ;;
228 ;; There are lots of such menu items. But all items from the same
229 ;; menu (e.g. `File') are grouped together. You cycle quickly (not
230 ;; reading) to the `Edit' menu, because you guess that moving the
231 ;; cursor has more to do with editing than with file operations, tool
232 ;; use, buffer choice, help, etc. Then you cycle more slowly among
233 ;; the `buffer' menu items in the `Edit' menu. You quickly find
234 ;; `Edit > Go To > Goto End of Buffer'. QED.
235 ;;
236 ;;
237 ;; Learn About Menu Items By Exploring Them
238 ;; ----------------------------------------
239 ;;
240 ;; With Icicles, you can display the complete documentation (doc
241 ;; string) for the command corresponding to each menu item, as the
242 ;; item appears in the minibuffer. To do this, just cycle menu-item
243 ;; candidates using `C-down' or `C-next', instead of `[down]' or
244 ;; `[next]'. The documentation appears in buffer `*Help*'.
245 ;;
246 ;; In sum, if you use La Carte, you will want to use it with Icicles!
247
248 ;;(@> "Index")
249 ;;
250 ;; If you have library `linkd.el' and Emacs 22 or later, load
251 ;; `linkd.el' and turn on `linkd-mode' now. It lets you easily
252 ;; navigate around the sections of this doc. Linkd mode will
253 ;; highlight this Index, as well as the cross-references and section
254 ;; headings throughout this file. You can get `linkd.el' here:
255 ;; http://dto.freeshell.org/notebook/Linkd.html.
256 ;;
257 ;; (@> "Change log")
258 ;; (@> "User Options")
259 ;; (@> "Internal Variables")
260 ;; (@> "Functions")
261
262 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
263 ;;
264 ;;; Change Log:
265 ;;
266 ;;(@* "Change log")
267 ;;
268 ;; 2014/02/01 dadams
269 ;; Added: lacarte-key-description, lacarte-propertize, face lacarte-shortcut.
270 ;; lacarte-add-if-menu-item, lacarte-get-a-menu-item-alist-pre-22:
271 ;; Use lacarte-key-description, not key-description. Use face lacarte-shortcut for key shortcuts.
272 ;; lacarte-execute-command: Stop icicle-special-candidate-regexp at ?\000 char (before key shortcut).
273 ;; lacarte-add-if-menu-item: Add ?\000 char before key shortcut (so not highlighted by Icicles).
274 ;; 2013/07/09 dadams
275 ;; Updated for recent Emacs versions. Corrections.
276 ;; Added: lacarte-add-if-menu-item,lacarte-get-a-menu-item-alist-22+,
277 ;; lacarte-get-a-menu-item-alist-pre-22.
278 ;; lacarte-get-a-menu-item-alist-1: defalias to one of lacarte-get-a-menu-item-alist-*22*.
279 ;; lacarte-execute(-menu)-command: Run menu-bar-update-hook.
280 ;; lacarte-get-overall-menu-item-alist: Simplified.
281 ;; lacarte-get-a-menu-item-alist-pre-22: Set composite-name to nil when should not add item.
282 ;; Removed handling of nested keymap (irrelevant for pre-22).
283 ;; 2013/07/08 dadams
284 ;; lacarte-get-overall-menu-item-alist: Protect using (lookup-key ... [menu-bar]).
285 ;; 2013/07/04 dadams
286 ;; lacarte-get-a-menu-item-alist-1:
287 ;; After recursing on nested keymap, set SCAN to its cdr. Thx to Michael Heerdegen.
288 ;; 2013/06/14 dadams
289 ;; lacarte-get-a-menu-item-alist-1: Corrected - was cdring twice for atomic car scan.
290 ;; 2012/10/28 dadams
291 ;; lacarte-get-a-menu-item-alist-1:
292 ;; Handle Emacs 24+ nested keymap (from multiple-keymap inheritance).
293 ;; 2012/10/15 dadams
294 ;; lacarte-get-a-menu-item-alist-1: Add entry for separator form (menu-item "--..." . WHATEVER).
295 ;; 2012/09/14 dadams
296 ;; lacarte-execute-menu-command, lacarte-get-overall-menu-item-alist:
297 ;; Added prefix arg treatment (arg MAPS), so you can choose keymaps.
298 ;; 2012/09/13 dadams
299 ;; Added: lacarte-string-match-p.
300 ;; lacarte-get-overall-menu-item-alist: Use lookup-key, not assq.
301 ;; lacarte-execute-command: Prepend dotted cons, not two-elt list, for lacarte-menu-first-p entry.
302 ;; lacarte-menu-first-p: Corrected to sort alphabetically in menus and non-menus.
303 ;; 2011/11/28 dadams
304 ;; lacarte-get-a-menu-item-alist-1:
305 ;; Added optional DONE arg, to handle recursive structures. Thx to Michael Heerdegen.
306 ;; 2011/10/30 dadams
307 ;; lacarte-get-a-menu-item-alist-1:
308 ;; Add keys using internal-where-is, not cached key string. Thx to Michael Heerdegen.
309 ;; 2011/01/04 dadams
310 ;; Added autoload cookies for defgroup, defcustom, and commands.
311 ;; 2010/06/26 dadams
312 ;; lacarte-execute-command: Protected Icicles vars with boundp. Thx to Alexey Romanov.
313 ;; 2010/05/11 dadams
314 ;; lacarte-get-a-menu-item-alist-1: Add keyboard shortcuts to item names.
315 ;; Applied Icicles renamings (belatedly):
316 ;; icicle-sort-functions-alist to icicle-sort-orders-alist,
317 ;; icicle-sort-function to icicle-sort-comparer.
318 ;; 2009/12/25 dadams
319 ;; Added: lacarte-execute-command, lacarte-menu-first-p.
320 ;; lacarte-get-a-menu-item-alist-1: Handle :filter (e.g. File > Open Recent submenus).
321 ;; lacarte-execute-menu-command:
322 ;; Just let-bind lacarte-menu-items-alist - don't use unwind-protect.
323 ;; lacarte-get-overall-menu-item-alist: Reset lacarte-menu-items-alist to nil.
324 ;; lacarte-get-a-menu-item-alist: Set to the return value.
325 ;; 2009/07/29 dadams
326 ;; Added: lacarte-history.
327 ;; lacarte-execute-menu-command:
328 ;; Use lacarte-history as the history list. Use strict completion.
329 ;; 2009/07/26 dadams
330 ;; lacarte-execute-menu-command: Use icicle-interactive-history as the history list.
331 ;; 2008/08/28 dadams
332 ;; Renamed from alacarte to lacarte. Confusion with alacarte Ubuntu source package.
333 ;; 2008/05/21 dadams
334 ;; Renamed library icicles-menu.el to alacarte.el.
335 ;; alacarte-execute-menu-command: Case-insensitive completion, by default.
336 ;; 2008/05/20 dadams
337 ;; icicle-get-a-menu-item-alist-1: Don't add non-selectable item to alist.
338 ;; 2006/12/22 dadams
339 ;; icicle-convert-menu-item-function: Use choice as :type, allowing nil.
340 ;; :group 'icicles -> :group 'Icicles.
341 ;; 2006/10/16 dadams
342 ;; icicle-get-overall-menu-item-alist: Include minor-mode keymaps.
343 ;; 2006/03/16 dadams
344 ;; Added to Commentary.
345 ;; 2006/02/18 dadams
346 ;; icicle-execute-menu-command: \s -> \\s. (Thx to dslcustomer-211-74.vivodi.gr.)
347 ;; 2006/01/07 dadams
348 ;; Added :link for sending bug reports.
349 ;; 2006/01/06 dadams
350 ;; Changed defgroup to icicles-menu from icicles.
351 ;; Added :link.
352 ;; 2005/11/08 dadams
353 ;; icicle-execute-menu-command:
354 ;; Reset icicle-menu-items-alist in unwind-protect.
355 ;; Fix for dynamic menus Select and Paste, Buffers, and Frames:
356 ;; Treat special cases of last-command-event.
357 ;; icicle-get-overall-menu-item-alist: setq result of sort.
358 ;; 2005/11/05 dadams
359 ;; Replaced icicle-menu-items with icicle-menu-items-alist (no need for both).
360 ;; icicle-execute-menu-command: Set, don't bind icicle-menu-items-alist.
361 ;; 2005/08/23 dadams
362 ;; icicle-execute-menu-command: renamed alist to icicle-menu-items-alist, so can
363 ;; refer to it unambiguously in icicle-help-on-candidate (in icicles.el).
364 ;; 2005/08/19 dadams
365 ;; Added: icicle-convert-menu-item-function, icicle-remove-w32-keybd-accelerators,
366 ;; icicle-escape-w32-accel.
367 ;;
368 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
369 ;;
370 ;; This program is free software; you can redistribute it and/or modify
371 ;; it under the terms of the GNU General Public License as published by
372 ;; the Free Software Foundation; either version 3, or (at your option)
373 ;; any later version.
374
375 ;; This program is distributed in the hope that it will be useful,
376 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
377 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
378 ;; GNU General Public License for more details.
379
380 ;; You should have received a copy of the GNU General Public License
381 ;; along with this program; see the file COPYING. If not, write to
382 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
383 ;; Floor, Boston, MA 02110-1301, USA.
384 ;;
385 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
386 ;;
387 ;;; Code:
388
389 (unless (fboundp 'replace-regexp-in-string) (require 'subr-21 nil t))
390
391 ;;;;;;;;;;;;;;;;;;;;;;;;;
392
393 ;;(@* "User Options")
394
395 ;;; User Options and Faces ---------------------------------
396
397 ;;;###autoload
398 (defgroup lacarte nil
399 "Execute menu items as commands, with completion."
400 :prefix "lacarte-" :group 'menu
401 :link `(url-link :tag "Send Bug Report"
402 ,(concat "mailto:" "drew.adams" "@" "oracle" ".com?subject=
403 lacarte.el bug: \
404 &body=Describe bug here, starting with `emacs -q'. \
405 Don't forget to mention your Emacs and library versions."))
406 :link '(url-link :tag "Other Libraries by Drew"
407 "http://www.emacswiki.org/cgi-bin/wiki/DrewsElispLibraries")
408 :link '(url-link :tag "Download" "http://www.emacswiki.org/cgi-bin/wiki/lacarte.el")
409 :link '(url-link :tag "Description" "http://www.emacswiki.org/cgi-bin/wiki/LaCarte")
410 :link '(emacs-commentary-link :tag "Commentary" "lacarte.el"))
411
412 ;;;###autoload
413 (defcustom lacarte-convert-menu-item-function nil
414 "*Function to call to convert a menu item.
415 Used by `lacarte-execute-menu-command'. A typical use would be to
416 remove the `&' characters used in MS Windows menus to define keyboard
417 accelerators. See `lacarte-remove-w32-keybd-accelerators'."
418 :type '(choice (const :tag "None" nil) function) :group 'lacarte)
419
420 ;;;###autoload
421 (defface lacarte-shortcut ; Same grays as for `shadow'.
422 '((((background dark)) (:foreground "gray70"))
423 (t (:foreground "gray50")))
424 "*Face used to highlight key binding of menu item `*Completions*'."
425 :group 'Icicles-Completions-Display :group 'faces)
426
427 ;;; Internal Variables -------------------------------------
428
429 (defvar lacarte-history nil "History for menu items read using La Carte completion.")
430
431 ;; This is used also in `icicle-help-on-candidate', which is defined in Icicles
432 ;; (library `icicles-mcmd.el').
433 (defvar lacarte-menu-items-alist nil
434 "Alist of pairs (MENU-ITEM . COMMAND).
435 The pairs are defined by the current local and global keymaps.
436 MENU-ITEM is a menu item, with ancestor-menu prefixes.
437 Example: `(\"Files > Insert File...\" . insert-file)'.
438 COMMAND is the command bound to the menu item.")
439
440 ;;; Functions -------------------------------
441
442 ;;;###autoload
443 (defun lacarte-execute-command (&optional no-commands-p)
444 "Execute a menu-bar menu command or an ordinary command.
445 Type a menu item or a command name. Completion is available.
446 With a prefix arg, only menu items are available.
447 Completion is not case-sensitive. However, if you use Icicles, then
448 you can use `C-A' in the minibuffer to toggle case-sensitivity.
449
450 If you use Icicles, then you can also sort the completion candidates
451 in different ways, using `C-,'. With Icicles, by default menu items
452 are sorted before non-menu commands, and menu items are highlighted
453 using face `icicle-special-candidate'."
454 (interactive "P")
455 (run-hooks 'menu-bar-update-hook)
456 (let ((lacarte-menu-items-alist (lacarte-get-overall-menu-item-alist))
457 (completion-ignore-case t) ; Not case-sensitive, by default.
458 ;; ?\000 prevents the key shortcut from being highlighted with face `icicle-special-candidate'.
459 (icicle-special-candidate-regexp (and (not no-commands-p) ".* > [^?\000]*"))
460 (icicle-sort-orders-alist (and (boundp 'icicle-sort-orders-alist)
461 (if no-commands-p
462 icicle-sort-orders-alist
463 (cons (cons "menu items first" 'lacarte-menu-first-p)
464 icicle-sort-orders-alist))))
465 (icicle-sort-comparer (and (boundp 'icicle-sort-comparer) (if no-commands-p
466 icicle-sort-comparer
467 'lacarte-menu-first-p)))
468 choice cmd)
469 (unless no-commands-p
470 (mapatoms (lambda (symb)
471 (when (commandp symb)
472 (push (cons (symbol-name symb) symb) lacarte-menu-items-alist)))))
473 (setq choice (completing-read (if no-commands-p "Menu command: " "Command: ")
474 lacarte-menu-items-alist nil t nil 'lacarte-history)
475 cmd (cdr (assoc choice lacarte-menu-items-alist)))
476 (unless cmd (error "No such menu command"))
477 ;; Treat special cases of `last-command-event', reconstructing it for
478 ;; menu items that get their meaning from the click itself.
479 (cond ((eq cmd 'menu-bar-select-buffer)
480 (string-match " >\\s-+\\(.+\\)\\s-+\\*?%?\\s-+\\S-*\\s-*$" choice)
481 (setq choice (substring choice (match-beginning 1) (match-end 1)))
482 (when (string-match " \\*?%?" choice)
483 (setq choice (substring choice 0 (match-beginning 0))))
484 (setq last-command-event choice))
485 ((eq cmd 'menu-bar-select-yank)
486 (string-match "Edit > Select and Paste > \\(.*\\)$" choice)
487 (setq last-command-event (substring choice (match-beginning 1) (match-end 1))))
488 ((eq cmd 'menu-bar-select-frame)
489 (string-match " >\\s-[^>]+>\\s-+\\(.+\\)$" choice)
490 (setq choice (substring choice (match-beginning 1) (match-end 1))
491 last-command-event choice)))
492 (call-interactively cmd)))
493
494 ;; Same as `icicle-string-match-p' in `icicles-fn.el'.
495 (if (fboundp 'string-match-p)
496 (defalias 'lacarte-string-match-p 'string-match-p) ; Emacs 23+
497 (defun lacarte-string-match-p (regexp string &optional start)
498 "Like `string-match', but this saves and restores the match data."
499 (save-match-data (string-match regexp string start))))
500
501 (defun lacarte-menu-first-p (s1 s2)
502 "Return non-nil if S1 is a menu item and S2 is not."
503 (if (lacarte-string-match-p " > " s1)
504 (or (not (lacarte-string-match-p " > " s2)) (string-lessp s1 s2))
505 (and (not (lacarte-string-match-p " > " s2)) (string-lessp s1 s2))))
506
507 ;; Same as `icicle-propertize', in `icicles-fn.el'.
508 (defun lacarte-propertize (object &rest properties)
509 "Like `propertize', but for all Emacs versions.
510 If OBJECT is not a string, then use `prin1-to-string' to get a string."
511 (let ((new (if (stringp object) (copy-sequence object) (prin1-to-string object))))
512 (add-text-properties 0 (length new) properties new)
513 new))
514
515 (defun lacarte-key-description (keys &optional prefix angles)
516 "`icicle-key-description', if Icicles is loaded; else `key-description'.
517 `icicle-key-description' removes any angle brackets, unless ANGLES is
518 non-nil."
519 (if (fboundp 'icicle-key-description)
520 (icicle-key-description keys prefix angles)
521 (key-description keys prefix)))
522
523 ;;;###autoload
524 (defun lacarte-execute-menu-command (maps)
525 "Execute a menu-bar menu command.
526 Type a menu item. Completion is available.
527
528 A prefix argument controls which menus are available:
529
530 * None: current major mode, global, and minor-mode keymaps.
531 * Positive (including plain `C-u'): current major mode keymap.
532 * Zero (e.g., `C-0'): current global keymap.
533 * Negative (e.g., `C--'): current minor mode keymaps.
534
535 Completion is not case-sensitive. However, if you use Icicles, then
536 you can use `C-A' in the minibuffer to toggle case-sensitivity.
537 If you use Icicles, then you can also sort the completion candidates
538 in different ways, using `C-,'."
539 (interactive
540 (cond ((not current-prefix-arg) '((local global minor)))
541 ((> (prefix-numeric-value current-prefix-arg) 0) '((local)))
542 ((= (prefix-numeric-value current-prefix-arg) 0) '((global)))
543 ((< (prefix-numeric-value current-prefix-arg) 0) '((minor)))))
544 (run-hooks 'menu-bar-update-hook)
545 (let* ((lacarte-menu-items-alist (lacarte-get-overall-menu-item-alist maps))
546 (completion-ignore-case t) ; Not case-sensitive, by default.
547 (menu-item (completing-read "Menu command: " lacarte-menu-items-alist
548 nil t nil 'lacarte-history))
549 (cmd (cdr (assoc menu-item lacarte-menu-items-alist))))
550 (unless cmd (error "No such menu command"))
551 ;; Treat special cases of `last-command-event', reconstructing it for
552 ;; menu items that get their meaning from the click itself.
553 (cond ((eq cmd 'menu-bar-select-buffer)
554 (string-match " >\\s-+\\(.+\\)\\s-+\\*?%?\\s-+\\S-*\\s-*$"
555 menu-item)
556 (setq menu-item (substring menu-item (match-beginning 1) (match-end 1)))
557 (when (string-match " \\*?%?" menu-item)
558 (setq menu-item (substring menu-item 0 (match-beginning 0))))
559 (setq last-command-event menu-item))
560 ((eq cmd 'menu-bar-select-yank)
561 (string-match "Edit > Select and Paste > \\(.*\\)$" menu-item)
562 (setq last-command-event (substring menu-item (match-beginning 1) (match-end 1))))
563 ((eq cmd 'menu-bar-select-frame)
564 (string-match " >\\s-[^>]+>\\s-+\\(.+\\)$" menu-item)
565 (setq menu-item (substring menu-item (match-beginning 1) (match-end 1))
566 last-command-event menu-item)))
567 (call-interactively cmd)))
568
569 (defun lacarte-get-overall-menu-item-alist (&optional maps)
570 "Alist formed from menu items in current active keymaps.
571 See `lacarte-get-a-menu-item-alist' for the alist structure.
572
573 Optional argument MAPS is a list specifying which keymaps to use: it
574 can contain the symbols `local', `global', and `minor', mean the
575 current local map, current global map, and all current minor maps.
576
577 As a side effect, this function modifies `lacarte-menu-items-alist'
578 temporarily, then resets it to ()."
579 (unless maps (setq maps '(local global minor)))
580 (let* ((lacarte-menu-items-alist lacarte-menu-items-alist)
581 (alist
582 (lacarte-get-a-menu-item-alist ; This modifies `lacarte-menu-items-alist'.
583 (lookup-key
584 (cons 'keymap (append (and (memq 'local maps) (current-local-map))
585 (apply #'append (and (memq 'minor maps) (current-minor-mode-maps)))
586 (and (memq 'global maps) (current-global-map))))
587 [menu-bar]))))
588 alist))
589
590 (defun lacarte-get-a-menu-item-alist (keymap)
591 "Alist of pairs (MENU-ITEM . COMMAND) defined by KEYMAP.
592 KEYMAP is any keymap that has menu items.
593 MENU-ITEM is a menu item, with ancestor-menu prefixes.
594 Example: `(\"Files > Insert File...\" . insert-file)'.
595 COMMAND is the command bound to the menu item.
596 Returns `lacarte-menu-items-alist' which it modifies."
597 (setq lacarte-menu-items-alist ())
598 (lacarte-get-a-menu-item-alist-1 keymap)
599 (setq lacarte-menu-items-alist (nreverse lacarte-menu-items-alist)))
600
601 (defalias 'lacarte-get-a-menu-item-alist-1 (if (fboundp 'map-keymap)
602 'lacarte-get-a-menu-item-alist-22+
603 'lacarte-get-a-menu-item-alist-pre-22))
604
605 (defun lacarte-get-a-menu-item-alist-22+ (keymap &optional root done)
606 "Add menu items for KEYMAP to `lacarte-menu-items-alist'.
607 ROOT is the accumulated part of a menu item so far.
608 DONE is the alist of accumulated completion candidates so far.
609 Returns `lacarte-menu-items-alist', which it modifies."
610 (map-keymap (lambda (event binding) (lacarte-add-if-menu-item event binding root done)) keymap)
611 lacarte-menu-items-alist)
612
613 ;;; Free vars here: ROOT, DONE. Bound in `lacarte-get-a-menu-item-alist'.
614 (defun lacarte-add-if-menu-item (event binding root done)
615 "Update `lacarte-menu-items-alist' to reflect EVENT and its BINDING.
616 ROOT is the accumulated part of a menu item so far.
617 DONE is the alist of accumulated completion candidates so far.
618 Ignore events that do not belong to menu-bar menus."
619 (let ((bndg binding)
620 (composite-name nil))
621 ;; Get REAL-BINDING for the menu item.
622 (cond
623 ;; (menu-item ITEM-STRING): non-selectable item - skip it.
624 ((and (eq 'menu-item (car-safe bndg)) (null (cdr-safe (cdr-safe bndg))))
625 (setq bndg nil)) ; So `keymapp' test, below, fails.
626
627 ;; (ITEM-STRING): non-selectable item - skip it.
628 ((and (stringp (car-safe bndg)) (null (cdr-safe bndg)))
629 (setq bndg nil)) ; So `keymapp' test, below, fails.
630
631 ;; (menu-item "--..." . WHATEVER): separator - skip it.
632 ;; Users can use `easy-menu-define' with an item such as ["--" nil], which produces
633 ;; (menu-item "--" nil)
634 ((and (eq 'menu-item (car-safe bndg))
635 (stringp (car-safe (cdr-safe bndg)))
636 (string-match "\\`--" (car-safe (cdr-safe bndg))))
637 (setq bndg nil))
638
639 ;; (menu-item ITEM-STRING REAL-BINDING . PROPERTIES), with `:filter'
640 ((and (eq 'menu-item (car-safe bndg))
641 (member :filter (cdr (cddr bndg))))
642 (let ((filt (cadr (member :filter (cdr (cddr bndg))))))
643 (setq composite-name
644 (concat root (and root " > ") (eval (cadr bndg))))
645 ;; Used to concat also the cached key, but Emacs abandoned this in Emacs 23.
646 ;; (let ((keys (car-safe (cdr-safe (cdr-safe (cdr-safe bndg))))))
647 ;; (and (consp keys) (stringp (cdr keys)) (cdr keys)))))
648 (setq bndg (if (functionp filt) ; Apply the filter to REAL-BINDING.
649 (funcall filt (car (cddr bndg)))
650 (car (cddr bndg))))))
651
652 ;; (menu-item ITEM-STRING REAL-BINDING . PROPERTIES)
653 ((eq 'menu-item (car-safe bndg))
654 (let ((enable-condition (memq ':enable (cdr-safe (cdr-safe (cdr-safe bndg))))))
655 (if (or (not enable-condition)
656 (condition-case nil ; Don't enable if we can't check the condition.
657 (eval (cadr enable-condition))
658 (error nil)))
659 (progn
660 (setq composite-name (concat root (and root " > ") (eval (cadr bndg))))
661 (setq bndg (car-safe (cdr-safe (cdr-safe bndg)))))
662 (setq bndg nil))))
663
664 ;; (ITEM-STRING . REAL-BINDING) or
665 ;; (ITEM-STRING [HELP-STRING] . REAL-BINDING) or
666 ;; (ITEM-STRING [HELP-STRING] (KEYBD-SHORTCUTS) . REAL-BINDING)
667 ((stringp (car-safe bndg))
668 (setq composite-name (concat root (and root " > ") (eval (car bndg))))
669 (setq bndg (cdr bndg))
670 ;; Skip HELP-STRING
671 (when (stringp (car-safe bndg)) (setq bndg (cdr bndg)))
672 ;; Skip (KEYBD-SHORTCUTS): cached key-equivalence data for menu items.
673 (when (and (consp bndg) (consp (car bndg)))
674 ;; Used to use the cached key, but Emacs abandoned this in Emacs 23.
675 ;; (when (stringp (cdar bndg))
676 ;; (setq composite-name (concat composite-name (cdar bndg))))
677 (setq bndg (cdr bndg)))))
678
679 ;; If REAL-BINDING is a keymap then recurse on it.
680 (when (keymapp bndg)
681 ;; Follow indirections to ultimate symbol naming a command.
682 (while (and (symbolp bndg) (fboundp bndg) (keymapp (symbol-function bndg)))
683 (setq bndg (symbol-function bndg)))
684 (unless (memq bndg done)
685 (if (eq 'keymap (car-safe bndg))
686 (lacarte-get-a-menu-item-alist-1 bndg composite-name (cons bndg done))
687 (lacarte-get-a-menu-item-alist-1 (symbol-function bndg) composite-name (cons bndg done)))))
688
689 ;; Add menu item + command pair to `lacarte-menu-items-alist' alist.
690 ;; Don't add it if `composite-name' is nil - that's a non-selectable item.
691 (when (and root composite-name (not (keymapp bndg)))
692 (setq lacarte-menu-items-alist
693 (cons (cons (concat (if (and (functionp lacarte-convert-menu-item-function)
694 (stringp composite-name)) ; Could be nil
695 (funcall lacarte-convert-menu-item-function composite-name)
696 composite-name)
697 ;; Add key description, if bound to a key.
698 (let ((key (and bndg (where-is-internal bndg nil t))))
699 ;; Hidden ?\000 char to prevent Icicles from highlighting shortcut too.
700 (and key (concat (lacarte-propertize "?\000" 'invisible t)
701 (lacarte-propertize
702 (format " (%s)" (lacarte-key-description key))
703 'face 'lacarte-shortcut)))))
704 bndg)
705 lacarte-menu-items-alist)))))
706
707 (defun lacarte-get-a-menu-item-alist-pre-22 (keymap &optional root done)
708 "Add menu items for KEYMAP to `lacarte-menu-items-alist'.
709 ROOT is the accumulated part of a menu item so far.
710 DONE is the alist of accumulated completion candidates so far.
711 Returns `lacarte-menu-items-alist', which it modifies."
712 (let ((scan keymap)
713 (composite-name nil))
714 (while (consp scan)
715 (if (atom (car scan))
716 (setq scan (cdr scan))
717 (let ((defn (cdr (car scan))))
718 ;; Get REAL-BINDING for the menu item.
719 (cond
720 ;; (menu-item ITEM-STRING): non-selectable item - skip it.
721 ((and (eq 'menu-item (car-safe defn))
722 (null (cdr-safe (cdr-safe defn))))
723 (setq defn nil
724 composite-name nil)) ; So we do not add it.
725
726 ;; (ITEM-STRING): non-selectable item - skip it.
727 ((and (stringp (car-safe defn)) (null (cdr-safe defn)))
728 (setq defn nil
729 composite-name nil)) ; So we do not add it.
730
731 ;; (menu-item "--..." . WHATEVER): separator - skip it.
732 ;; Users can use `easy-menu-define' with an item such as ["--" nil], which produces
733 ;; (menu-item "--" nil)
734 ((and (eq 'menu-item (car-safe defn))
735 (stringp (car-safe (cdr-safe defn)))
736 (string-match "\\`--" (car-safe (cdr-safe defn))))
737 (setq defn nil
738 composite-name nil)) ; So we do not add it.
739
740 ;; (menu-item ITEM-STRING REAL-BINDING . PROPERTIES), with `:filter'
741 ((and (eq 'menu-item (car-safe defn))
742 (member :filter (cdr (cddr defn))))
743 (let ((filt (cadr (member :filter (cdr (cddr defn))))))
744 (setq composite-name (concat root (and root " > ") (eval (cadr defn))))
745 ;; Used to concat also the cached key, but Emacs abandoned this in Emacs 23.
746 ;; (let ((keys (car-safe (cdr-safe (cdr-safe (cdr-safe defn))))))
747 ;; (and (consp keys) (stringp (cdr keys)) (cdr keys)))))
748 (setq defn (if (functionp filt) ; Apply the filter to REAL-BINDING.
749 (funcall filt (car (cddr defn)))
750 (car (cddr defn))))))
751
752 ;; (menu-item ITEM-STRING REAL-BINDING . PROPERTIES)
753 ((eq 'menu-item (car-safe defn))
754 (setq composite-name
755 (concat root (and root " > ") (eval (cadr defn))))
756 ;; Used to concat also the cached key, but Emacs abandoned this in Emacs 23.
757 ;; (let ((keys (car-safe (cdr-safe (cdr-safe (cdr-safe defn))))))
758 ;; (and (consp keys) (stringp (cdr keys)) (cdr keys)))))
759 (setq defn (car (cddr defn))))
760
761 ;; (ITEM-STRING . REAL-BINDING) or
762 ;; (ITEM-STRING [HELP-STRING] (KEYBD-SHORTCUTS) . REAL-BINDING)
763 ((stringp (car-safe defn))
764 (setq composite-name (concat root (and root " > ") (eval (car defn)))
765 defn (cdr defn))
766 ;; Skip HELP-STRING
767 (when (stringp (car-safe defn)) (setq defn (cdr defn)))
768 ;; Skip (KEYBD-SHORTCUTS): cached key-equivalence data for menu items.
769 (when (and (consp defn) (consp (car defn)))
770 ;; Used to use the cached key, but Emacs abandoned this in Emacs 23.
771 ;; (when (stringp (cdar defn))
772 ;; (setq composite-name (concat composite-name (cdar defn))))
773 (setq defn (cdr defn)))))
774
775 ;; If REAL-BINDING is a keymap, then recurse on it.
776 (when (keymapp defn)
777 ;; Follow indirections to ultimate symbol naming a command.
778 (while (and (symbolp defn) (fboundp defn) (keymapp (symbol-function defn)))
779 (setq defn (symbol-function defn)))
780 (unless (memq defn done)
781 (if (eq 'keymap (car-safe defn))
782 (lacarte-get-a-menu-item-alist-1 (cdr defn) composite-name (cons defn done))
783 (lacarte-get-a-menu-item-alist-1 (symbol-function defn)
784 composite-name
785 (cons defn done)))))
786
787 ;; Add menu item + command pair to `lacarte-menu-items-alist' alist.
788 ;; Do not add it if COMPOSITE-NAME is nil - that's a non-selectable item.
789 ;; Do not add it if DEFN is a keymap.
790 (when (and root composite-name (not (keymapp defn)))
791 (setq lacarte-menu-items-alist
792 (cons
793 (cons (concat (if (and (functionp lacarte-convert-menu-item-function)
794 (stringp composite-name)) ; Could be nil
795 (funcall lacarte-convert-menu-item-function composite-name)
796 composite-name)
797 ;; Add key description, if bound to a key.
798 (let ((key (where-is-internal defn nil t)))
799 (and key (lacarte-propertize
800 (format " (%s)" (lacarte-key-description key))
801 'face 'lacarte-shortcut))))
802 defn)
803 lacarte-menu-items-alist))))
804 (when (consp scan) (setq scan (cdr scan)))))
805 lacarte-menu-items-alist))
806
807 (defun lacarte-remove-w32-keybd-accelerators (menu-item)
808 "Remove `&' characters that define keyboard accelerators in MS Windows.
809 \"&&\" is an escaped `&' - it is replaced by a single `&'.
810 This is a candidate value for `lacarte-convert-menu-item-function'."
811 (replace-regexp-in-string "&&?" 'lacarte-escape-w32-accel menu-item))
812
813 (defun lacarte-escape-w32-accel (match-string)
814 "If STRING is \"&&\", then return \"&\". Else return \"\"."
815 (if (> (length match-string) 1) "&" ""))
816
817 ;;;;;;;;;;;;;;;;;;;;;;;
818
819 (provide 'lacarte)
820
821 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
822 ;;; lacarte.el ends here