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