annotate lisp/tmm.el @ 12855:2481803f0338

(vip-set-hooks): Use view-mode-hook, not view-hook.
author Karl Heuer <kwzh@gnu.org>
date Mon, 14 Aug 1995 21:56:42 +0000
parents b8e986069a58
children 6db607a7b62d
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
10955
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1 ;;; tmm.el - text mode access to menu-bar
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
3 ;; Copyright (C) 1994, 1995 Free Software Foundation, Inc.
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
4
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
5 ;; Author: Ilya Zakharevich <ilya@math.mps.ohio-state.edu>
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
6
10956
40810ac8d212 Comment change.
Richard M. Stallman <rms@gnu.org>
parents: 10955
diff changeset
7 ;; This file is part of GNU Emacs.
10955
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
8
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
9 ;; GNU Emacs is free software; you can redistribute it and/or modify
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
10 ;; it under the terms of the GNU General Public License as published by
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
11 ;; the Free Software Foundation; either version 2, or (at your option)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
12 ;; any later version.
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
13
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
14 ;; GNU Emacs is distributed in the hope that it will be useful,
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
17 ;; GNU General Public License for more details.
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
18
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
19 ;; You should have received a copy of the GNU General Public License
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
20 ;; along with GNU Emacs; see the file COPYING. If not, write to
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
21 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
22
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
23 ;;; Commentary ============================================================
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
24
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
25 ;;; To use this package add
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
26
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
27 ;;; (autoload 'tmm-menubar 'tmm "Text mode substitute for menubar" t)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
28 ;;; (global-set-key [f10] 'tmm-menubar)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
29
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
30 ;;; to your .emacs file. You can also add your own access to different
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
31 ;;; menus available in Window System Emacs modelling definition after
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
32 ;;; tmm-menubar.
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
33
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
34 (require 'electric)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
35 ;(define-key minibuffer-local-must-match-map [pageup] 'tmm-goto-completions)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
36 ;(define-key minibuffer-local-must-match-map [prior] 'tmm-goto-completions)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
37 ;(define-key minibuffer-local-must-match-map "\ev" 'tmm-goto-completions)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
38
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
39 ;;; The following will be localized, added only to pacify the compiler.
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
40 (defvar tmm-short-cuts)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
41 (defvar tmm-old-mb-map)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
42 (defvar tmm-old-comp-map)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
43 (defvar tmm-c-prompt)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
44 (defvar tmm-km-list)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
45 (defvar tmm-table-undef)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
46
12763
b8e986069a58 Don't alter bindings in minibuffer-local-must-match-map
Richard M. Stallman <rms@gnu.org>
parents: 10956
diff changeset
47 ;;;###autoload (define-key global-map "\M-`" tmm-menubar)
b8e986069a58 Don't alter bindings in minibuffer-local-must-match-map
Richard M. Stallman <rms@gnu.org>
parents: 10956
diff changeset
48
10955
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
49 ;;;###autoload
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
50 (defun tmm-menubar ()
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
51 "Text-mode emulation of looking and choosing from a menubar.
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
52 See the documentation for `tmm-prompt'."
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
53 (interactive)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
54 (run-hooks 'menu-bar-update-hook)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
55 (tmm-prompt (tmm-get-keybind [menu-bar])))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
56
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
57 (defvar tmm-mid-prompt "==>"
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
58 "String to insert between shortcut and menu item or nil.")
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
59
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
60 (defvar tmm-mb-map nil
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
61 "A place to store minibuffer map.")
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
62
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
63 (defvar tmm-completion-prompt
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
64 "Press PageUp Key to reach this buffer from the minibuffer.
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
65 Alternatively, you can use Up/Down keys (or your History keys) to change
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
66 the item in the minibuffer, and press RET when you are done, or press the
12763
b8e986069a58 Don't alter bindings in minibuffer-local-must-match-map
Richard M. Stallman <rms@gnu.org>
parents: 10956
diff changeset
67 marked letters to pick up your choice. Type ESC ESC to cancel.
10955
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
68 "
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
69 "What insert on top of completion buffer.")
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
70
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
71 ;;;###autoload
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
72 (defun tmm-prompt (bind &optional in-popup)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
73 "Text-mode emulation of calling the bindings in keymap.
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
74 Creates a text-mode menu of possible choices. You can access the elements
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
75 in the menu:
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
76 *) Either via history mechanism from minibuffer;
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
77 *) Or via completion-buffer that is automatically shown.
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
78 The last alternative is currently a hack, you cannot use mouse reliably.
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
79 If the optional argument IN-POPUP is set, is argument-compatible with
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
80 `x-popup-menu', otherwise the argument BIND should be a cdr of sparse keymap."
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
81 (if in-popup (if bind (setq bind in-popup) (x-popup-menu nil in-popup)))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
82 (let (gl-str tmm-km-list out compl-list compl-list-l tmm-table-undef tmm-c-prompt
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
83 tmm-old-mb-map tmm-old-comp-map tmm-short-cuts)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
84 (run-hooks 'activate-menubar-hook)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
85 (mapcar (function (lambda (elt)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
86 (if (stringp elt)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
87 (setq gl-str elt)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
88 (and (listp elt) (tmm-get-keymap elt in-popup)))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
89 )) bind)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
90 (and tmm-km-list
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
91 (if tmm-mid-prompt
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
92 (setq tmm-km-list (reverse (tmm-add-shortcuts tmm-km-list)))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
93 t)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
94 (setq compl-list (mapcar 'car tmm-km-list))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
95 (setq compl-list-l (length compl-list))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
96 (setq compl-list (append compl-list compl-list compl-list compl-list))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
97 (setq tmm-c-prompt (nth (1- compl-list-l) compl-list))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
98 (add-hook 'minibuffer-setup-hook 'tmm-add-prompt)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
99 (unwind-protect
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
100 (setq out
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
101 (completing-read
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
102 (concat gl-str " (up/down to change, PgUp to menu): ")
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
103 tmm-km-list nil t nil
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
104 (cons 'compl-list (* 2 compl-list-l))))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
105 ;;(add-hook 'minibuffer-setup-hook 'tmm-remove-shortcuts)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
106 ;;(save-excursion
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
107 ;; (set-buffer "*Completions*")
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
108 ;; (use-local-map tmm-old-mb-map))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
109 (save-excursion
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
110 (set-buffer "*Completions*")
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
111 (use-local-map tmm-old-comp-map)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
112 (bury-buffer (current-buffer)))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
113 ))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
114 (setq bind (cdr (assoc out tmm-km-list)))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
115 (and (null bind)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
116 (> (length out) (length tmm-c-prompt))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
117 (string= (substring out 0 (length tmm-c-prompt)) tmm-c-prompt)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
118 (setq out (substring out (length tmm-c-prompt))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
119 bind (cdr (assoc out tmm-km-list))))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
120 (setq last-command-event (car bind))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
121 (setq bind (cdr bind))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
122 (if bind
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
123 (if in-popup (tmm-prompt t bind)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
124 (if (keymapp bind)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
125 (if (listp bind)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
126 (progn
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
127 (condition-case nil
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
128 (require 'mouse)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
129 (error nil))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
130 (condition-case nil
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
131 (x-popup-menu nil bind) ; Get the shortcuts
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
132 (error nil))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
133 (tmm-prompt bind))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
134 (tmm-prompt (symbol-value bind))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
135 )
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
136 (if last-command-event
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
137 (call-interactively bind)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
138 bind)))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
139 gl-str)))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
140
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
141 (defun tmm-remove-shortcuts ()
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
142 (use-local-map tmm-mb-map))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
143
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
144 (defun tmm-add-shortcuts (list)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
145 "Adds shortcuts to cars of elements of the list.
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
146 Takes a list of lists with a string as car, returns list with
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
147 shortcuts added to these cars. Adds the shortcuts to a free variable
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
148 `tmm-short-cuts'."
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
149 (mapcar (lambda (elt)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
150 (let ((str (car elt)) f b)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
151 (setq f (upcase (substring str 0 1)))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
152 ;; If does not work, try beginning of the other word
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
153 (if (and (member f tmm-short-cuts)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
154 (string-match " \\([^ ]\\)" str))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
155 (setq f (upcase (substring
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
156 str
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
157 (setq b (match-beginning 1)) (1+ b)))))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
158 (if (member f tmm-short-cuts)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
159 elt
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
160 (setq tmm-short-cuts (cons f tmm-short-cuts))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
161 (cons (concat f tmm-mid-prompt str) (cdr elt)))))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
162 (reverse list)))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
163
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
164 (defun tmm-add-prompt ()
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
165 (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
166 (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
167 (add-hook 'minibuffer-exit-hook 'tmm-delete-map nil t)
10955
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
168 (let ((map (make-sparse-keymap)) (win (selected-window)))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
169 (mapcar (lambda (str)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
170 (define-key map str 'tmm-shortcut)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
171 (define-key map (downcase str) 'tmm-shortcut))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
172 tmm-short-cuts)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
173 (define-key map [pageup] 'tmm-goto-completions)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
174 (define-key map [prior] 'tmm-goto-completions)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
175 (define-key map "\ev" 'tmm-goto-completions)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
176 (define-key map "\e\e" 'abort-recursive-edit)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
177 (setq tmm-old-mb-map (current-local-map))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
178 (use-local-map (append map (cdr tmm-old-mb-map)))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
179 ;; Get window and hide it for electric mode to get correct size
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
180 (save-window-excursion
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
181 (minibuffer-completion-help)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
182 (set-buffer "*Completions*")
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
183 (goto-char 1)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
184 (insert tmm-completion-prompt)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
185 )
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
186 (save-excursion
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
187 (other-window 1) ; Electric-pop-up-window does
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
188 ; not work in minibuffer
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
189 (set-buffer (window-buffer (Electric-pop-up-window "*Completions*")))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
190 (setq tmm-old-comp-map (current-local-map))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
191 (use-local-map (append map (cdr tmm-old-comp-map)))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
192 (select-window win) ; Cannot use
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
193 ; save-window-excursion, since
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
194 ; it restores the size
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
195 )
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
196 (insert tmm-c-prompt)))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
197
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
198 (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
199 (remove-hook 'minibuffer-exit-hook 'tmm-delete-map t)
10955
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
200 (use-local-map tmm-old-mb-map))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
201
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
202 (defun tmm-shortcut ()
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
203 (interactive)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
204 (let ((c (upcase (char-to-string last-command-char))) s)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
205 (if (member c tmm-short-cuts)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
206 (if (equal (buffer-name) "*Completions*")
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
207 (progn
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
208 (beginning-of-buffer)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
209 (re-search-forward
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
210 (concat "\\(^\\|[ \t]\\)" c tmm-mid-prompt))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
211 (choose-completion))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
212 (erase-buffer) ; In minibuffer
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
213 (mapcar (lambda (elt)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
214 (if (string=
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
215 (substring (car elt) 0
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
216 (min (1+ (length tmm-mid-prompt))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
217 (length (car elt))))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
218 (concat c tmm-mid-prompt))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
219 (setq s (car elt))))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
220 tmm-km-list)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
221 (insert s)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
222 (exit-minibuffer)))))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
223
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
224 (defun tmm-goto-completions ()
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
225 (interactive)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
226 (setq tmm-c-prompt (buffer-string))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
227 (erase-buffer)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
228 (switch-to-buffer-other-window
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
229 "*Completions*")
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
230 (search-forward tmm-c-prompt)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
231 (search-backward tmm-c-prompt))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
232
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
233
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
234 (defun tmm-get-keymap (elt &optional in-x-menu)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
235 "Prepends (DOCSTRING EVENT BINDING) to free variable `tmm-km-list'.
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
236 The values are deduced from the argument ELT, that should be an
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
237 element of keymap, on `x-popup-menu' argument, or an element of
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
238 `x-popup-menu' argument (when IN-X-MENU is not-nil).
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
239 Does it only if it is not already there. Uses free variable
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
240 `tmm-table-undef' to keep undefined keys."
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
241 (let (km str cache (event (car elt)))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
242 (setq elt (cdr elt))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
243 (if (eq elt 'undefined)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
244 (setq tmm-table-undef (cons (cons event nil) tmm-table-undef))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
245 (or
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
246 (assoc event tmm-table-undef)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
247 (and (if (listp elt)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
248 (keymapp elt)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
249 (fboundp elt))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
250 (setq km elt))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
251 (and (if (listp (cdr-safe elt))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
252 (keymapp (cdr-safe elt))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
253 (fboundp (cdr-safe elt)))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
254 (setq km (cdr elt))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
255 (and (stringp (car elt)) (setq str (car elt))))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
256 (and (if (listp (cdr-safe (cdr-safe elt)))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
257 (keymapp (cdr-safe (cdr-safe elt)))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
258 (fboundp (cdr-safe (cdr-safe elt))))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
259 (setq km (cdr (cdr elt)))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
260 (and (stringp (car elt)) (setq str (car elt)))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
261 (or (and str
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
262 (stringp (cdr (car (cdr elt)))) ; keyseq cache
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
263 (setq cache (cdr (car (cdr elt))))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
264 cache (setq str (concat str cache))) str))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
265 (and (if (listp (cdr-safe (cdr-safe (cdr-safe elt))))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
266 (keymapp (cdr-safe (cdr-safe (cdr-safe elt))))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
267 (fboundp (cdr-safe (cdr-safe (cdr-safe elt)))))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
268 ; New style of easy-menu
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
269 (setq km (cdr (cdr (cdr elt))))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
270 (and (stringp (car elt)) (setq str (car elt)))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
271 (or (and str
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
272 (stringp (cdr (car (cdr (cdr elt))))) ; keyseq cache
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
273 (setq cache (cdr (car (cdr (cdr elt)))))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
274 cache (setq str (concat str cache)))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
275 str))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
276 (and (stringp event) ; x-popup or x-popup element
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
277 (if (or in-x-menu (stringp (car-safe elt)))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
278 (setq str event event nil km elt)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
279 (setq str event event nil km (cons 'keymap elt))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
280 )))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
281 (and km (stringp km) (setq str km))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
282 (and km str
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
283 (or (assoc str tmm-km-list)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
284 (setq tmm-km-list
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
285 (cons (cons str (cons event km)) tmm-km-list)))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
286 ))))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
287
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
288
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
289 (defun tmm-get-keybind (keyseq)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
290 "Gets binding from all the tables, can have some junk inside."
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
291 (let (allbind bind)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
292 (setq allbind (mapcar 'cdr (minor-mode-key-binding keyseq)))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
293 (setq allbind (append allbind (list (local-key-binding keyseq))))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
294 (setq allbind (append allbind (list (global-key-binding keyseq))))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
295 ; list of bindings
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
296 (mapcar (lambda (in)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
297 (if (and (symbolp in) (keymapp in))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
298 (setq in (symbol-value in)))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
299 (and in
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
300 (or (eq bind 'undefined) (not bind)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
301 (and (keymapp bind) (keymapp in)))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
302 (if (keymapp bind)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
303 (setq bind (append bind (cdr in)))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
304 (setq bind in)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
305 )
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
306 )
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
307 )
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
308 allbind)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
309 bind))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
310
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
311 (add-hook 'calendar-load-hook (lambda () (require 'cal-menu)))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
312
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
313
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
314 (provide 'tmm)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
315
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
316
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
317 ;;; tmm.el ends here