Mercurial > emacs
annotate lisp/tmm.el @ 13896:d23e1ac7b432
Doc fixes.
(ff-get-file): Use get-file-buffer to avoid false match.
(ff-switch-to-buffer): Rename arg FILE to BUFFER-OR-NAME.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Sun, 31 Dec 1995 00:10:18 +0000 |
parents | e69e87bdc813 |
children | 1319e4b9aa6c |
rev | line source |
---|---|
13337 | 1 ;;; tmm.el --- text mode access to menu-bar |
10955 | 2 |
3 ;; Copyright (C) 1994, 1995 Free Software Foundation, Inc. | |
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 | |
21 ;; along with GNU Emacs; see the file COPYING. If not, write to | |
22 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | |
23 | |
24 ;;; Commentary ============================================================ | |
25 | |
26 ;;; To use this package add | |
27 | |
28 ;;; (autoload 'tmm-menubar 'tmm "Text mode substitute for menubar" t) | |
29 ;;; (global-set-key [f10] 'tmm-menubar) | |
30 | |
31 ;;; to your .emacs file. You can also add your own access to different | |
32 ;;; menus available in Window System Emacs modelling definition after | |
33 ;;; tmm-menubar. | |
34 | |
35 (require 'electric) | |
36 | |
37 ;;; The following will be localized, added only to pacify the compiler. | |
38 (defvar tmm-short-cuts) | |
13334
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
39 (defvar tmm-old-mb-map nil) |
10955 | 40 (defvar tmm-old-comp-map) |
41 (defvar tmm-c-prompt) | |
42 (defvar tmm-km-list) | |
43 (defvar tmm-table-undef) | |
44 | |
12960
6db607a7b62d
Fix typo in global-map define.
Richard M. Stallman <rms@gnu.org>
parents:
12763
diff
changeset
|
45 ;;;###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
|
46 ;;;###autoload (define-key global-map [f10] 'tmm-menubar) |
13499
309b1a308079
Define menu-bar mouse-1 as tmm-menubar.
Richard M. Stallman <rms@gnu.org>
parents:
13480
diff
changeset
|
47 ;;;###autoload (define-key global-map [menu-bar mouse-1] 'tmm-menubar) |
12763
b8e986069a58
Don't alter bindings in minibuffer-local-must-match-map
Richard M. Stallman <rms@gnu.org>
parents:
10956
diff
changeset
|
48 |
10955 | 49 ;;;###autoload |
50 (defun tmm-menubar () | |
51 "Text-mode emulation of looking and choosing from a menubar. | |
52 See the documentation for `tmm-prompt'." | |
53 (interactive) | |
54 (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
|
55 ;; Obey menu-bar-final-items; put those items last. |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
56 (let ((menu-bar (tmm-get-keybind [menu-bar]))) |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
57 (let ((list menu-bar-final-items)) |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
58 (while list |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
59 (let ((item (car list))) |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
60 ;; 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
|
61 ;; 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
|
62 (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
|
63 (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
|
64 (list this-one))))) |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
65 (setq list (cdr list)))) |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
66 (tmm-prompt menu-bar))) |
10955 | 67 |
68 (defvar tmm-mid-prompt "==>" | |
69 "String to insert between shortcut and menu item or nil.") | |
70 | |
71 (defvar tmm-mb-map nil | |
72 "A place to store minibuffer map.") | |
73 | |
74 (defvar tmm-completion-prompt | |
75 "Press PageUp Key to reach this buffer from the minibuffer. | |
76 Alternatively, you can use Up/Down keys (or your History keys) to change | |
77 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
|
78 marked letters to pick up your choice. Type C-g or ESC ESC ESC to cancel. |
10955 | 79 " |
80 "What insert on top of completion buffer.") | |
81 | |
82 ;;;###autoload | |
83 (defun tmm-prompt (bind &optional in-popup) | |
84 "Text-mode emulation of calling the bindings in keymap. | |
85 Creates a text-mode menu of possible choices. You can access the elements | |
86 in the menu: | |
87 *) Either via history mechanism from minibuffer; | |
88 *) Or via completion-buffer that is automatically shown. | |
89 The last alternative is currently a hack, you cannot use mouse reliably. | |
90 If the optional argument IN-POPUP is set, is argument-compatible with | |
91 `x-popup-menu', otherwise the argument BIND should be a cdr of sparse keymap." | |
92 (if in-popup (if bind (setq bind in-popup) (x-popup-menu nil in-popup))) | |
13334
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
93 (let (gl-str tmm-km-list out history history-len tmm-table-undef tmm-c-prompt |
10955 | 94 tmm-old-mb-map tmm-old-comp-map tmm-short-cuts) |
95 (run-hooks 'activate-menubar-hook) | |
96 (mapcar (function (lambda (elt) | |
97 (if (stringp elt) | |
98 (setq gl-str elt) | |
13334
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
99 (and (listp elt) (tmm-get-keymap elt in-popup))))) |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
100 bind) |
10955 | 101 (and tmm-km-list |
13334
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
102 (progn |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
103 (if tmm-mid-prompt |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
104 (setq tmm-km-list (tmm-add-shortcuts tmm-km-list)) |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
105 t) |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
106 (setq history (reverse (mapcar 'car tmm-km-list))) |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
107 (setq history-len (length history)) |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
108 (setq history (append history history history history)) |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
109 (setq tmm-c-prompt (nth (1- history-len) history)) |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
110 (add-hook 'minibuffer-setup-hook 'tmm-add-prompt) |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
111 (unwind-protect |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
112 (setq out |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
113 (completing-read |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
114 (concat gl-str " (up/down to change, PgUp to menu): ") |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
115 tmm-km-list nil t nil |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
116 (cons 'history (* 2 history-len)))) |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
117 (save-excursion |
13581
e69e87bdc813
(tmm-prompt): Delete tmm-add-prompt if we fail.
Richard M. Stallman <rms@gnu.org>
parents:
13533
diff
changeset
|
118 (remove-hook 'minibuffer-setup-hook 'tmm-add-prompt) |
e69e87bdc813
(tmm-prompt): Delete tmm-add-prompt if we fail.
Richard M. Stallman <rms@gnu.org>
parents:
13533
diff
changeset
|
119 (if (get-buffer "*Completions*") |
e69e87bdc813
(tmm-prompt): Delete tmm-add-prompt if we fail.
Richard M. Stallman <rms@gnu.org>
parents:
13533
diff
changeset
|
120 (progn |
e69e87bdc813
(tmm-prompt): Delete tmm-add-prompt if we fail.
Richard M. Stallman <rms@gnu.org>
parents:
13533
diff
changeset
|
121 (set-buffer "*Completions*") |
e69e87bdc813
(tmm-prompt): Delete tmm-add-prompt if we fail.
Richard M. Stallman <rms@gnu.org>
parents:
13533
diff
changeset
|
122 (use-local-map tmm-old-comp-map) |
e69e87bdc813
(tmm-prompt): Delete tmm-add-prompt if we fail.
Richard M. Stallman <rms@gnu.org>
parents:
13533
diff
changeset
|
123 (bury-buffer (current-buffer))))) |
13334
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
124 ))) |
10955 | 125 (setq bind (cdr (assoc out tmm-km-list))) |
126 (and (null bind) | |
127 (> (length out) (length tmm-c-prompt)) | |
128 (string= (substring out 0 (length tmm-c-prompt)) tmm-c-prompt) | |
129 (setq out (substring out (length tmm-c-prompt)) | |
130 bind (cdr (assoc out tmm-km-list)))) | |
13334
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
131 (and (null bind) |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
132 (setq out (try-completion out tmm-km-list) |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
133 bind (cdr (assoc out tmm-km-list)))) |
10955 | 134 (setq last-command-event (car bind)) |
135 (setq bind (cdr bind)) | |
136 (if bind | |
137 (if in-popup (tmm-prompt t bind) | |
138 (if (keymapp bind) | |
139 (if (listp bind) | |
140 (progn | |
141 (condition-case nil | |
142 (require 'mouse) | |
143 (error nil)) | |
144 (condition-case nil | |
145 (x-popup-menu nil bind) ; Get the shortcuts | |
146 (error nil)) | |
147 (tmm-prompt bind)) | |
148 (tmm-prompt (symbol-value bind)) | |
149 ) | |
150 (if last-command-event | |
151 (call-interactively bind) | |
152 bind))) | |
153 gl-str))) | |
154 | |
155 | |
156 (defun tmm-add-shortcuts (list) | |
157 "Adds shortcuts to cars of elements of the list. | |
158 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
|
159 shortcuts added to these cars. |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
160 Stores a list of all the shortcuts in the free variable `tmm-short-cuts'." |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
161 (let ((next-shortcut-number 0)) |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
162 (mapcar (lambda (elt) |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
163 (let ((str (car elt)) f b) |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
164 (setq f (upcase (substring str 0 1))) |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
165 ;; If does not work, try beginning of the other word |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
166 (if (and (member f tmm-short-cuts) |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
167 (string-match " \\([^ ]\\)" str)) |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
168 (setq f (upcase (substring |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
169 str |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
170 (setq b (match-beginning 1)) (1+ b))))) |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
171 ;; If we don't have an unique letter shortcut, |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
172 ;; pick a digit as a shortcut instead. |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
173 (if (member f tmm-short-cuts) |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
174 (if (< next-shortcut-number 10) |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
175 (setq f (format "%d" next-shortcut-number) |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
176 next-shortcut-number (1+ next-shortcut-number)) |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
177 (setq f nil))) |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
178 (if (null f) |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
179 elt |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
180 (setq tmm-short-cuts (cons f tmm-short-cuts)) |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
181 (cons (concat f tmm-mid-prompt str) (cdr elt))))) |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
182 (reverse list)))) |
10955 | 183 |
13480
edc4a329403e
(tmm-define-keys): New subroutine.
Richard M. Stallman <rms@gnu.org>
parents:
13337
diff
changeset
|
184 (defun tmm-define-keys () |
edc4a329403e
(tmm-define-keys): New subroutine.
Richard M. Stallman <rms@gnu.org>
parents:
13337
diff
changeset
|
185 (mapcar (lambda (str) |
edc4a329403e
(tmm-define-keys): New subroutine.
Richard M. Stallman <rms@gnu.org>
parents:
13337
diff
changeset
|
186 (define-key (current-local-map) str 'tmm-shortcut) |
edc4a329403e
(tmm-define-keys): New subroutine.
Richard M. Stallman <rms@gnu.org>
parents:
13337
diff
changeset
|
187 (define-key (current-local-map) (downcase str) 'tmm-shortcut)) |
edc4a329403e
(tmm-define-keys): New subroutine.
Richard M. Stallman <rms@gnu.org>
parents:
13337
diff
changeset
|
188 tmm-short-cuts) |
edc4a329403e
(tmm-define-keys): New subroutine.
Richard M. Stallman <rms@gnu.org>
parents:
13337
diff
changeset
|
189 (define-key (current-local-map) [pageup] 'tmm-goto-completions) |
edc4a329403e
(tmm-define-keys): New subroutine.
Richard M. Stallman <rms@gnu.org>
parents:
13337
diff
changeset
|
190 (define-key (current-local-map) [prior] 'tmm-goto-completions) |
edc4a329403e
(tmm-define-keys): New subroutine.
Richard M. Stallman <rms@gnu.org>
parents:
13337
diff
changeset
|
191 (define-key (current-local-map) "\ev" 'tmm-goto-completions) |
edc4a329403e
(tmm-define-keys): New subroutine.
Richard M. Stallman <rms@gnu.org>
parents:
13337
diff
changeset
|
192 (define-key (current-local-map) "\C-n" 'next-history-element) |
edc4a329403e
(tmm-define-keys): New subroutine.
Richard M. Stallman <rms@gnu.org>
parents:
13337
diff
changeset
|
193 (define-key (current-local-map) "\C-p" 'previous-history-element)) |
edc4a329403e
(tmm-define-keys): New subroutine.
Richard M. Stallman <rms@gnu.org>
parents:
13337
diff
changeset
|
194 |
10955 | 195 (defun tmm-add-prompt () |
196 (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
|
197 (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
|
198 (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
|
199 (let ((win (selected-window))) |
10955 | 200 (setq tmm-old-mb-map (current-local-map)) |
13480
edc4a329403e
(tmm-define-keys): New subroutine.
Richard M. Stallman <rms@gnu.org>
parents:
13337
diff
changeset
|
201 (use-local-map (append (make-sparse-keymap) tmm-old-mb-map)) |
edc4a329403e
(tmm-define-keys): New subroutine.
Richard M. Stallman <rms@gnu.org>
parents:
13337
diff
changeset
|
202 (tmm-define-keys) |
10955 | 203 ;; Get window and hide it for electric mode to get correct size |
204 (save-window-excursion | |
13334
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
205 (let ((completions |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
206 (mapcar 'car minibuffer-completion-table))) |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
207 (with-output-to-temp-buffer "*Completions*" |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
208 (display-completion-list completions))) |
10955 | 209 (set-buffer "*Completions*") |
210 (goto-char 1) | |
211 (insert tmm-completion-prompt) | |
212 ) | |
213 (save-excursion | |
214 (other-window 1) ; Electric-pop-up-window does | |
215 ; not work in minibuffer | |
216 (set-buffer (window-buffer (Electric-pop-up-window "*Completions*"))) | |
217 (setq tmm-old-comp-map (current-local-map)) | |
13480
edc4a329403e
(tmm-define-keys): New subroutine.
Richard M. Stallman <rms@gnu.org>
parents:
13337
diff
changeset
|
218 (use-local-map (append (make-sparse-keymap) tmm-old-comp-map)) |
edc4a329403e
(tmm-define-keys): New subroutine.
Richard M. Stallman <rms@gnu.org>
parents:
13337
diff
changeset
|
219 (tmm-define-keys) |
10955 | 220 (select-window win) ; Cannot use |
221 ; save-window-excursion, since | |
222 ; it restores the size | |
223 ) | |
224 (insert tmm-c-prompt))) | |
225 | |
226 (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
|
227 (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
|
228 (if tmm-old-mb-map |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
229 (use-local-map tmm-old-mb-map))) |
10955 | 230 |
231 (defun tmm-shortcut () | |
13334
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
232 "Choose the shortcut that the user typed." |
10955 | 233 (interactive) |
234 (let ((c (upcase (char-to-string last-command-char))) s) | |
235 (if (member c tmm-short-cuts) | |
13334
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
236 (if (equal (buffer-name) "*Completions*") |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
237 (progn |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
238 (beginning-of-buffer) |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
239 (re-search-forward |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
240 (concat "\\(^\\|[ \t]\\)" c tmm-mid-prompt)) |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
241 (choose-completion)) |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
242 (erase-buffer) ; In minibuffer |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
243 (mapcar (lambda (elt) |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
244 (if (string= |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
245 (substring (car elt) 0 |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
246 (min (1+ (length tmm-mid-prompt)) |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
247 (length (car elt)))) |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
248 (concat c tmm-mid-prompt)) |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
249 (setq s (car elt)))) |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
250 tmm-km-list) |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
251 (insert s) |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
252 (exit-minibuffer))))) |
10955 | 253 |
254 (defun tmm-goto-completions () | |
255 (interactive) | |
256 (setq tmm-c-prompt (buffer-string)) | |
257 (erase-buffer) | |
13334
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
258 (switch-to-buffer-other-window "*Completions*") |
10955 | 259 (search-forward tmm-c-prompt) |
260 (search-backward tmm-c-prompt)) | |
261 | |
262 | |
263 (defun tmm-get-keymap (elt &optional in-x-menu) | |
264 "Prepends (DOCSTRING EVENT BINDING) to free variable `tmm-km-list'. | |
265 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
|
266 element of keymap, an `x-popup-menu' argument, or an element of |
10955 | 267 `x-popup-menu' argument (when IN-X-MENU is not-nil). |
268 Does it only if it is not already there. Uses free variable | |
269 `tmm-table-undef' to keep undefined keys." | |
270 (let (km str cache (event (car elt))) | |
271 (setq elt (cdr elt)) | |
272 (if (eq elt 'undefined) | |
273 (setq tmm-table-undef (cons (cons event nil) tmm-table-undef)) | |
274 (or | |
275 (assoc event tmm-table-undef) | |
276 (and (if (listp elt) | |
277 (keymapp elt) | |
278 (fboundp elt)) | |
279 (setq km elt)) | |
280 (and (if (listp (cdr-safe elt)) | |
281 (keymapp (cdr-safe elt)) | |
282 (fboundp (cdr-safe elt))) | |
283 (setq km (cdr elt)) | |
284 (and (stringp (car elt)) (setq str (car elt)))) | |
285 (and (if (listp (cdr-safe (cdr-safe elt))) | |
286 (keymapp (cdr-safe (cdr-safe elt))) | |
287 (fboundp (cdr-safe (cdr-safe elt)))) | |
288 (setq km (cdr (cdr elt))) | |
289 (and (stringp (car elt)) (setq str (car elt))) | |
290 (or (and str | |
291 (stringp (cdr (car (cdr elt)))) ; keyseq cache | |
292 (setq cache (cdr (car (cdr elt)))) | |
293 cache (setq str (concat str cache))) str)) | |
294 (and (if (listp (cdr-safe (cdr-safe (cdr-safe elt)))) | |
295 (keymapp (cdr-safe (cdr-safe (cdr-safe elt)))) | |
296 (fboundp (cdr-safe (cdr-safe (cdr-safe elt))))) | |
297 ; New style of easy-menu | |
298 (setq km (cdr (cdr (cdr elt)))) | |
299 (and (stringp (car elt)) (setq str (car elt))) | |
300 (or (and str | |
301 (stringp (cdr (car (cdr (cdr elt))))) ; keyseq cache | |
302 (setq cache (cdr (car (cdr (cdr elt))))) | |
303 cache (setq str (concat str cache))) | |
304 str)) | |
305 (and (stringp event) ; x-popup or x-popup element | |
306 (if (or in-x-menu (stringp (car-safe elt))) | |
307 (setq str event event nil km elt) | |
308 (setq str event event nil km (cons 'keymap elt)) | |
309 ))) | |
310 (and km (stringp km) (setq str km)) | |
311 (and km str | |
312 (or (assoc str tmm-km-list) | |
313 (setq tmm-km-list | |
314 (cons (cons str (cons event km)) tmm-km-list))) | |
315 )))) | |
316 | |
317 | |
318 (defun tmm-get-keybind (keyseq) | |
13334
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
319 "Return the current binding of KEYSEQ, merging prefix definitions. |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
320 If KEYSEQ is a prefix key that has local and gloibal bindings, |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
321 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
|
322 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
|
323 of `menu-bar-final-items'." |
10955 | 324 (let (allbind bind) |
13334
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
325 (setq bind (key-binding keyseq)) |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
326 ;; 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
|
327 ;; 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
|
328 (if (keymapp bind) |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
329 (setq bind nil)) |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
330 ;; 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
|
331 (or bind |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
332 (progn |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
333 ;; 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
|
334 ;; 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
|
335 (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
|
336 (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
|
337 (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
|
338 ;; 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
|
339 (mapcar (lambda (in) |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
340 (if (and (symbolp in) (keymapp in)) |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
341 (setq in (symbol-function in))) |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
342 (and in (keymapp in) |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
343 (if (keymapp bind) |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
344 (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
|
345 (setq bind (copy-sequence in))))) |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
346 allbind) |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
347 ;; Return that keymap. |
c55f17d3931f
(tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents:
12960
diff
changeset
|
348 bind)))) |
10955 | 349 |
350 (add-hook 'calendar-load-hook (lambda () (require 'cal-menu))) | |
351 | |
352 | |
353 (provide 'tmm) | |
354 | |
355 | |
356 ;;; tmm.el ends here |