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