Commit | Line | Data |
---|---|---|
be010748 | 1 | ;;; tmm.el --- text mode access to menu-bar |
20062d6b | 2 | |
97895167 | 3 | ;; Copyright (C) 1994, 1995, 1996, 2000, 2001, 2002 |
0595722b | 4 | ;; Free Software Foundation, Inc. |
20062d6b RS |
5 | |
6 | ;; Author: Ilya Zakharevich <ilya@math.mps.ohio-state.edu> | |
fc225f66 | 7 | ;; Maintainer: FSF |
97895167 | 8 | ;; Keywords: convenience |
20062d6b | 9 | |
d440e474 | 10 | ;; This file is part of GNU Emacs. |
20062d6b RS |
11 | |
12 | ;; GNU Emacs is free software; you can redistribute it and/or modify | |
13 | ;; it under the terms of the GNU General Public License as published by | |
14 | ;; the Free Software Foundation; either version 2, or (at your option) | |
15 | ;; any later version. | |
16 | ||
17 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
20 | ;; GNU General Public License for more details. | |
21 | ||
22 | ;; You should have received a copy of the GNU General Public License | |
b578f267 EN |
23 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
24 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
25 | ;; Boston, MA 02111-1307, USA. | |
20062d6b | 26 | |
b578f267 | 27 | ;;; Commentary: |
20062d6b | 28 | |
97895167 | 29 | ;; This package provides text mode access to the menu bar. |
20062d6b | 30 | |
b578f267 | 31 | ;;; Code: |
20062d6b RS |
32 | |
33 | (require 'electric) | |
20062d6b | 34 | |
4bef9110 SE |
35 | (defgroup tmm nil |
36 | "Text mode access to menu-bar." | |
37 | :prefix "tmm-" | |
38 | :group 'menu) | |
39 | ||
20062d6b RS |
40 | ;;; The following will be localized, added only to pacify the compiler. |
41 | (defvar tmm-short-cuts) | |
fc225f66 | 42 | (defvar tmm-old-mb-map nil) |
20062d6b RS |
43 | (defvar tmm-old-comp-map) |
44 | (defvar tmm-c-prompt) | |
45 | (defvar tmm-km-list) | |
670ce6ea | 46 | (defvar tmm-next-shortcut-digit) |
20062d6b RS |
47 | (defvar tmm-table-undef) |
48 | ||
e6a5c7de | 49 | ;;;###autoload (define-key global-map "\M-`" 'tmm-menubar) |
b46324e6 | 50 | ;;;###autoload (define-key global-map [f10] 'tmm-menubar) |
77cc5db0 | 51 | ;;;###autoload (define-key global-map [menu-bar mouse-1] 'tmm-menubar-mouse) |
afb1835e | 52 | |
20062d6b | 53 | ;;;###autoload |
77cc5db0 | 54 | (defun tmm-menubar (&optional x-position) |
20062d6b | 55 | "Text-mode emulation of looking and choosing from a menubar. |
77cc5db0 RS |
56 | See the documentation for `tmm-prompt'. |
57 | X-POSITION, if non-nil, specifies a horizontal position within the menu bar; | |
58 | we make that menu bar item (the one at that position) the default choice." | |
20062d6b RS |
59 | (interactive) |
60 | (run-hooks 'menu-bar-update-hook) | |
fc225f66 | 61 | ;; Obey menu-bar-final-items; put those items last. |
77cc5db0 RS |
62 | (let ((menu-bar (tmm-get-keybind [menu-bar])) |
63 | menu-bar-item) | |
fc225f66 RS |
64 | (let ((list menu-bar-final-items)) |
65 | (while list | |
66 | (let ((item (car list))) | |
67 | ;; ITEM is the name of an item that we want to put last. | |
68 | ;; Find it in MENU-BAR and move it to the end. | |
69 | (let ((this-one (assq item menu-bar))) | |
70 | (setq menu-bar (append (delq this-one menu-bar) | |
71 | (list this-one))))) | |
72 | (setq list (cdr list)))) | |
77cc5db0 RS |
73 | (if x-position |
74 | (let ((tail menu-bar) | |
75 | this-one | |
76 | (column 0)) | |
77 | (while (and tail (< column x-position)) | |
78 | (setq this-one (car tail)) | |
79 | (if (and (consp (car tail)) | |
80 | (consp (cdr (car tail))) | |
81 | (stringp (nth 1 (car tail)))) | |
82 | (setq column (+ column | |
83 | (length (nth 1 (car tail))) | |
84 | 1))) | |
85 | (setq tail (cdr tail))) | |
86 | (setq menu-bar-item (car this-one)))) | |
87 | (tmm-prompt menu-bar nil menu-bar-item))) | |
88 | ||
8e735883 | 89 | ;;;###autoload |
77cc5db0 RS |
90 | (defun tmm-menubar-mouse (event) |
91 | "Text-mode emulation of looking and choosing from a menubar. | |
92 | This command is used when you click the mouse in the menubar | |
93 | on a console which has no window system but does have a mouse. | |
94 | See the documentation for `tmm-prompt'." | |
95 | (interactive "e") | |
96 | (tmm-menubar (car (posn-x-y (event-start event))))) | |
20062d6b | 97 | |
4bef9110 | 98 | (defcustom tmm-mid-prompt "==>" |
97895167 | 99 | "*String to insert between shortcut and menu item. |
670ce6ea | 100 | If nil, there will be no shortcuts. It should not consist only of spaces, |
4bef9110 SE |
101 | or else the correct item might not be found in the `*Completions*' buffer." |
102 | :type 'string | |
103 | :group 'tmm) | |
20062d6b RS |
104 | |
105 | (defvar tmm-mb-map nil | |
106 | "A place to store minibuffer map.") | |
107 | ||
97895167 | 108 | (defcustom tmm-completion-prompt |
e5ba1eb9 | 109 | "Press PageUp key to reach this buffer from the minibuffer. |
20062d6b | 110 | Alternatively, you can use Up/Down keys (or your History keys) to change |
97895167 | 111 | the item in the minibuffer, and press RET when you are done, or press the |
10fe2d38 | 112 | marked letters to pick up your choice. Type C-g or ESC ESC ESC to cancel. |
20062d6b | 113 | " |
670ce6ea RS |
114 | "*Help text to insert on the top of the completion buffer. |
115 | To save space, you can set this to nil, | |
4bef9110 SE |
116 | in which case the standard introduction text is deleted too." |
117 | :type '(choice string (const nil)) | |
118 | :group 'tmm) | |
670ce6ea | 119 | |
4bef9110 | 120 | (defcustom tmm-shortcut-style '(downcase upcase) |
97895167 PJ |
121 | "*What letters to use as menu shortcuts. |
122 | Must be either one of the symbols `downcase' or `upcase', | |
4bef9110 SE |
123 | or else a list of the two in the order you prefer." |
124 | :type '(choice (const downcase) | |
125 | (const upcase) | |
126 | (repeat (choice (const downcase) (const upcase)))) | |
127 | :group 'tmm) | |
670ce6ea | 128 | |
4bef9110 | 129 | (defcustom tmm-shortcut-words 2 |
670ce6ea | 130 | "*How many successive words to try for shortcuts, nil means all. |
97895167 | 131 | If you use only one of `downcase' or `upcase' for `tmm-shortcut-style', |
4bef9110 SE |
132 | specify nil for this variable." |
133 | :type '(choice integer (const nil)) | |
134 | :group 'tmm) | |
20062d6b RS |
135 | |
136 | ;;;###autoload | |
bdbc7685 | 137 | (defun tmm-prompt (menu &optional in-popup default-item) |
20062d6b | 138 | "Text-mode emulation of calling the bindings in keymap. |
77cc5db0 RS |
139 | Creates a text-mode menu of possible choices. You can access the elements |
140 | in the menu in two ways: | |
141 | *) via history mechanism from minibuffer; | |
20062d6b RS |
142 | *) Or via completion-buffer that is automatically shown. |
143 | The last alternative is currently a hack, you cannot use mouse reliably. | |
bdbc7685 RS |
144 | |
145 | MENU is like the MENU argument to `x-popup-menu': either a | |
146 | keymap or an alist of alists. | |
147 | DEFAULT-ITEM, if non-nil, specifies an initial default choice. | |
148 | Its value should be an event that has a binding in MENU." | |
149 | ;; If the optional argument IN-POPUP is t, | |
150 | ;; then MENU is an alist of elements of the form (STRING . VALUE). | |
151 | ;; That is used for recursive calls only. | |
152 | (let ((gl-str "Menu bar") ;; The menu bar itself is not a menu keymap | |
153 | ; so it doesn't have a name. | |
154 | tmm-km-list out history history-len tmm-table-undef tmm-c-prompt | |
155 | tmm-old-mb-map tmm-old-comp-map tmm-short-cuts | |
156 | chosen-string choice | |
157 | (not-menu (not (keymapp menu)))) | |
20062d6b | 158 | (run-hooks 'activate-menubar-hook) |
bdbc7685 RS |
159 | ;; Compute tmm-km-list from MENU. |
160 | ;; tmm-km-list is an alist of (STRING . MEANING). | |
161 | ;; It has no other elements. | |
162 | ;; The order of elements in tmm-km-list is the order of the menu bar. | |
e07436e1 DL |
163 | (mapc (lambda (elt) |
164 | (if (stringp elt) | |
165 | (setq gl-str elt) | |
166 | (and (listp elt) (tmm-get-keymap elt not-menu)))) | |
bdbc7685 RS |
167 | menu) |
168 | ;; Choose an element of tmm-km-list; put it in choice. | |
169 | (if (and not-menu (= 1 (length tmm-km-list))) | |
170 | ;; If this is the top-level of an x-popup-menu menu, | |
171 | ;; and there is just one pane, choose that one silently. | |
172 | ;; This way we only ask the user one question, | |
173 | ;; for which element of that pane. | |
174 | (setq choice (cdr (car tmm-km-list))) | |
ae3f2f3c RS |
175 | (unless tmm-km-list |
176 | (error "Empty menu reached")) | |
bdbc7685 RS |
177 | (and tmm-km-list |
178 | (let ((index-of-default 0)) | |
179 | (if tmm-mid-prompt | |
180 | (setq tmm-km-list (tmm-add-shortcuts tmm-km-list)) | |
181 | t) | |
182 | ;; Find the default item's index within the menu bar. | |
183 | ;; We use this to decide the initial minibuffer contents | |
184 | ;; and initial history position. | |
185 | (if default-item | |
186 | (let ((tail menu)) | |
187 | (while (and tail | |
188 | (not (eq (car-safe (car tail)) default-item))) | |
189 | ;; Be careful to count only the elements of MENU | |
190 | ;; that actually constitute menu bar items. | |
191 | (if (and (consp (car tail)) | |
d0bca3c9 GM |
192 | (or (stringp (car-safe (cdr (car tail)))) |
193 | (eq (car-safe (cdr (car tail))) 'menu-item))) | |
bdbc7685 RS |
194 | (setq index-of-default (1+ index-of-default))) |
195 | (setq tail (cdr tail))))) | |
196 | (setq history (reverse (mapcar 'car tmm-km-list))) | |
197 | (setq history-len (length history)) | |
198 | (setq history (append history history history history)) | |
199 | (setq tmm-c-prompt (nth (- history-len 1 index-of-default) history)) | |
200 | (add-hook 'minibuffer-setup-hook 'tmm-add-prompt) | |
ca85cf8a RS |
201 | (save-excursion |
202 | (unwind-protect | |
203 | (setq out | |
204 | (completing-read | |
205 | (concat gl-str " (up/down to change, PgUp to menu): ") | |
206 | tmm-km-list nil t nil | |
207 | (cons 'history (- (* 2 history-len) index-of-default)))) | |
208 | (save-excursion | |
209 | (remove-hook 'minibuffer-setup-hook 'tmm-add-prompt) | |
210 | (if (get-buffer "*Completions*") | |
211 | (progn | |
212 | (set-buffer "*Completions*") | |
213 | (use-local-map tmm-old-comp-map) | |
214 | (bury-buffer (current-buffer))))) | |
215 | )))) | |
bdbc7685 RS |
216 | (setq choice (cdr (assoc out tmm-km-list))) |
217 | (and (null choice) | |
218 | (> (length out) (length tmm-c-prompt)) | |
219 | (string= (substring out 0 (length tmm-c-prompt)) tmm-c-prompt) | |
220 | (setq out (substring out (length tmm-c-prompt)) | |
221 | choice (cdr (assoc out tmm-km-list)))) | |
ae3f2f3c | 222 | (and (null choice) out |
bdbc7685 RS |
223 | (setq out (try-completion out tmm-km-list) |
224 | choice (cdr (assoc out tmm-km-list))))) | |
225 | ;; CHOICE is now (STRING . MEANING). Separate the two parts. | |
226 | (setq chosen-string (car choice)) | |
227 | (setq choice (cdr choice)) | |
228 | (cond (in-popup | |
229 | ;; We just did the inner level of a -popup menu. | |
230 | choice) | |
231 | ;; We just did the outer level. Do the inner level now. | |
97895167 | 232 | (not-menu (tmm-prompt choice t)) |
bdbc7685 RS |
233 | ;; We just handled a menu keymap and found another keymap. |
234 | ((keymapp choice) | |
235 | (if (symbolp choice) | |
236 | (setq choice (indirect-function choice))) | |
237 | (condition-case nil | |
238 | (require 'mouse) | |
239 | (error nil)) | |
240 | (condition-case nil | |
241 | (x-popup-menu nil choice) ; Get the shortcuts | |
242 | (error nil)) | |
243 | (tmm-prompt choice)) | |
244 | ;; We just handled a menu keymap and found a command. | |
245 | (choice | |
246 | (if chosen-string | |
3132f319 KH |
247 | (progn |
248 | (setq last-command-event chosen-string) | |
249 | (call-interactively choice)) | |
bdbc7685 | 250 | choice))))) |
20062d6b | 251 | |
20062d6b RS |
252 | (defun tmm-add-shortcuts (list) |
253 | "Adds shortcuts to cars of elements of the list. | |
254 | Takes a list of lists with a string as car, returns list with | |
fc225f66 RS |
255 | shortcuts added to these cars. |
256 | Stores a list of all the shortcuts in the free variable `tmm-short-cuts'." | |
670ce6ea RS |
257 | (let ((tmm-next-shortcut-digit ?0)) |
258 | (mapcar 'tmm-add-one-shortcut (reverse list)))) | |
20062d6b | 259 | |
670ce6ea RS |
260 | (defsubst tmm-add-one-shortcut (elt) |
261 | ;; uses the free vars tmm-next-shortcut-digit and tmm-short-cuts | |
262 | (let* ((str (car elt)) | |
97895167 | 263 | (paren (string-match "(" str)) |
670ce6ea RS |
264 | (pos 0) (word 0) char) |
265 | (catch 'done ; ??? is this slow? | |
266 | (while (and (or (not tmm-shortcut-words) ; no limit on words | |
267 | (< word tmm-shortcut-words)) ; try n words | |
268 | (setq pos (string-match "\\w+" str pos)) ; get next word | |
269 | (not (and paren (> pos paren)))) ; don't go past "(binding.." | |
270 | (if (or (= pos 0) | |
271 | (/= (aref str (1- pos)) ?.)) ; avoid file extensions | |
97895167 | 272 | (let ((shortcut-style |
670ce6ea RS |
273 | (if (listp tmm-shortcut-style) ; convert to list |
274 | tmm-shortcut-style | |
275 | (list tmm-shortcut-style)))) | |
276 | (while shortcut-style ; try upcase and downcase variants | |
277 | (setq char (funcall (car shortcut-style) (aref str pos))) | |
278 | (if (not (memq char tmm-short-cuts)) (throw 'done char)) | |
279 | (setq shortcut-style (cdr shortcut-style))))) | |
280 | (setq word (1+ word)) | |
281 | (setq pos (match-end 0))) | |
282 | (while (<= tmm-next-shortcut-digit ?9) ; no letter shortcut, pick a digit | |
283 | (setq char tmm-next-shortcut-digit) | |
284 | (setq tmm-next-shortcut-digit (1+ tmm-next-shortcut-digit)) | |
285 | (if (not (memq char tmm-short-cuts)) (throw 'done char))) | |
286 | (setq char nil)) | |
287 | (if char (setq tmm-short-cuts (cons char tmm-short-cuts))) | |
288 | (cons (concat (if char (concat (char-to-string char) tmm-mid-prompt) | |
289 | ;; keep them lined up in columns | |
290 | (make-string (1+ (length tmm-mid-prompt)) ?\ )) | |
291 | str) | |
292 | (cdr elt)))) | |
293 | ||
294 | ;; This returns the old map. | |
fe03654a | 295 | (defun tmm-define-keys (minibuffer) |
670ce6ea RS |
296 | (let ((map (make-sparse-keymap))) |
297 | (suppress-keymap map t) | |
e07436e1 DL |
298 | (mapc |
299 | (lambda (c) | |
300 | (if (listp tmm-shortcut-style) | |
301 | (define-key map (char-to-string c) 'tmm-shortcut) | |
302 | ;; only one kind of letters are shortcuts, so map both upcase and | |
303 | ;; downcase input to the same | |
304 | (define-key map (char-to-string (downcase c)) 'tmm-shortcut) | |
305 | (define-key map (char-to-string (upcase c)) 'tmm-shortcut))) | |
670ce6ea RS |
306 | tmm-short-cuts) |
307 | (if minibuffer | |
308 | (progn | |
309 | (define-key map [pageup] 'tmm-goto-completions) | |
310 | (define-key map [prior] 'tmm-goto-completions) | |
311 | (define-key map "\ev" 'tmm-goto-completions) | |
312 | (define-key map "\C-n" 'next-history-element) | |
313 | (define-key map "\C-p" 'previous-history-element))) | |
314 | (prog1 (current-local-map) | |
315 | (use-local-map (append map (current-local-map)))))) | |
316 | ||
317 | (defun tmm-completion-delete-prompt () | |
318 | (set-buffer standard-output) | |
319 | (goto-char 1) | |
320 | (delete-region 1 (search-forward "Possible completions are:\n"))) | |
b46324e6 | 321 | |
20062d6b RS |
322 | (defun tmm-add-prompt () |
323 | (remove-hook 'minibuffer-setup-hook 'tmm-add-prompt) | |
afb1835e | 324 | (add-hook 'minibuffer-exit-hook 'tmm-delete-map nil t) |
b46324e6 | 325 | (let ((win (selected-window))) |
670ce6ea | 326 | (setq tmm-old-mb-map (tmm-define-keys t)) |
20062d6b | 327 | ;; Get window and hide it for electric mode to get correct size |
97895167 | 328 | (save-window-excursion |
fc225f66 RS |
329 | (let ((completions |
330 | (mapcar 'car minibuffer-completion-table))) | |
670ce6ea RS |
331 | (or tmm-completion-prompt |
332 | (add-hook 'completion-setup-hook | |
333 | 'tmm-completion-delete-prompt 'append)) | |
fc225f66 | 334 | (with-output-to-temp-buffer "*Completions*" |
670ce6ea RS |
335 | (display-completion-list completions)) |
336 | (remove-hook 'completion-setup-hook 'tmm-completion-delete-prompt)) | |
0595722b GM |
337 | (when tmm-completion-prompt |
338 | (set-buffer "*Completions*") | |
339 | (let ((buffer-read-only nil)) | |
340 | (goto-char (point-min)) | |
341 | (insert tmm-completion-prompt)))) | |
ca85cf8a | 342 | (save-selected-window |
20062d6b RS |
343 | (other-window 1) ; Electric-pop-up-window does |
344 | ; not work in minibuffer | |
ca85cf8a RS |
345 | (Electric-pop-up-window "*Completions*") |
346 | (with-current-buffer "*Completions*" | |
347 | (setq tmm-old-comp-map (tmm-define-keys nil)))) | |
670ce6ea | 348 | |
20062d6b RS |
349 | (insert tmm-c-prompt))) |
350 | ||
351 | (defun tmm-delete-map () | |
afb1835e | 352 | (remove-hook 'minibuffer-exit-hook 'tmm-delete-map t) |
fc225f66 RS |
353 | (if tmm-old-mb-map |
354 | (use-local-map tmm-old-mb-map))) | |
20062d6b RS |
355 | |
356 | (defun tmm-shortcut () | |
fc225f66 | 357 | "Choose the shortcut that the user typed." |
20062d6b | 358 | (interactive) |
670ce6ea RS |
359 | (let ((c last-command-char) s) |
360 | (if (symbolp tmm-shortcut-style) | |
361 | (setq c (funcall tmm-shortcut-style c))) | |
362 | (if (memq c tmm-short-cuts) | |
fc225f66 RS |
363 | (if (equal (buffer-name) "*Completions*") |
364 | (progn | |
365 | (beginning-of-buffer) | |
366 | (re-search-forward | |
670ce6ea | 367 | (concat "\\(^\\|[ \t]\\)" (char-to-string c) tmm-mid-prompt)) |
fc225f66 | 368 | (choose-completion)) |
c2a8d4a7 GM |
369 | ;; In minibuffer |
370 | (delete-region (minibuffer-prompt-end) (point-max)) | |
e07436e1 DL |
371 | (mapc (lambda (elt) |
372 | (if (string= | |
97895167 | 373 | (substring (car elt) 0 |
e07436e1 DL |
374 | (min (1+ (length tmm-mid-prompt)) |
375 | (length (car elt)))) | |
376 | (concat (char-to-string c) tmm-mid-prompt)) | |
377 | (setq s (car elt)))) | |
fc225f66 RS |
378 | tmm-km-list) |
379 | (insert s) | |
380 | (exit-minibuffer))))) | |
20062d6b RS |
381 | |
382 | (defun tmm-goto-completions () | |
383 | (interactive) | |
fbe91bbd GM |
384 | (let ((prompt-end (minibuffer-prompt-end))) |
385 | (setq tmm-c-prompt (buffer-substring prompt-end (point-max))) | |
386 | (delete-region prompt-end (point-max))) | |
fc225f66 | 387 | (switch-to-buffer-other-window "*Completions*") |
20062d6b RS |
388 | (search-forward tmm-c-prompt) |
389 | (search-backward tmm-c-prompt)) | |
390 | ||
97895167 | 391 | (defun tmm-get-keymap (elt &optional in-x-menu) |
20062d6b RS |
392 | "Prepends (DOCSTRING EVENT BINDING) to free variable `tmm-km-list'. |
393 | The values are deduced from the argument ELT, that should be an | |
fc225f66 | 394 | element of keymap, an `x-popup-menu' argument, or an element of |
20062d6b | 395 | `x-popup-menu' argument (when IN-X-MENU is not-nil). |
77cc5db0 RS |
396 | This function adds the element only if it is not already present. |
397 | It uses the free variable `tmm-table-undef' to keep undefined keys." | |
97895167 | 398 | (let (km str cache plist filter visible (event (car elt))) |
20062d6b RS |
399 | (setq elt (cdr elt)) |
400 | (if (eq elt 'undefined) | |
401 | (setq tmm-table-undef (cons (cons event nil) tmm-table-undef)) | |
42d140b4 KH |
402 | (unless (assoc event tmm-table-undef) |
403 | (cond ((if (listp elt) | |
404 | (or (keymapp elt) (eq (car elt) 'lambda)) | |
405 | (fboundp elt)) | |
406 | (setq km elt)) | |
0595722b | 407 | |
42d140b4 KH |
408 | ((if (listp (cdr-safe elt)) |
409 | (or (keymapp (cdr-safe elt)) | |
410 | (eq (car (cdr-safe elt)) 'lambda)) | |
411 | (fboundp (cdr-safe elt))) | |
412 | (setq km (cdr elt)) | |
413 | (and (stringp (car elt)) (setq str (car elt)))) | |
0595722b | 414 | |
42d140b4 KH |
415 | ((if (listp (cdr-safe (cdr-safe elt))) |
416 | (or (keymapp (cdr-safe (cdr-safe elt))) | |
417 | (eq (car (cdr-safe (cdr-safe elt))) 'lambda)) | |
418 | (fboundp (cdr-safe (cdr-safe elt)))) | |
419 | (setq km (cdr (cdr elt))) | |
420 | (and (stringp (car elt)) (setq str (car elt))) | |
421 | (and str | |
422 | (stringp (cdr (car (cdr elt)))) ; keyseq cache | |
423 | (setq cache (cdr (car (cdr elt)))) | |
424 | cache (setq str (concat str cache)))) | |
0595722b | 425 | |
42d140b4 | 426 | ((eq (car-safe elt) 'menu-item) |
0595722b | 427 | ;; (menu-item TITLE COMMAND KEY ...) |
dd81ca0d | 428 | (setq plist (cdr-safe (cdr-safe (cdr-safe elt)))) |
0595722b GM |
429 | (when (consp (car-safe plist)) |
430 | (setq plist (cdr-safe plist))) | |
42d140b4 | 431 | (setq km (nth 2 elt)) |
c19cc275 | 432 | (setq str (eval (nth 1 elt))) |
dd81ca0d RS |
433 | (setq filter (plist-get plist :filter)) |
434 | (if filter | |
435 | (setq km (funcall filter km))) | |
97895167 PJ |
436 | (setq visible (plist-get plist :visible)) |
437 | (if visible | |
438 | (setq km (and (eval visible) km))) | |
42d140b4 | 439 | (and str |
ae3f2f3c | 440 | (consp (nth 3 elt)) |
437d9247 RS |
441 | (stringp (cdr (nth 3 elt))) ; keyseq cache |
442 | (setq cache (cdr (nth 3 elt))) | |
42d140b4 KH |
443 | cache |
444 | (setq str (concat str cache)))) | |
0595722b | 445 | |
42d140b4 KH |
446 | ((if (listp (cdr-safe (cdr-safe (cdr-safe elt)))) |
447 | (or (keymapp (cdr-safe (cdr-safe (cdr-safe elt)))) | |
448 | (eq (car (cdr-safe (cdr-safe (cdr-safe elt)))) 'lambda)) | |
449 | (fboundp (cdr-safe (cdr-safe (cdr-safe elt))))) | |
450 | ; New style of easy-menu | |
451 | (setq km (cdr (cdr (cdr elt)))) | |
452 | (and (stringp (car elt)) (setq str (car elt))) | |
453 | (and str | |
454 | (stringp (cdr (car (cdr (cdr elt))))) ; keyseq cache | |
455 | (setq cache (cdr (car (cdr (cdr elt))))) | |
456 | cache (setq str (concat str cache)))) | |
0595722b | 457 | |
42d140b4 KH |
458 | ((stringp event) ; x-popup or x-popup element |
459 | (if (or in-x-menu (stringp (car-safe elt))) | |
460 | (setq str event event nil km elt) | |
461 | (setq str event event nil km (cons 'keymap elt)) | |
462 | )))) | |
20062d6b | 463 | (and km (stringp km) (setq str km)) |
2a9f2437 RS |
464 | ;; Verify that the command is enabled; |
465 | ;; if not, don't mention it. | |
466 | (when (and km (symbolp km) (get km 'menu-enable)) | |
467 | (unless (eval (get km 'menu-enable)) | |
468 | (setq km nil))) | |
20062d6b RS |
469 | (and km str |
470 | (or (assoc str tmm-km-list) | |
c19cc275 | 471 | (push (cons str (cons event km)) tmm-km-list)))))) |
20062d6b | 472 | |
20062d6b | 473 | (defun tmm-get-keybind (keyseq) |
fc225f66 | 474 | "Return the current binding of KEYSEQ, merging prefix definitions. |
91a5e367 | 475 | If KEYSEQ is a prefix key that has local and global bindings, |
fc225f66 RS |
476 | we merge them into a single keymap which shows the proper order of the menu. |
477 | However, for the menu bar itself, the value does not take account | |
478 | of `menu-bar-final-items'." | |
20062d6b | 479 | (let (allbind bind) |
fc225f66 RS |
480 | (setq bind (key-binding keyseq)) |
481 | ;; If KEYSEQ is a prefix key, then BIND is either nil | |
482 | ;; or a symbol defined as a keymap (which satisfies keymapp). | |
483 | (if (keymapp bind) | |
484 | (setq bind nil)) | |
485 | ;; If we have a non-keymap definition, return that. | |
486 | (or bind | |
487 | (progn | |
488 | ;; Otherwise, it is a prefix, so make a list of the subcommands. | |
489 | ;; Make a list of all the bindings in all the keymaps. | |
97895167 | 490 | (setq allbind (mapcar 'cdr (minor-mode-key-binding keyseq))) |
fc225f66 RS |
491 | (setq allbind (cons (local-key-binding keyseq) allbind)) |
492 | (setq allbind (cons (global-key-binding keyseq) allbind)) | |
493 | ;; Merge all the elements of ALLBIND into one keymap. | |
e07436e1 DL |
494 | (mapc (lambda (in) |
495 | (if (and (symbolp in) (keymapp in)) | |
496 | (setq in (symbol-function in))) | |
497 | (and in (keymapp in) | |
498 | (if (keymapp bind) | |
499 | (setq bind (nconc bind (copy-sequence (cdr in)))) | |
500 | (setq bind (copy-sequence in))))) | |
fc225f66 RS |
501 | allbind) |
502 | ;; Return that keymap. | |
503 | bind)))) | |
20062d6b RS |
504 | |
505 | (add-hook 'calendar-load-hook (lambda () (require 'cal-menu))) | |
506 | ||
20062d6b RS |
507 | (provide 'tmm) |
508 | ||
20062d6b | 509 | ;;; tmm.el ends here |