Mercurial > emacs
annotate lisp/tmm.el @ 97722:38eecdd090f7
(calendar-holidays): Doc fix.
author | Glenn Morris <rgm@gnu.org> |
---|---|
date | Tue, 26 Aug 2008 05:39:19 +0000 |
parents | ee5932bf781d |
children | 00ad633e13ee |
rev | line source |
---|---|
13337 | 1 ;;; tmm.el --- text mode access to menu-bar |
10955 | 2 |
64762
41bb365f41c4
Update years in copyright notice; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
64091
diff
changeset
|
3 ;; Copyright (C) 1994, 1995, 1996, 2000, 2001, 2002, 2003, |
79721 | 4 ;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. |
10955 | 5 |
6 ;; 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
|
7 ;; Maintainer: FSF |
42991
2cc71fdee37e
(tmm-get-keymap): Honour :visible in `menu-item'.
Pavel Janík <Pavel@Janik.cz>
parents:
41483
diff
changeset
|
8 ;; Keywords: convenience |
10955 | 9 |
10956 | 10 ;; This file is part of GNU Emacs. |
10955 | 11 |
94678
ee5932bf781d
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
94088
diff
changeset
|
12 ;; GNU Emacs is free software: you can redistribute it and/or modify |
10955 | 13 ;; it under the terms of the GNU General Public License as published by |
94678
ee5932bf781d
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
94088
diff
changeset
|
14 ;; the Free Software Foundation, either version 3 of the License, or |
ee5932bf781d
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
94088
diff
changeset
|
15 ;; (at your option) any later version. |
10955 | 16 |
17 ;; GNU Emacs is distributed in the hope that it will be useful, | |
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
20 ;; GNU General Public License for more details. | |
21 | |
22 ;; You should have received a copy of the GNU General Public License | |
94678
ee5932bf781d
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
94088
diff
changeset
|
23 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
10955 | 24 |
14169 | 25 ;;; Commentary: |
10955 | 26 |
42991
2cc71fdee37e
(tmm-get-keymap): Honour :visible in `menu-item'.
Pavel Janík <Pavel@Janik.cz>
parents:
41483
diff
changeset
|
27 ;; This package provides text mode access to the menu bar. |
10955 | 28 |
14169 | 29 ;;; Code: |
10955 | 30 |
31 (require 'electric) | |
32 | |
21088 | 33 (defgroup tmm nil |
34 "Text mode access to menu-bar." | |
35 :prefix "tmm-" | |
36 :group 'menu) | |
37 | |
10955 | 38 ;;; The following will be localized, added only to pacify the compiler. |
39 (defvar tmm-short-cuts) | |
13334
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
40 (defvar tmm-old-mb-map nil) |
10955 | 41 (defvar tmm-old-comp-map) |
76905
624ef730616c
(tmm-c-prompt): Initialize.
Nick Roberts <nickrob@snap.net.nz>
parents:
76802
diff
changeset
|
42 (defvar tmm-c-prompt nil) |
10955 | 43 (defvar tmm-km-list) |
16040
74fc923ff6d5
(tmm-add-one-shortcut): New subroutine.
Richard M. Stallman <rms@gnu.org>
parents:
15564
diff
changeset
|
44 (defvar tmm-next-shortcut-digit) |
10955 | 45 (defvar tmm-table-undef) |
46 | |
12960
6db607a7b62d
Fix typo in global-map define.
Richard M. Stallman <rms@gnu.org>
parents:
12763
diff
changeset
|
47 ;;;###autoload (define-key global-map "\M-`" 'tmm-menubar) |
13915
1319e4b9aa6c
(tmm-menubar-mouse): New function, handles [menu-bar mouse-1].
Richard M. Stallman <rms@gnu.org>
parents:
13581
diff
changeset
|
48 ;;;###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
|
49 |
10955 | 50 ;;;###autoload |
13915
1319e4b9aa6c
(tmm-menubar-mouse): New function, handles [menu-bar mouse-1].
Richard M. Stallman <rms@gnu.org>
parents:
13581
diff
changeset
|
51 (defun tmm-menubar (&optional x-position) |
10955 | 52 "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
|
53 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
|
54 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
|
55 we make that menu bar item (the one at that position) the default choice." |
10955 | 56 (interactive) |
57 (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
|
58 ;; 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
|
59 (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
|
60 menu-bar-item) |
13334
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
61 (let ((list menu-bar-final-items)) |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
62 (while list |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
63 (let ((item (car list))) |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
64 ;; 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
|
65 ;; 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
|
66 (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
|
67 (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
|
68 (list this-one))))) |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
69 (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
|
70 (if x-position |
76905
624ef730616c
(tmm-c-prompt): Initialize.
Nick Roberts <nickrob@snap.net.nz>
parents:
76802
diff
changeset
|
71 (let ((tail menu-bar) (column 0) |
76911
0d761d6b0064
(tmm-menubar, tmm-prompt): Handle visibility of top level menu-items.
Nick Roberts <nickrob@snap.net.nz>
parents:
76905
diff
changeset
|
72 this-one name visible) |
76802
293d8ec25f85
(tmm-menubar): Select the right menu item with the mouse.
Nick Roberts <nickrob@snap.net.nz>
parents:
75347
diff
changeset
|
73 (while (and tail (<= column x-position)) |
13915
1319e4b9aa6c
(tmm-menubar-mouse): New function, handles [menu-bar mouse-1].
Richard M. Stallman <rms@gnu.org>
parents:
13581
diff
changeset
|
74 (setq this-one (car tail)) |
76802
293d8ec25f85
(tmm-menubar): Select the right menu item with the mouse.
Nick Roberts <nickrob@snap.net.nz>
parents:
75347
diff
changeset
|
75 (if (and (consp this-one) |
293d8ec25f85
(tmm-menubar): Select the right menu item with the mouse.
Nick Roberts <nickrob@snap.net.nz>
parents:
75347
diff
changeset
|
76 (consp (cdr this-one)) |
76911
0d761d6b0064
(tmm-menubar, tmm-prompt): Handle visibility of top level menu-items.
Nick Roberts <nickrob@snap.net.nz>
parents:
76905
diff
changeset
|
77 (setq name ;simple menu |
76905
624ef730616c
(tmm-c-prompt): Initialize.
Nick Roberts <nickrob@snap.net.nz>
parents:
76802
diff
changeset
|
78 (cond ((stringp (nth 1 this-one)) |
624ef730616c
(tmm-c-prompt): Initialize.
Nick Roberts <nickrob@snap.net.nz>
parents:
76802
diff
changeset
|
79 (nth 1 this-one)) |
76911
0d761d6b0064
(tmm-menubar, tmm-prompt): Handle visibility of top level menu-items.
Nick Roberts <nickrob@snap.net.nz>
parents:
76905
diff
changeset
|
80 ;extended menu |
0d761d6b0064
(tmm-menubar, tmm-prompt): Handle visibility of top level menu-items.
Nick Roberts <nickrob@snap.net.nz>
parents:
76905
diff
changeset
|
81 ((stringp (nth 2 this-one)) |
0d761d6b0064
(tmm-menubar, tmm-prompt): Handle visibility of top level menu-items.
Nick Roberts <nickrob@snap.net.nz>
parents:
76905
diff
changeset
|
82 (setq visible (plist-get |
0d761d6b0064
(tmm-menubar, tmm-prompt): Handle visibility of top level menu-items.
Nick Roberts <nickrob@snap.net.nz>
parents:
76905
diff
changeset
|
83 (nthcdr 4 this-one) :visible)) |
0d761d6b0064
(tmm-menubar, tmm-prompt): Handle visibility of top level menu-items.
Nick Roberts <nickrob@snap.net.nz>
parents:
76905
diff
changeset
|
84 (unless (and visible (not (eval visible))) |
0d761d6b0064
(tmm-menubar, tmm-prompt): Handle visibility of top level menu-items.
Nick Roberts <nickrob@snap.net.nz>
parents:
76905
diff
changeset
|
85 (nth 2 this-one)))))) |
76905
624ef730616c
(tmm-c-prompt): Initialize.
Nick Roberts <nickrob@snap.net.nz>
parents:
76802
diff
changeset
|
86 (setq column (+ column (length name) 1))) |
13915
1319e4b9aa6c
(tmm-menubar-mouse): New function, handles [menu-bar mouse-1].
Richard M. Stallman <rms@gnu.org>
parents:
13581
diff
changeset
|
87 (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
|
88 (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
|
89 (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
|
90 |
14120
4d4eb72a8d65
(tmm-menubar-mouse): Add autoload cookie.
Karl Heuer <kwzh@gnu.org>
parents:
14011
diff
changeset
|
91 ;;;###autoload |
13915
1319e4b9aa6c
(tmm-menubar-mouse): New function, handles [menu-bar mouse-1].
Richard M. Stallman <rms@gnu.org>
parents:
13581
diff
changeset
|
92 (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
|
93 "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
|
94 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
|
95 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
|
96 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
|
97 (interactive "e") |
1319e4b9aa6c
(tmm-menubar-mouse): New function, handles [menu-bar mouse-1].
Richard M. Stallman <rms@gnu.org>
parents:
13581
diff
changeset
|
98 (tmm-menubar (car (posn-x-y (event-start event))))) |
10955 | 99 |
21088 | 100 (defcustom tmm-mid-prompt "==>" |
84430
490362706869
Remove spurious * in docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
83648
diff
changeset
|
101 "String to insert between shortcut and menu item. |
16040
74fc923ff6d5
(tmm-add-one-shortcut): New subroutine.
Richard M. Stallman <rms@gnu.org>
parents:
15564
diff
changeset
|
102 If nil, there will be no shortcuts. It should not consist only of spaces, |
21088 | 103 or else the correct item might not be found in the `*Completions*' buffer." |
104 :type 'string | |
105 :group 'tmm) | |
10955 | 106 |
107 (defvar tmm-mb-map nil | |
108 "A place to store minibuffer map.") | |
109 | |
42991
2cc71fdee37e
(tmm-get-keymap): Honour :visible in `menu-item'.
Pavel Janík <Pavel@Janik.cz>
parents:
41483
diff
changeset
|
110 (defcustom tmm-completion-prompt |
44742
bf788fcf5b82
(tmm-completion-prompt): Doc fix.
Pavel Janík <Pavel@Janik.cz>
parents:
42991
diff
changeset
|
111 "Press PageUp key to reach this buffer from the minibuffer. |
10955 | 112 Alternatively, you can use Up/Down keys (or your History keys) to change |
42991
2cc71fdee37e
(tmm-get-keymap): Honour :visible in `menu-item'.
Pavel Janík <Pavel@Janik.cz>
parents:
41483
diff
changeset
|
113 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
|
114 marked letters to pick up your choice. Type C-g or ESC ESC ESC to cancel. |
10955 | 115 " |
84430
490362706869
Remove spurious * in docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
83648
diff
changeset
|
116 "Help text to insert on the top of the completion buffer. |
16040
74fc923ff6d5
(tmm-add-one-shortcut): New subroutine.
Richard M. Stallman <rms@gnu.org>
parents:
15564
diff
changeset
|
117 To save space, you can set this to nil, |
21088 | 118 in which case the standard introduction text is deleted too." |
119 :type '(choice string (const nil)) | |
120 :group 'tmm) | |
16040
74fc923ff6d5
(tmm-add-one-shortcut): New subroutine.
Richard M. Stallman <rms@gnu.org>
parents:
15564
diff
changeset
|
121 |
21088 | 122 (defcustom tmm-shortcut-style '(downcase upcase) |
84430
490362706869
Remove spurious * in docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
83648
diff
changeset
|
123 "What letters to use as menu shortcuts. |
42991
2cc71fdee37e
(tmm-get-keymap): Honour :visible in `menu-item'.
Pavel Janík <Pavel@Janik.cz>
parents:
41483
diff
changeset
|
124 Must be either one of the symbols `downcase' or `upcase', |
21088 | 125 or else a list of the two in the order you prefer." |
126 :type '(choice (const downcase) | |
127 (const upcase) | |
128 (repeat (choice (const downcase) (const upcase)))) | |
129 :group 'tmm) | |
16040
74fc923ff6d5
(tmm-add-one-shortcut): New subroutine.
Richard M. Stallman <rms@gnu.org>
parents:
15564
diff
changeset
|
130 |
21088 | 131 (defcustom tmm-shortcut-words 2 |
84430
490362706869
Remove spurious * in docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
83648
diff
changeset
|
132 "How many successive words to try for shortcuts, nil means all. |
42991
2cc71fdee37e
(tmm-get-keymap): Honour :visible in `menu-item'.
Pavel Janík <Pavel@Janik.cz>
parents:
41483
diff
changeset
|
133 If you use only one of `downcase' or `upcase' for `tmm-shortcut-style', |
21088 | 134 specify nil for this variable." |
135 :type '(choice integer (const nil)) | |
136 :group 'tmm) | |
10955 | 137 |
63082
24720eb84061
(tmm-inactive, tmm-remove-inactive-mouse-face):
Juri Linkov <juri@jurta.org>
parents:
63054
diff
changeset
|
138 (defface tmm-inactive |
63054
bb05eaafc76a
* tmm.el (tmm-inactive-face): Inherit from `shadow' face.
Juri Linkov <juri@jurta.org>
parents:
62972
diff
changeset
|
139 '((t :inherit shadow)) |
62972
6331f03975bb
(tmm-inactive-face): New face.
Nick Roberts <nickrob@snap.net.nz>
parents:
62572
diff
changeset
|
140 "Face used for inactive menu items." |
6331f03975bb
(tmm-inactive-face): New face.
Nick Roberts <nickrob@snap.net.nz>
parents:
62572
diff
changeset
|
141 :group 'tmm) |
6331f03975bb
(tmm-inactive-face): New face.
Nick Roberts <nickrob@snap.net.nz>
parents:
62572
diff
changeset
|
142 |
10955 | 143 ;;;###autoload |
13916
00065bf711b8
(tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents:
13915
diff
changeset
|
144 (defun tmm-prompt (menu &optional in-popup default-item) |
10955 | 145 "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
|
146 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
|
147 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
|
148 *) via history mechanism from minibuffer; |
10955 | 149 *) Or via completion-buffer that is automatically shown. |
150 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
|
151 |
00065bf711b8
(tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents:
13915
diff
changeset
|
152 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
|
153 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
|
154 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
|
155 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
|
156 ;; 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
|
157 ;; 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
|
158 ;; 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
|
159 (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
|
160 ; 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
|
161 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
|
162 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
|
163 chosen-string choice |
00065bf711b8
(tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents:
13915
diff
changeset
|
164 (not-menu (not (keymapp menu)))) |
10955 | 165 (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
|
166 ;; 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
|
167 ;; 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
|
168 ;; 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
|
169 ;; The order of elements in tmm-km-list is the order of the menu bar. |
31675
a8e0d20f0043
Replace mapcar with mapc in several places.
Dave Love <fx@gnu.org>
parents:
29290
diff
changeset
|
170 (mapc (lambda (elt) |
a8e0d20f0043
Replace mapcar with mapc in several places.
Dave Love <fx@gnu.org>
parents:
29290
diff
changeset
|
171 (if (stringp elt) |
a8e0d20f0043
Replace mapcar with mapc in several places.
Dave Love <fx@gnu.org>
parents:
29290
diff
changeset
|
172 (setq gl-str elt) |
a8e0d20f0043
Replace mapcar with mapc in several places.
Dave Love <fx@gnu.org>
parents:
29290
diff
changeset
|
173 (and (listp elt) (tmm-get-keymap elt not-menu)))) |
13916
00065bf711b8
(tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents:
13915
diff
changeset
|
174 menu) |
00065bf711b8
(tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents:
13915
diff
changeset
|
175 ;; 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
|
176 (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
|
177 ;; 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
|
178 ;; 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
|
179 ;; 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
|
180 ;; 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
|
181 (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
|
182 (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
|
183 (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
|
184 (and tmm-km-list |
00065bf711b8
(tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents:
13915
diff
changeset
|
185 (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
|
186 (if tmm-mid-prompt |
00065bf711b8
(tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents:
13915
diff
changeset
|
187 (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
|
188 t) |
00065bf711b8
(tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents:
13915
diff
changeset
|
189 ;; 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
|
190 ;; 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
|
191 ;; and initial history position. |
00065bf711b8
(tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents:
13915
diff
changeset
|
192 (if default-item |
76911
0d761d6b0064
(tmm-menubar, tmm-prompt): Handle visibility of top level menu-items.
Nick Roberts <nickrob@snap.net.nz>
parents:
76905
diff
changeset
|
193 (let ((tail menu) visible) |
13916
00065bf711b8
(tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents:
13915
diff
changeset
|
194 (while (and tail |
00065bf711b8
(tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents:
13915
diff
changeset
|
195 (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
|
196 ;; 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
|
197 ;; 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
|
198 (if (and (consp (car tail)) |
29290
181d214fe71c
(tmm-prompt): Recognize menu item definitions of the for
Gerd Moellmann <gerd@gnu.org>
parents:
27350
diff
changeset
|
199 (or (stringp (car-safe (cdr (car tail)))) |
76911
0d761d6b0064
(tmm-menubar, tmm-prompt): Handle visibility of top level menu-items.
Nick Roberts <nickrob@snap.net.nz>
parents:
76905
diff
changeset
|
200 (and |
0d761d6b0064
(tmm-menubar, tmm-prompt): Handle visibility of top level menu-items.
Nick Roberts <nickrob@snap.net.nz>
parents:
76905
diff
changeset
|
201 (eq (car-safe (cdr (car tail))) 'menu-item) |
0d761d6b0064
(tmm-menubar, tmm-prompt): Handle visibility of top level menu-items.
Nick Roberts <nickrob@snap.net.nz>
parents:
76905
diff
changeset
|
202 (progn |
0d761d6b0064
(tmm-menubar, tmm-prompt): Handle visibility of top level menu-items.
Nick Roberts <nickrob@snap.net.nz>
parents:
76905
diff
changeset
|
203 (setq visible |
0d761d6b0064
(tmm-menubar, tmm-prompt): Handle visibility of top level menu-items.
Nick Roberts <nickrob@snap.net.nz>
parents:
76905
diff
changeset
|
204 (plist-get |
0d761d6b0064
(tmm-menubar, tmm-prompt): Handle visibility of top level menu-items.
Nick Roberts <nickrob@snap.net.nz>
parents:
76905
diff
changeset
|
205 (nthcdr 4 (car tail)) :visible)) |
0d761d6b0064
(tmm-menubar, tmm-prompt): Handle visibility of top level menu-items.
Nick Roberts <nickrob@snap.net.nz>
parents:
76905
diff
changeset
|
206 (or (not visible) (eval visible)))))) |
13916
00065bf711b8
(tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents:
13915
diff
changeset
|
207 (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
|
208 (setq tail (cdr tail))))) |
62972
6331f03975bb
(tmm-inactive-face): New face.
Nick Roberts <nickrob@snap.net.nz>
parents:
62572
diff
changeset
|
209 (let ((prompt (concat "^." (regexp-quote tmm-mid-prompt)))) |
6331f03975bb
(tmm-inactive-face): New face.
Nick Roberts <nickrob@snap.net.nz>
parents:
62572
diff
changeset
|
210 (setq history |
6331f03975bb
(tmm-inactive-face): New face.
Nick Roberts <nickrob@snap.net.nz>
parents:
62572
diff
changeset
|
211 (reverse (delq nil |
6331f03975bb
(tmm-inactive-face): New face.
Nick Roberts <nickrob@snap.net.nz>
parents:
62572
diff
changeset
|
212 (mapcar |
6331f03975bb
(tmm-inactive-face): New face.
Nick Roberts <nickrob@snap.net.nz>
parents:
62572
diff
changeset
|
213 (lambda (elt) |
6331f03975bb
(tmm-inactive-face): New face.
Nick Roberts <nickrob@snap.net.nz>
parents:
62572
diff
changeset
|
214 (if (string-match prompt (car elt)) |
6331f03975bb
(tmm-inactive-face): New face.
Nick Roberts <nickrob@snap.net.nz>
parents:
62572
diff
changeset
|
215 (car elt))) |
6331f03975bb
(tmm-inactive-face): New face.
Nick Roberts <nickrob@snap.net.nz>
parents:
62572
diff
changeset
|
216 tmm-km-list))))) |
13916
00065bf711b8
(tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents:
13915
diff
changeset
|
217 (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
|
218 (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
|
219 (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
|
220 (add-hook 'minibuffer-setup-hook 'tmm-add-prompt) |
76802
293d8ec25f85
(tmm-menubar): Select the right menu item with the mouse.
Nick Roberts <nickrob@snap.net.nz>
parents:
75347
diff
changeset
|
221 (if default-item |
293d8ec25f85
(tmm-menubar): Select the right menu item with the mouse.
Nick Roberts <nickrob@snap.net.nz>
parents:
75347
diff
changeset
|
222 (setq out (car (nth index-of-default tmm-km-list))) |
293d8ec25f85
(tmm-menubar): Select the right menu item with the mouse.
Nick Roberts <nickrob@snap.net.nz>
parents:
75347
diff
changeset
|
223 (save-excursion |
293d8ec25f85
(tmm-menubar): Select the right menu item with the mouse.
Nick Roberts <nickrob@snap.net.nz>
parents:
75347
diff
changeset
|
224 (unwind-protect |
293d8ec25f85
(tmm-menubar): Select the right menu item with the mouse.
Nick Roberts <nickrob@snap.net.nz>
parents:
75347
diff
changeset
|
225 (setq out |
293d8ec25f85
(tmm-menubar): Select the right menu item with the mouse.
Nick Roberts <nickrob@snap.net.nz>
parents:
75347
diff
changeset
|
226 (completing-read |
293d8ec25f85
(tmm-menubar): Select the right menu item with the mouse.
Nick Roberts <nickrob@snap.net.nz>
parents:
75347
diff
changeset
|
227 (concat gl-str |
293d8ec25f85
(tmm-menubar): Select the right menu item with the mouse.
Nick Roberts <nickrob@snap.net.nz>
parents:
75347
diff
changeset
|
228 " (up/down to change, PgUp to menu): ") |
293d8ec25f85
(tmm-menubar): Select the right menu item with the mouse.
Nick Roberts <nickrob@snap.net.nz>
parents:
75347
diff
changeset
|
229 tmm-km-list nil t nil |
293d8ec25f85
(tmm-menubar): Select the right menu item with the mouse.
Nick Roberts <nickrob@snap.net.nz>
parents:
75347
diff
changeset
|
230 (cons 'history |
293d8ec25f85
(tmm-menubar): Select the right menu item with the mouse.
Nick Roberts <nickrob@snap.net.nz>
parents:
75347
diff
changeset
|
231 (- (* 2 history-len) index-of-default)))) |
84430
490362706869
Remove spurious * in docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
83648
diff
changeset
|
232 (remove-hook 'minibuffer-setup-hook 'tmm-add-prompt) |
490362706869
Remove spurious * in docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
83648
diff
changeset
|
233 (if (get-buffer "*Completions*") |
490362706869
Remove spurious * in docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
83648
diff
changeset
|
234 (with-current-buffer "*Completions*" |
490362706869
Remove spurious * in docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
83648
diff
changeset
|
235 (use-local-map tmm-old-comp-map) |
490362706869
Remove spurious * in docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
83648
diff
changeset
|
236 (bury-buffer (current-buffer))))))))) |
13916
00065bf711b8
(tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents:
13915
diff
changeset
|
237 (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
|
238 (and (null choice) |
00065bf711b8
(tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents:
13915
diff
changeset
|
239 (> (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
|
240 (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
|
241 (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
|
242 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
|
243 (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
|
244 (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
|
245 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
|
246 ;; 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
|
247 (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
|
248 (setq choice (cdr choice)) |
00065bf711b8
(tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents:
13915
diff
changeset
|
249 (cond (in-popup |
00065bf711b8
(tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents:
13915
diff
changeset
|
250 ;; 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
|
251 choice) |
00065bf711b8
(tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents:
13915
diff
changeset
|
252 ;; We just did the outer level. Do the inner level now. |
42991
2cc71fdee37e
(tmm-get-keymap): Honour :visible in `menu-item'.
Pavel Janík <Pavel@Janik.cz>
parents:
41483
diff
changeset
|
253 (not-menu (tmm-prompt choice t)) |
13916
00065bf711b8
(tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents:
13915
diff
changeset
|
254 ;; 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
|
255 ((keymapp choice) |
00065bf711b8
(tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents:
13915
diff
changeset
|
256 (if (symbolp choice) |
00065bf711b8
(tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents:
13915
diff
changeset
|
257 (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
|
258 (condition-case nil |
00065bf711b8
(tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents:
13915
diff
changeset
|
259 (require 'mouse) |
00065bf711b8
(tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents:
13915
diff
changeset
|
260 (error nil)) |
00065bf711b8
(tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents:
13915
diff
changeset
|
261 (condition-case nil |
00065bf711b8
(tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents:
13915
diff
changeset
|
262 (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
|
263 (error nil)) |
00065bf711b8
(tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents:
13915
diff
changeset
|
264 (tmm-prompt choice)) |
00065bf711b8
(tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents:
13915
diff
changeset
|
265 ;; 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
|
266 (choice |
00065bf711b8
(tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents:
13915
diff
changeset
|
267 (if chosen-string |
14282
63fbb2aeb1f2
(tmm-prompt): Set last-command-event before calling the
Karl Heuer <kwzh@gnu.org>
parents:
14169
diff
changeset
|
268 (progn |
63fbb2aeb1f2
(tmm-prompt): Set last-command-event before calling the
Karl Heuer <kwzh@gnu.org>
parents:
14169
diff
changeset
|
269 (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
|
270 (call-interactively choice)) |
13916
00065bf711b8
(tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents:
13915
diff
changeset
|
271 choice))))) |
10955 | 272 |
273 (defun tmm-add-shortcuts (list) | |
274 "Adds shortcuts to cars of elements of the list. | |
275 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
|
276 shortcuts added to these cars. |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
277 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
|
278 (let ((tmm-next-shortcut-digit ?0)) |
74fc923ff6d5
(tmm-add-one-shortcut): New subroutine.
Richard M. Stallman <rms@gnu.org>
parents:
15564
diff
changeset
|
279 (mapcar 'tmm-add-one-shortcut (reverse list)))) |
10955 | 280 |
16040
74fc923ff6d5
(tmm-add-one-shortcut): New subroutine.
Richard M. Stallman <rms@gnu.org>
parents:
15564
diff
changeset
|
281 (defsubst tmm-add-one-shortcut (elt) |
74fc923ff6d5
(tmm-add-one-shortcut): New subroutine.
Richard M. Stallman <rms@gnu.org>
parents:
15564
diff
changeset
|
282 ;; uses the free vars tmm-next-shortcut-digit and tmm-short-cuts |
62972
6331f03975bb
(tmm-inactive-face): New face.
Nick Roberts <nickrob@snap.net.nz>
parents:
62572
diff
changeset
|
283 (cond |
6331f03975bb
(tmm-inactive-face): New face.
Nick Roberts <nickrob@snap.net.nz>
parents:
62572
diff
changeset
|
284 ((eq (cddr elt) 'ignore) |
6331f03975bb
(tmm-inactive-face): New face.
Nick Roberts <nickrob@snap.net.nz>
parents:
62572
diff
changeset
|
285 (cons (concat " " (make-string (length tmm-mid-prompt) ?\-) |
6331f03975bb
(tmm-inactive-face): New face.
Nick Roberts <nickrob@snap.net.nz>
parents:
62572
diff
changeset
|
286 (car elt)) |
6331f03975bb
(tmm-inactive-face): New face.
Nick Roberts <nickrob@snap.net.nz>
parents:
62572
diff
changeset
|
287 (cdr elt))) |
6331f03975bb
(tmm-inactive-face): New face.
Nick Roberts <nickrob@snap.net.nz>
parents:
62572
diff
changeset
|
288 (t |
6331f03975bb
(tmm-inactive-face): New face.
Nick Roberts <nickrob@snap.net.nz>
parents:
62572
diff
changeset
|
289 (let* ((str (car elt)) |
6331f03975bb
(tmm-inactive-face): New face.
Nick Roberts <nickrob@snap.net.nz>
parents:
62572
diff
changeset
|
290 (paren (string-match "(" str)) |
6331f03975bb
(tmm-inactive-face): New face.
Nick Roberts <nickrob@snap.net.nz>
parents:
62572
diff
changeset
|
291 (pos 0) (word 0) char) |
6331f03975bb
(tmm-inactive-face): New face.
Nick Roberts <nickrob@snap.net.nz>
parents:
62572
diff
changeset
|
292 (catch 'done ; ??? is this slow? |
6331f03975bb
(tmm-inactive-face): New face.
Nick Roberts <nickrob@snap.net.nz>
parents:
62572
diff
changeset
|
293 (while (and (or (not tmm-shortcut-words) ; no limit on words |
6331f03975bb
(tmm-inactive-face): New face.
Nick Roberts <nickrob@snap.net.nz>
parents:
62572
diff
changeset
|
294 (< word tmm-shortcut-words)) ; try n words |
6331f03975bb
(tmm-inactive-face): New face.
Nick Roberts <nickrob@snap.net.nz>
parents:
62572
diff
changeset
|
295 (setq pos (string-match "\\w+" str pos)) ; get next word |
6331f03975bb
(tmm-inactive-face): New face.
Nick Roberts <nickrob@snap.net.nz>
parents:
62572
diff
changeset
|
296 (not (and paren (> pos paren)))) ; don't go past "(binding.." |
6331f03975bb
(tmm-inactive-face): New face.
Nick Roberts <nickrob@snap.net.nz>
parents:
62572
diff
changeset
|
297 (if (or (= pos 0) |
6331f03975bb
(tmm-inactive-face): New face.
Nick Roberts <nickrob@snap.net.nz>
parents:
62572
diff
changeset
|
298 (/= (aref str (1- pos)) ?.)) ; avoid file extensions |
6331f03975bb
(tmm-inactive-face): New face.
Nick Roberts <nickrob@snap.net.nz>
parents:
62572
diff
changeset
|
299 (let ((shortcut-style |
6331f03975bb
(tmm-inactive-face): New face.
Nick Roberts <nickrob@snap.net.nz>
parents:
62572
diff
changeset
|
300 (if (listp tmm-shortcut-style) ; convert to list |
6331f03975bb
(tmm-inactive-face): New face.
Nick Roberts <nickrob@snap.net.nz>
parents:
62572
diff
changeset
|
301 tmm-shortcut-style |
6331f03975bb
(tmm-inactive-face): New face.
Nick Roberts <nickrob@snap.net.nz>
parents:
62572
diff
changeset
|
302 (list tmm-shortcut-style)))) |
6331f03975bb
(tmm-inactive-face): New face.
Nick Roberts <nickrob@snap.net.nz>
parents:
62572
diff
changeset
|
303 (while shortcut-style ; try upcase and downcase variants |
6331f03975bb
(tmm-inactive-face): New face.
Nick Roberts <nickrob@snap.net.nz>
parents:
62572
diff
changeset
|
304 (setq char (funcall (car shortcut-style) (aref str pos))) |
6331f03975bb
(tmm-inactive-face): New face.
Nick Roberts <nickrob@snap.net.nz>
parents:
62572
diff
changeset
|
305 (if (not (memq char tmm-short-cuts)) (throw 'done char)) |
6331f03975bb
(tmm-inactive-face): New face.
Nick Roberts <nickrob@snap.net.nz>
parents:
62572
diff
changeset
|
306 (setq shortcut-style (cdr shortcut-style))))) |
6331f03975bb
(tmm-inactive-face): New face.
Nick Roberts <nickrob@snap.net.nz>
parents:
62572
diff
changeset
|
307 (setq word (1+ word)) |
6331f03975bb
(tmm-inactive-face): New face.
Nick Roberts <nickrob@snap.net.nz>
parents:
62572
diff
changeset
|
308 (setq pos (match-end 0))) |
6331f03975bb
(tmm-inactive-face): New face.
Nick Roberts <nickrob@snap.net.nz>
parents:
62572
diff
changeset
|
309 (while (<= tmm-next-shortcut-digit ?9) ; no letter shortcut, pick a digit |
6331f03975bb
(tmm-inactive-face): New face.
Nick Roberts <nickrob@snap.net.nz>
parents:
62572
diff
changeset
|
310 (setq char tmm-next-shortcut-digit) |
6331f03975bb
(tmm-inactive-face): New face.
Nick Roberts <nickrob@snap.net.nz>
parents:
62572
diff
changeset
|
311 (setq tmm-next-shortcut-digit (1+ tmm-next-shortcut-digit)) |
6331f03975bb
(tmm-inactive-face): New face.
Nick Roberts <nickrob@snap.net.nz>
parents:
62572
diff
changeset
|
312 (if (not (memq char tmm-short-cuts)) (throw 'done char))) |
6331f03975bb
(tmm-inactive-face): New face.
Nick Roberts <nickrob@snap.net.nz>
parents:
62572
diff
changeset
|
313 (setq char nil)) |
6331f03975bb
(tmm-inactive-face): New face.
Nick Roberts <nickrob@snap.net.nz>
parents:
62572
diff
changeset
|
314 (if char (setq tmm-short-cuts (cons char tmm-short-cuts))) |
6331f03975bb
(tmm-inactive-face): New face.
Nick Roberts <nickrob@snap.net.nz>
parents:
62572
diff
changeset
|
315 (cons (concat (if char (concat (char-to-string char) tmm-mid-prompt) |
6331f03975bb
(tmm-inactive-face): New face.
Nick Roberts <nickrob@snap.net.nz>
parents:
62572
diff
changeset
|
316 ;; keep them lined up in columns |
74246
27de5ea279da
(tmm-add-one-shortcut): "?\ " -> "?\s".
Juanma Barranquero <lekktu@gmail.com>
parents:
68651
diff
changeset
|
317 (make-string (1+ (length tmm-mid-prompt)) ?\s)) |
62972
6331f03975bb
(tmm-inactive-face): New face.
Nick Roberts <nickrob@snap.net.nz>
parents:
62572
diff
changeset
|
318 str) |
6331f03975bb
(tmm-inactive-face): New face.
Nick Roberts <nickrob@snap.net.nz>
parents:
62572
diff
changeset
|
319 (cdr elt)))))) |
16040
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 ;; This returns the old map. |
14902
6dc4dee167eb
(tmm-define-keys): New arg MINIBUFFER.
Richard M. Stallman <rms@gnu.org>
parents:
14733
diff
changeset
|
322 (defun tmm-define-keys (minibuffer) |
16040
74fc923ff6d5
(tmm-add-one-shortcut): New subroutine.
Richard M. Stallman <rms@gnu.org>
parents:
15564
diff
changeset
|
323 (let ((map (make-sparse-keymap))) |
74fc923ff6d5
(tmm-add-one-shortcut): New subroutine.
Richard M. Stallman <rms@gnu.org>
parents:
15564
diff
changeset
|
324 (suppress-keymap map t) |
31675
a8e0d20f0043
Replace mapcar with mapc in several places.
Dave Love <fx@gnu.org>
parents:
29290
diff
changeset
|
325 (mapc |
a8e0d20f0043
Replace mapcar with mapc in several places.
Dave Love <fx@gnu.org>
parents:
29290
diff
changeset
|
326 (lambda (c) |
a8e0d20f0043
Replace mapcar with mapc in several places.
Dave Love <fx@gnu.org>
parents:
29290
diff
changeset
|
327 (if (listp tmm-shortcut-style) |
a8e0d20f0043
Replace mapcar with mapc in several places.
Dave Love <fx@gnu.org>
parents:
29290
diff
changeset
|
328 (define-key map (char-to-string c) 'tmm-shortcut) |
a8e0d20f0043
Replace mapcar with mapc in several places.
Dave Love <fx@gnu.org>
parents:
29290
diff
changeset
|
329 ;; only one kind of letters are shortcuts, so map both upcase and |
a8e0d20f0043
Replace mapcar with mapc in several places.
Dave Love <fx@gnu.org>
parents:
29290
diff
changeset
|
330 ;; downcase input to the same |
a8e0d20f0043
Replace mapcar with mapc in several places.
Dave Love <fx@gnu.org>
parents:
29290
diff
changeset
|
331 (define-key map (char-to-string (downcase c)) 'tmm-shortcut) |
a8e0d20f0043
Replace mapcar with mapc in several places.
Dave Love <fx@gnu.org>
parents:
29290
diff
changeset
|
332 (define-key map (char-to-string (upcase c)) 'tmm-shortcut))) |
16040
74fc923ff6d5
(tmm-add-one-shortcut): New subroutine.
Richard M. Stallman <rms@gnu.org>
parents:
15564
diff
changeset
|
333 tmm-short-cuts) |
74fc923ff6d5
(tmm-add-one-shortcut): New subroutine.
Richard M. Stallman <rms@gnu.org>
parents:
15564
diff
changeset
|
334 (if minibuffer |
74fc923ff6d5
(tmm-add-one-shortcut): New subroutine.
Richard M. Stallman <rms@gnu.org>
parents:
15564
diff
changeset
|
335 (progn |
74fc923ff6d5
(tmm-add-one-shortcut): New subroutine.
Richard M. Stallman <rms@gnu.org>
parents:
15564
diff
changeset
|
336 (define-key map [pageup] 'tmm-goto-completions) |
74fc923ff6d5
(tmm-add-one-shortcut): New subroutine.
Richard M. Stallman <rms@gnu.org>
parents:
15564
diff
changeset
|
337 (define-key map [prior] 'tmm-goto-completions) |
74fc923ff6d5
(tmm-add-one-shortcut): New subroutine.
Richard M. Stallman <rms@gnu.org>
parents:
15564
diff
changeset
|
338 (define-key map "\ev" 'tmm-goto-completions) |
74fc923ff6d5
(tmm-add-one-shortcut): New subroutine.
Richard M. Stallman <rms@gnu.org>
parents:
15564
diff
changeset
|
339 (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
|
340 (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
|
341 (prog1 (current-local-map) |
74fc923ff6d5
(tmm-add-one-shortcut): New subroutine.
Richard M. Stallman <rms@gnu.org>
parents:
15564
diff
changeset
|
342 (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
|
343 |
74fc923ff6d5
(tmm-add-one-shortcut): New subroutine.
Richard M. Stallman <rms@gnu.org>
parents:
15564
diff
changeset
|
344 (defun tmm-completion-delete-prompt () |
74fc923ff6d5
(tmm-add-one-shortcut): New subroutine.
Richard M. Stallman <rms@gnu.org>
parents:
15564
diff
changeset
|
345 (set-buffer standard-output) |
94088
8518c76e4083
(tmm-completion-delete-prompt): Don't hardcode point-min==1.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
87649
diff
changeset
|
346 (goto-char (point-min)) |
8518c76e4083
(tmm-completion-delete-prompt): Don't hardcode point-min==1.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
87649
diff
changeset
|
347 (delete-region (point) (search-forward "Possible completions are:\n"))) |
13480
edc4a329403e
(tmm-define-keys): New subroutine.
Richard M. Stallman <rms@gnu.org>
parents:
13337
diff
changeset
|
348 |
62972
6331f03975bb
(tmm-inactive-face): New face.
Nick Roberts <nickrob@snap.net.nz>
parents:
62572
diff
changeset
|
349 (defun tmm-remove-inactive-mouse-face () |
6331f03975bb
(tmm-inactive-face): New face.
Nick Roberts <nickrob@snap.net.nz>
parents:
62572
diff
changeset
|
350 "Remove the mouse-face property from inactive menu items." |
6331f03975bb
(tmm-inactive-face): New face.
Nick Roberts <nickrob@snap.net.nz>
parents:
62572
diff
changeset
|
351 (let ((inhibit-read-only t) |
6331f03975bb
(tmm-inactive-face): New face.
Nick Roberts <nickrob@snap.net.nz>
parents:
62572
diff
changeset
|
352 (inactive-string |
6331f03975bb
(tmm-inactive-face): New face.
Nick Roberts <nickrob@snap.net.nz>
parents:
62572
diff
changeset
|
353 (concat " " (make-string (length tmm-mid-prompt) ?\-))) |
6331f03975bb
(tmm-inactive-face): New face.
Nick Roberts <nickrob@snap.net.nz>
parents:
62572
diff
changeset
|
354 next) |
6331f03975bb
(tmm-inactive-face): New face.
Nick Roberts <nickrob@snap.net.nz>
parents:
62572
diff
changeset
|
355 (save-excursion |
6331f03975bb
(tmm-inactive-face): New face.
Nick Roberts <nickrob@snap.net.nz>
parents:
62572
diff
changeset
|
356 (goto-char (point-min)) |
6331f03975bb
(tmm-inactive-face): New face.
Nick Roberts <nickrob@snap.net.nz>
parents:
62572
diff
changeset
|
357 (while (not (eobp)) |
6331f03975bb
(tmm-inactive-face): New face.
Nick Roberts <nickrob@snap.net.nz>
parents:
62572
diff
changeset
|
358 (setq next (next-single-char-property-change (point) 'mouse-face)) |
6331f03975bb
(tmm-inactive-face): New face.
Nick Roberts <nickrob@snap.net.nz>
parents:
62572
diff
changeset
|
359 (when (looking-at inactive-string) |
6331f03975bb
(tmm-inactive-face): New face.
Nick Roberts <nickrob@snap.net.nz>
parents:
62572
diff
changeset
|
360 (remove-text-properties (point) next '(mouse-face)) |
63082
24720eb84061
(tmm-inactive, tmm-remove-inactive-mouse-face):
Juri Linkov <juri@jurta.org>
parents:
63054
diff
changeset
|
361 (add-text-properties (point) next '(face tmm-inactive))) |
62972
6331f03975bb
(tmm-inactive-face): New face.
Nick Roberts <nickrob@snap.net.nz>
parents:
62572
diff
changeset
|
362 (goto-char next))) |
6331f03975bb
(tmm-inactive-face): New face.
Nick Roberts <nickrob@snap.net.nz>
parents:
62572
diff
changeset
|
363 (set-buffer-modified-p nil))) |
6331f03975bb
(tmm-inactive-face): New face.
Nick Roberts <nickrob@snap.net.nz>
parents:
62572
diff
changeset
|
364 |
10955 | 365 (defun tmm-add-prompt () |
366 (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
|
367 (add-hook 'minibuffer-exit-hook 'tmm-delete-map nil t) |
62972
6331f03975bb
(tmm-inactive-face): New face.
Nick Roberts <nickrob@snap.net.nz>
parents:
62572
diff
changeset
|
368 (unless tmm-c-prompt |
6331f03975bb
(tmm-inactive-face): New face.
Nick Roberts <nickrob@snap.net.nz>
parents:
62572
diff
changeset
|
369 (error "No active menu entries")) |
13480
edc4a329403e
(tmm-define-keys): New subroutine.
Richard M. Stallman <rms@gnu.org>
parents:
13337
diff
changeset
|
370 (let ((win (selected-window))) |
16040
74fc923ff6d5
(tmm-add-one-shortcut): New subroutine.
Richard M. Stallman <rms@gnu.org>
parents:
15564
diff
changeset
|
371 (setq tmm-old-mb-map (tmm-define-keys t)) |
10955 | 372 ;; Get window and hide it for electric mode to get correct size |
42991
2cc71fdee37e
(tmm-get-keymap): Honour :visible in `menu-item'.
Pavel Janík <Pavel@Janik.cz>
parents:
41483
diff
changeset
|
373 (save-window-excursion |
13334
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
374 (let ((completions |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
375 (mapcar 'car minibuffer-completion-table))) |
16040
74fc923ff6d5
(tmm-add-one-shortcut): New subroutine.
Richard M. Stallman <rms@gnu.org>
parents:
15564
diff
changeset
|
376 (or tmm-completion-prompt |
74fc923ff6d5
(tmm-add-one-shortcut): New subroutine.
Richard M. Stallman <rms@gnu.org>
parents:
15564
diff
changeset
|
377 (add-hook 'completion-setup-hook |
74fc923ff6d5
(tmm-add-one-shortcut): New subroutine.
Richard M. Stallman <rms@gnu.org>
parents:
15564
diff
changeset
|
378 'tmm-completion-delete-prompt 'append)) |
94088
8518c76e4083
(tmm-completion-delete-prompt): Don't hardcode point-min==1.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
87649
diff
changeset
|
379 (unwind-protect |
8518c76e4083
(tmm-completion-delete-prompt): Don't hardcode point-min==1.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
87649
diff
changeset
|
380 (with-output-to-temp-buffer "*Completions*" |
8518c76e4083
(tmm-completion-delete-prompt): Don't hardcode point-min==1.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
87649
diff
changeset
|
381 (display-completion-list completions)) |
8518c76e4083
(tmm-completion-delete-prompt): Don't hardcode point-min==1.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
87649
diff
changeset
|
382 (remove-hook 'completion-setup-hook 'tmm-completion-delete-prompt))) |
62972
6331f03975bb
(tmm-inactive-face): New face.
Nick Roberts <nickrob@snap.net.nz>
parents:
62572
diff
changeset
|
383 (set-buffer "*Completions*") |
6331f03975bb
(tmm-inactive-face): New face.
Nick Roberts <nickrob@snap.net.nz>
parents:
62572
diff
changeset
|
384 (tmm-remove-inactive-mouse-face) |
37811
b496c10108cb
(tmm-get-keymap): Fix handling of :filter.
Gerd Moellmann <gerd@gnu.org>
parents:
34281
diff
changeset
|
385 (when tmm-completion-prompt |
b496c10108cb
(tmm-get-keymap): Fix handling of :filter.
Gerd Moellmann <gerd@gnu.org>
parents:
34281
diff
changeset
|
386 (let ((buffer-read-only nil)) |
b496c10108cb
(tmm-get-keymap): Fix handling of :filter.
Gerd Moellmann <gerd@gnu.org>
parents:
34281
diff
changeset
|
387 (goto-char (point-min)) |
b496c10108cb
(tmm-get-keymap): Fix handling of :filter.
Gerd Moellmann <gerd@gnu.org>
parents:
34281
diff
changeset
|
388 (insert tmm-completion-prompt)))) |
18810
de905e8be2e0
(tmm-prompt): Use save-excursion around completing-read code.
Richard M. Stallman <rms@gnu.org>
parents:
16922
diff
changeset
|
389 (save-selected-window |
10955 | 390 (other-window 1) ; Electric-pop-up-window does |
391 ; 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
|
392 (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
|
393 (with-current-buffer "*Completions*" |
de905e8be2e0
(tmm-prompt): Use save-excursion around completing-read code.
Richard M. Stallman <rms@gnu.org>
parents:
16922
diff
changeset
|
394 (setq tmm-old-comp-map (tmm-define-keys nil)))) |
10955 | 395 (insert tmm-c-prompt))) |
396 | |
397 (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
|
398 (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
|
399 (if tmm-old-mb-map |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
400 (use-local-map tmm-old-mb-map))) |
10955 | 401 |
402 (defun tmm-shortcut () | |
13334
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
403 "Choose the shortcut that the user typed." |
10955 | 404 (interactive) |
16040
74fc923ff6d5
(tmm-add-one-shortcut): New subroutine.
Richard M. Stallman <rms@gnu.org>
parents:
15564
diff
changeset
|
405 (let ((c last-command-char) s) |
74fc923ff6d5
(tmm-add-one-shortcut): New subroutine.
Richard M. Stallman <rms@gnu.org>
parents:
15564
diff
changeset
|
406 (if (symbolp tmm-shortcut-style) |
74fc923ff6d5
(tmm-add-one-shortcut): New subroutine.
Richard M. Stallman <rms@gnu.org>
parents:
15564
diff
changeset
|
407 (setq c (funcall tmm-shortcut-style c))) |
74fc923ff6d5
(tmm-add-one-shortcut): New subroutine.
Richard M. Stallman <rms@gnu.org>
parents:
15564
diff
changeset
|
408 (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
|
409 (if (equal (buffer-name) "*Completions*") |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
410 (progn |
62572
f7490b212956
(tmm-shortcut): Avoid using beginning-of-buffer.
Richard M. Stallman <rms@gnu.org>
parents:
62302
diff
changeset
|
411 (goto-char (point-min)) |
13334
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
412 (re-search-forward |
16040
74fc923ff6d5
(tmm-add-one-shortcut): New subroutine.
Richard M. Stallman <rms@gnu.org>
parents:
15564
diff
changeset
|
413 (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
|
414 (choose-completion)) |
27289
f6c878d8527c
(tmm-shortcut): Delete region after prompt instead
Gerd Moellmann <gerd@gnu.org>
parents:
22482
diff
changeset
|
415 ;; In minibuffer |
f6c878d8527c
(tmm-shortcut): Delete region after prompt instead
Gerd Moellmann <gerd@gnu.org>
parents:
22482
diff
changeset
|
416 (delete-region (minibuffer-prompt-end) (point-max)) |
31675
a8e0d20f0043
Replace mapcar with mapc in several places.
Dave Love <fx@gnu.org>
parents:
29290
diff
changeset
|
417 (mapc (lambda (elt) |
a8e0d20f0043
Replace mapcar with mapc in several places.
Dave Love <fx@gnu.org>
parents:
29290
diff
changeset
|
418 (if (string= |
42991
2cc71fdee37e
(tmm-get-keymap): Honour :visible in `menu-item'.
Pavel Janík <Pavel@Janik.cz>
parents:
41483
diff
changeset
|
419 (substring (car elt) 0 |
31675
a8e0d20f0043
Replace mapcar with mapc in several places.
Dave Love <fx@gnu.org>
parents:
29290
diff
changeset
|
420 (min (1+ (length tmm-mid-prompt)) |
a8e0d20f0043
Replace mapcar with mapc in several places.
Dave Love <fx@gnu.org>
parents:
29290
diff
changeset
|
421 (length (car elt)))) |
a8e0d20f0043
Replace mapcar with mapc in several places.
Dave Love <fx@gnu.org>
parents:
29290
diff
changeset
|
422 (concat (char-to-string c) tmm-mid-prompt)) |
a8e0d20f0043
Replace mapcar with mapc in several places.
Dave Love <fx@gnu.org>
parents:
29290
diff
changeset
|
423 (setq s (car elt)))) |
13334
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
424 tmm-km-list) |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
425 (insert s) |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
426 (exit-minibuffer))))) |
10955 | 427 |
428 (defun tmm-goto-completions () | |
429 (interactive) | |
27350
5834ff22d8ce
(tmm-goto-completions): Adapt to prompt being part
Gerd Moellmann <gerd@gnu.org>
parents:
27289
diff
changeset
|
430 (let ((prompt-end (minibuffer-prompt-end))) |
5834ff22d8ce
(tmm-goto-completions): Adapt to prompt being part
Gerd Moellmann <gerd@gnu.org>
parents:
27289
diff
changeset
|
431 (setq tmm-c-prompt (buffer-substring prompt-end (point-max))) |
5834ff22d8ce
(tmm-goto-completions): Adapt to prompt being part
Gerd Moellmann <gerd@gnu.org>
parents:
27289
diff
changeset
|
432 (delete-region prompt-end (point-max))) |
13334
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
433 (switch-to-buffer-other-window "*Completions*") |
10955 | 434 (search-forward tmm-c-prompt) |
435 (search-backward tmm-c-prompt)) | |
436 | |
42991
2cc71fdee37e
(tmm-get-keymap): Honour :visible in `menu-item'.
Pavel Janík <Pavel@Janik.cz>
parents:
41483
diff
changeset
|
437 (defun tmm-get-keymap (elt &optional in-x-menu) |
10955 | 438 "Prepends (DOCSTRING EVENT BINDING) to free variable `tmm-km-list'. |
439 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
|
440 element of keymap, an `x-popup-menu' argument, or an element of |
10955 | 441 `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
|
442 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
|
443 It uses the free variable `tmm-table-undef' to keep undefined keys." |
62302
587868b19cb8
(tmm-get-keymap): Include only active menus and menu items.
Nick Roberts <nickrob@snap.net.nz>
parents:
52401
diff
changeset
|
444 (let (km str cache plist filter visible enable (event (car elt))) |
10955 | 445 (setq elt (cdr elt)) |
446 (if (eq elt 'undefined) | |
447 (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
|
448 (unless (assoc event tmm-table-undef) |
8a45c0e518fa
(tmm-get-keymap): Handle `menu-item' menu items.
Karl Heuer <kwzh@gnu.org>
parents:
21088
diff
changeset
|
449 (cond ((if (listp elt) |
8a45c0e518fa
(tmm-get-keymap): Handle `menu-item' menu items.
Karl Heuer <kwzh@gnu.org>
parents:
21088
diff
changeset
|
450 (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
|
451 (fboundp elt)) |
8a45c0e518fa
(tmm-get-keymap): Handle `menu-item' menu items.
Karl Heuer <kwzh@gnu.org>
parents:
21088
diff
changeset
|
452 (setq km elt)) |
37811
b496c10108cb
(tmm-get-keymap): Fix handling of :filter.
Gerd Moellmann <gerd@gnu.org>
parents:
34281
diff
changeset
|
453 |
21495
8a45c0e518fa
(tmm-get-keymap): Handle `menu-item' menu items.
Karl Heuer <kwzh@gnu.org>
parents:
21088
diff
changeset
|
454 ((if (listp (cdr-safe elt)) |
8a45c0e518fa
(tmm-get-keymap): Handle `menu-item' menu items.
Karl Heuer <kwzh@gnu.org>
parents:
21088
diff
changeset
|
455 (or (keymapp (cdr-safe elt)) |
8a45c0e518fa
(tmm-get-keymap): Handle `menu-item' menu items.
Karl Heuer <kwzh@gnu.org>
parents:
21088
diff
changeset
|
456 (eq (car (cdr-safe elt)) 'lambda)) |
8a45c0e518fa
(tmm-get-keymap): Handle `menu-item' menu items.
Karl Heuer <kwzh@gnu.org>
parents:
21088
diff
changeset
|
457 (fboundp (cdr-safe elt))) |
8a45c0e518fa
(tmm-get-keymap): Handle `menu-item' menu items.
Karl Heuer <kwzh@gnu.org>
parents:
21088
diff
changeset
|
458 (setq km (cdr elt)) |
8a45c0e518fa
(tmm-get-keymap): Handle `menu-item' menu items.
Karl Heuer <kwzh@gnu.org>
parents:
21088
diff
changeset
|
459 (and (stringp (car elt)) (setq str (car elt)))) |
37811
b496c10108cb
(tmm-get-keymap): Fix handling of :filter.
Gerd Moellmann <gerd@gnu.org>
parents:
34281
diff
changeset
|
460 |
21495
8a45c0e518fa
(tmm-get-keymap): Handle `menu-item' menu items.
Karl Heuer <kwzh@gnu.org>
parents:
21088
diff
changeset
|
461 ((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
|
462 (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
|
463 (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
|
464 (fboundp (cdr-safe (cdr-safe elt)))) |
8a45c0e518fa
(tmm-get-keymap): Handle `menu-item' menu items.
Karl Heuer <kwzh@gnu.org>
parents:
21088
diff
changeset
|
465 (setq km (cdr (cdr elt))) |
8a45c0e518fa
(tmm-get-keymap): Handle `menu-item' menu items.
Karl Heuer <kwzh@gnu.org>
parents:
21088
diff
changeset
|
466 (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
|
467 (and str |
8a45c0e518fa
(tmm-get-keymap): Handle `menu-item' menu items.
Karl Heuer <kwzh@gnu.org>
parents:
21088
diff
changeset
|
468 (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
|
469 (setq cache (cdr (car (cdr elt)))) |
8a45c0e518fa
(tmm-get-keymap): Handle `menu-item' menu items.
Karl Heuer <kwzh@gnu.org>
parents:
21088
diff
changeset
|
470 cache (setq str (concat str cache)))) |
37811
b496c10108cb
(tmm-get-keymap): Fix handling of :filter.
Gerd Moellmann <gerd@gnu.org>
parents:
34281
diff
changeset
|
471 |
21495
8a45c0e518fa
(tmm-get-keymap): Handle `menu-item' menu items.
Karl Heuer <kwzh@gnu.org>
parents:
21088
diff
changeset
|
472 ((eq (car-safe elt) 'menu-item) |
37811
b496c10108cb
(tmm-get-keymap): Fix handling of :filter.
Gerd Moellmann <gerd@gnu.org>
parents:
34281
diff
changeset
|
473 ;; (menu-item TITLE COMMAND KEY ...) |
22482
eb09852bfc05
(tmm-get-keymap): Handle :filter.
Richard M. Stallman <rms@gnu.org>
parents:
21952
diff
changeset
|
474 (setq plist (cdr-safe (cdr-safe (cdr-safe elt)))) |
37811
b496c10108cb
(tmm-get-keymap): Fix handling of :filter.
Gerd Moellmann <gerd@gnu.org>
parents:
34281
diff
changeset
|
475 (when (consp (car-safe plist)) |
b496c10108cb
(tmm-get-keymap): Fix handling of :filter.
Gerd Moellmann <gerd@gnu.org>
parents:
34281
diff
changeset
|
476 (setq plist (cdr-safe plist))) |
21495
8a45c0e518fa
(tmm-get-keymap): Handle `menu-item' menu items.
Karl Heuer <kwzh@gnu.org>
parents:
21088
diff
changeset
|
477 (setq km (nth 2 elt)) |
34137
c95b5f588978
(tmm-get-keymap): Eval the menu name in `menu-item'.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
31675
diff
changeset
|
478 (setq str (eval (nth 1 elt))) |
22482
eb09852bfc05
(tmm-get-keymap): Handle :filter.
Richard M. Stallman <rms@gnu.org>
parents:
21952
diff
changeset
|
479 (setq filter (plist-get plist :filter)) |
eb09852bfc05
(tmm-get-keymap): Handle :filter.
Richard M. Stallman <rms@gnu.org>
parents:
21952
diff
changeset
|
480 (if filter |
eb09852bfc05
(tmm-get-keymap): Handle :filter.
Richard M. Stallman <rms@gnu.org>
parents:
21952
diff
changeset
|
481 (setq km (funcall filter km))) |
42991
2cc71fdee37e
(tmm-get-keymap): Honour :visible in `menu-item'.
Pavel Janík <Pavel@Janik.cz>
parents:
41483
diff
changeset
|
482 (setq visible (plist-get plist :visible)) |
2cc71fdee37e
(tmm-get-keymap): Honour :visible in `menu-item'.
Pavel Janík <Pavel@Janik.cz>
parents:
41483
diff
changeset
|
483 (if visible |
2cc71fdee37e
(tmm-get-keymap): Honour :visible in `menu-item'.
Pavel Janík <Pavel@Janik.cz>
parents:
41483
diff
changeset
|
484 (setq km (and (eval visible) km))) |
62302
587868b19cb8
(tmm-get-keymap): Include only active menus and menu items.
Nick Roberts <nickrob@snap.net.nz>
parents:
52401
diff
changeset
|
485 (setq enable (plist-get plist :enable)) |
587868b19cb8
(tmm-get-keymap): Include only active menus and menu items.
Nick Roberts <nickrob@snap.net.nz>
parents:
52401
diff
changeset
|
486 (if enable |
62972
6331f03975bb
(tmm-inactive-face): New face.
Nick Roberts <nickrob@snap.net.nz>
parents:
62572
diff
changeset
|
487 (setq km (if (eval enable) km 'ignore))) |
21495
8a45c0e518fa
(tmm-get-keymap): Handle `menu-item' menu items.
Karl Heuer <kwzh@gnu.org>
parents:
21088
diff
changeset
|
488 (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
|
489 (consp (nth 3 elt)) |
21952
e71c5e32d385
(tmm-get-keymap): Fix previous change;
Richard M. Stallman <rms@gnu.org>
parents:
21688
diff
changeset
|
490 (stringp (cdr (nth 3 elt))) ; keyseq cache |
e71c5e32d385
(tmm-get-keymap): Fix previous change;
Richard M. Stallman <rms@gnu.org>
parents:
21688
diff
changeset
|
491 (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
|
492 cache |
8a45c0e518fa
(tmm-get-keymap): Handle `menu-item' menu items.
Karl Heuer <kwzh@gnu.org>
parents:
21088
diff
changeset
|
493 (setq str (concat str cache)))) |
37811
b496c10108cb
(tmm-get-keymap): Fix handling of :filter.
Gerd Moellmann <gerd@gnu.org>
parents:
34281
diff
changeset
|
494 |
21495
8a45c0e518fa
(tmm-get-keymap): Handle `menu-item' menu items.
Karl Heuer <kwzh@gnu.org>
parents:
21088
diff
changeset
|
495 ((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
|
496 (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
|
497 (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
|
498 (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
|
499 ; New style of easy-menu |
8a45c0e518fa
(tmm-get-keymap): Handle `menu-item' menu items.
Karl Heuer <kwzh@gnu.org>
parents:
21088
diff
changeset
|
500 (setq km (cdr (cdr (cdr elt)))) |
8a45c0e518fa
(tmm-get-keymap): Handle `menu-item' menu items.
Karl Heuer <kwzh@gnu.org>
parents:
21088
diff
changeset
|
501 (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
|
502 (and str |
8a45c0e518fa
(tmm-get-keymap): Handle `menu-item' menu items.
Karl Heuer <kwzh@gnu.org>
parents:
21088
diff
changeset
|
503 (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
|
504 (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
|
505 cache (setq str (concat str cache)))) |
37811
b496c10108cb
(tmm-get-keymap): Fix handling of :filter.
Gerd Moellmann <gerd@gnu.org>
parents:
34281
diff
changeset
|
506 |
21495
8a45c0e518fa
(tmm-get-keymap): Handle `menu-item' menu items.
Karl Heuer <kwzh@gnu.org>
parents:
21088
diff
changeset
|
507 ((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
|
508 (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
|
509 (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
|
510 (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
|
511 )))) |
10955 | 512 (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
|
513 ;; 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
|
514 ;; 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
|
515 (when (and km (symbolp km) (get km 'menu-enable)) |
62972
6331f03975bb
(tmm-inactive-face): New face.
Nick Roberts <nickrob@snap.net.nz>
parents:
62572
diff
changeset
|
516 (setq km (if (eval (get km 'menu-enable)) km 'ignore))) |
10955 | 517 (and km str |
518 (or (assoc str tmm-km-list) | |
34137
c95b5f588978
(tmm-get-keymap): Eval the menu name in `menu-item'.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
31675
diff
changeset
|
519 (push (cons str (cons event km)) tmm-km-list)))))) |
10955 | 520 |
521 (defun tmm-get-keybind (keyseq) | |
13334
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
522 "Return the current binding of KEYSEQ, merging prefix definitions. |
14011 | 523 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
|
524 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
|
525 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
|
526 of `menu-bar-final-items'." |
76905
624ef730616c
(tmm-c-prompt): Initialize.
Nick Roberts <nickrob@snap.net.nz>
parents:
76802
diff
changeset
|
527 (let (allbind bind minorbind localbind globalbind) |
13334
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
528 (setq bind (key-binding keyseq)) |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
529 ;; 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
|
530 ;; 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
|
531 (if (keymapp bind) |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
532 (setq bind nil)) |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
533 ;; 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
|
534 (or bind |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
535 (progn |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
536 ;; 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
|
537 ;; Make a list of all the bindings in all the keymaps. |
76905
624ef730616c
(tmm-c-prompt): Initialize.
Nick Roberts <nickrob@snap.net.nz>
parents:
76802
diff
changeset
|
538 (setq minorbind (mapcar 'cdr (minor-mode-key-binding keyseq))) |
624ef730616c
(tmm-c-prompt): Initialize.
Nick Roberts <nickrob@snap.net.nz>
parents:
76802
diff
changeset
|
539 (setq localbind (local-key-binding keyseq)) |
77198
4588da3832c6
(tmm-get-keybind): Use copy-sequence to ensure that the
Nick Roberts <nickrob@snap.net.nz>
parents:
77162
diff
changeset
|
540 (setq globalbind (copy-sequence (cdr (global-key-binding keyseq)))) |
76905
624ef730616c
(tmm-c-prompt): Initialize.
Nick Roberts <nickrob@snap.net.nz>
parents:
76802
diff
changeset
|
541 |
624ef730616c
(tmm-c-prompt): Initialize.
Nick Roberts <nickrob@snap.net.nz>
parents:
76802
diff
changeset
|
542 ;; If items have been redefined/undefined locally, remove them from |
624ef730616c
(tmm-c-prompt): Initialize.
Nick Roberts <nickrob@snap.net.nz>
parents:
76802
diff
changeset
|
543 ;; the global list. |
624ef730616c
(tmm-c-prompt): Initialize.
Nick Roberts <nickrob@snap.net.nz>
parents:
76802
diff
changeset
|
544 (dolist (minor minorbind) |
624ef730616c
(tmm-c-prompt): Initialize.
Nick Roberts <nickrob@snap.net.nz>
parents:
76802
diff
changeset
|
545 (dolist (item (cdr minor)) |
77162
3c1a4db3e853
(tmm-get-keybind): Use car-safe to avoid errors with
Nick Roberts <nickrob@snap.net.nz>
parents:
76911
diff
changeset
|
546 (setq globalbind (assq-delete-all (car-safe item) globalbind)))) |
76905
624ef730616c
(tmm-c-prompt): Initialize.
Nick Roberts <nickrob@snap.net.nz>
parents:
76802
diff
changeset
|
547 (dolist (item (cdr localbind)) |
77162
3c1a4db3e853
(tmm-get-keybind): Use car-safe to avoid errors with
Nick Roberts <nickrob@snap.net.nz>
parents:
76911
diff
changeset
|
548 (setq globalbind (assq-delete-all (car-safe item) globalbind))) |
76905
624ef730616c
(tmm-c-prompt): Initialize.
Nick Roberts <nickrob@snap.net.nz>
parents:
76802
diff
changeset
|
549 |
624ef730616c
(tmm-c-prompt): Initialize.
Nick Roberts <nickrob@snap.net.nz>
parents:
76802
diff
changeset
|
550 (setq globalbind (cons 'keymap globalbind)) |
624ef730616c
(tmm-c-prompt): Initialize.
Nick Roberts <nickrob@snap.net.nz>
parents:
76802
diff
changeset
|
551 (setq allbind (cons globalbind (cons localbind minorbind))) |
624ef730616c
(tmm-c-prompt): Initialize.
Nick Roberts <nickrob@snap.net.nz>
parents:
76802
diff
changeset
|
552 |
13334
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
553 ;; Merge all the elements of ALLBIND into one keymap. |
31675
a8e0d20f0043
Replace mapcar with mapc in several places.
Dave Love <fx@gnu.org>
parents:
29290
diff
changeset
|
554 (mapc (lambda (in) |
a8e0d20f0043
Replace mapcar with mapc in several places.
Dave Love <fx@gnu.org>
parents:
29290
diff
changeset
|
555 (if (and (symbolp in) (keymapp in)) |
a8e0d20f0043
Replace mapcar with mapc in several places.
Dave Love <fx@gnu.org>
parents:
29290
diff
changeset
|
556 (setq in (symbol-function in))) |
a8e0d20f0043
Replace mapcar with mapc in several places.
Dave Love <fx@gnu.org>
parents:
29290
diff
changeset
|
557 (and in (keymapp in) |
a8e0d20f0043
Replace mapcar with mapc in several places.
Dave Love <fx@gnu.org>
parents:
29290
diff
changeset
|
558 (if (keymapp bind) |
a8e0d20f0043
Replace mapcar with mapc in several places.
Dave Love <fx@gnu.org>
parents:
29290
diff
changeset
|
559 (setq bind (nconc bind (copy-sequence (cdr in)))) |
a8e0d20f0043
Replace mapcar with mapc in several places.
Dave Love <fx@gnu.org>
parents:
29290
diff
changeset
|
560 (setq bind (copy-sequence in))))) |
13334
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
561 allbind) |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
562 ;; Return that keymap. |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
563 bind)))) |
10955 | 564 |
84430
490362706869
Remove spurious * in docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
83648
diff
changeset
|
565 ;; Huh? What's that about? --Stef |
10955 | 566 (add-hook 'calendar-load-hook (lambda () (require 'cal-menu))) |
567 | |
568 (provide 'tmm) | |
569 | |
84430
490362706869
Remove spurious * in docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
83648
diff
changeset
|
570 ;; arch-tag: e7ddbdb6-4b95-4da3-afbe-ad6063d112f4 |
10955 | 571 ;;; tmm.el ends here |