annotate lisp/tmm.el @ 15701:5db02009315e libc-1-93 libc-960716 libc-960717 libc-960718 libc-960719 libc-960720 libc-960721 libc-960722 libc-960723 libc-960724 libc-960725 libc-960726 libc-960727 libc-960728 libc-960729 libc-960730 libc-960731 libc-960801 libc-960802 libc-960803 libc-960804 libc-960805 libc-960806 libc-960807 libc-960808 libc-960809 libc-960810 libc-960811 libc-960812 libc-960813 libc-960814 libc-960815 libc-960816 libc-960817 libc-960818 libc-960819 libc-960820 libc-960821 libc-960822 libc-960823 libc-960824 libc-960825 libc-960826 libc-960827 libc-960828 libc-960829 libc-960830 libc-960831 libc-960901 libc-960902 libc-960903 libc-960904 libc-960905 libc-960906 libc-960907 libc-960908 libc-960909 libc-960910 libc-960911 libc-960912 release-0-0 release-0-1

Fix previous change. Use sed's y command instead.
author Karl Heuer <kwzh@gnu.org>
date Tue, 16 Jul 1996 04:47:46 +0000
parents 1e86b1873c5e
children 74fc923ff6d5
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
13337
84acc3adcd63 Comment change.
Richard M. Stallman <rms@gnu.org>
parents: 13334
diff changeset
1 ;;; tmm.el --- text mode access to menu-bar
10955
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2
14733
eae53a7dcf03 Comment change.
Richard M. Stallman <rms@gnu.org>
parents: 14282
diff changeset
3 ;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc.
10955
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>
13334
c55f17d3931f (tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents: 12960
diff changeset
6 ;; Maintainer: FSF
10955
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
7
10956
40810ac8d212 Comment change.
Richard M. Stallman <rms@gnu.org>
parents: 10955
diff changeset
8 ;; This file is part of GNU Emacs.
10955
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
9
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
11 ;; 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
12 ;; the Free Software Foundation; either version 2, or (at your option)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
13 ;; any later version.
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
14
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
15 ;; GNU Emacs is distributed in the hope that it will be useful,
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
18 ;; GNU General Public License for more details.
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
19
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
20 ;; You should have received a copy of the GNU General Public License
14169
83f275dcd93a Update FSF's address.
Erik Naggum <erik@naggum.no>
parents: 14120
diff changeset
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
83f275dcd93a Update FSF's address.
Erik Naggum <erik@naggum.no>
parents: 14120
diff changeset
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
83f275dcd93a Update FSF's address.
Erik Naggum <erik@naggum.no>
parents: 14120
diff changeset
23 ;; Boston, MA 02111-1307, USA.
10955
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
24
14169
83f275dcd93a Update FSF's address.
Erik Naggum <erik@naggum.no>
parents: 14120
diff changeset
25 ;;; Commentary:
10955
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
26
14169
83f275dcd93a Update FSF's address.
Erik Naggum <erik@naggum.no>
parents: 14120
diff changeset
27 ;; To use this package add
10955
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
28
14169
83f275dcd93a Update FSF's address.
Erik Naggum <erik@naggum.no>
parents: 14120
diff changeset
29 ;; (autoload 'tmm-menubar 'tmm "Text mode substitute for menubar" t)
83f275dcd93a Update FSF's address.
Erik Naggum <erik@naggum.no>
parents: 14120
diff changeset
30 ;; (global-set-key [f10] 'tmm-menubar)
83f275dcd93a Update FSF's address.
Erik Naggum <erik@naggum.no>
parents: 14120
diff changeset
31 ;; to your .emacs file. You can also add your own access to different
83f275dcd93a Update FSF's address.
Erik Naggum <erik@naggum.no>
parents: 14120
diff changeset
32 ;; menus available in Window System Emacs modeling definition after
83f275dcd93a Update FSF's address.
Erik Naggum <erik@naggum.no>
parents: 14120
diff changeset
33 ;; tmm-menubar.
10955
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
34
14169
83f275dcd93a Update FSF's address.
Erik Naggum <erik@naggum.no>
parents: 14120
diff changeset
35 ;;; Code:
10955
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
36
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
37 (require 'electric)
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)
13334
c55f17d3931f (tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents: 12960
diff changeset
41 (defvar tmm-old-mb-map nil)
10955
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
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)
13480
edc4a329403e (tmm-define-keys): New subroutine.
Richard M. Stallman <rms@gnu.org>
parents: 13337
diff changeset
48 ;;;###autoload (define-key global-map [f10] 'tmm-menubar)
13915
1319e4b9aa6c (tmm-menubar-mouse): New function, handles [menu-bar mouse-1].
Richard M. Stallman <rms@gnu.org>
parents: 13581
diff changeset
49 ;;;###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
50
10955
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
51 ;;;###autoload
13915
1319e4b9aa6c (tmm-menubar-mouse): New function, handles [menu-bar mouse-1].
Richard M. Stallman <rms@gnu.org>
parents: 13581
diff changeset
52 (defun tmm-menubar (&optional x-position)
10955
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
53 "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
54 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
55 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
56 we make that menu bar item (the one at that position) the default choice."
10955
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
57 (interactive)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
58 (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
59 ;; 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
60 (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
61 menu-bar-item)
13334
c55f17d3931f (tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents: 12960
diff changeset
62 (let ((list menu-bar-final-items))
c55f17d3931f (tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents: 12960
diff changeset
63 (while list
c55f17d3931f (tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents: 12960
diff changeset
64 (let ((item (car list)))
c55f17d3931f (tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents: 12960
diff changeset
65 ;; 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
66 ;; 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
67 (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
68 (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
69 (list this-one)))))
c55f17d3931f (tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents: 12960
diff changeset
70 (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
71 (if x-position
1319e4b9aa6c (tmm-menubar-mouse): New function, handles [menu-bar mouse-1].
Richard M. Stallman <rms@gnu.org>
parents: 13581
diff changeset
72 (let ((tail menu-bar)
1319e4b9aa6c (tmm-menubar-mouse): New function, handles [menu-bar mouse-1].
Richard M. Stallman <rms@gnu.org>
parents: 13581
diff changeset
73 this-one
1319e4b9aa6c (tmm-menubar-mouse): New function, handles [menu-bar mouse-1].
Richard M. Stallman <rms@gnu.org>
parents: 13581
diff changeset
74 (column 0))
1319e4b9aa6c (tmm-menubar-mouse): New function, handles [menu-bar mouse-1].
Richard M. Stallman <rms@gnu.org>
parents: 13581
diff changeset
75 (while (and tail (< column x-position))
1319e4b9aa6c (tmm-menubar-mouse): New function, handles [menu-bar mouse-1].
Richard M. Stallman <rms@gnu.org>
parents: 13581
diff changeset
76 (setq this-one (car tail))
1319e4b9aa6c (tmm-menubar-mouse): New function, handles [menu-bar mouse-1].
Richard M. Stallman <rms@gnu.org>
parents: 13581
diff changeset
77 (if (and (consp (car tail))
1319e4b9aa6c (tmm-menubar-mouse): New function, handles [menu-bar mouse-1].
Richard M. Stallman <rms@gnu.org>
parents: 13581
diff changeset
78 (consp (cdr (car tail)))
1319e4b9aa6c (tmm-menubar-mouse): New function, handles [menu-bar mouse-1].
Richard M. Stallman <rms@gnu.org>
parents: 13581
diff changeset
79 (stringp (nth 1 (car tail))))
1319e4b9aa6c (tmm-menubar-mouse): New function, handles [menu-bar mouse-1].
Richard M. Stallman <rms@gnu.org>
parents: 13581
diff changeset
80 (setq column (+ column
1319e4b9aa6c (tmm-menubar-mouse): New function, handles [menu-bar mouse-1].
Richard M. Stallman <rms@gnu.org>
parents: 13581
diff changeset
81 (length (nth 1 (car tail)))
1319e4b9aa6c (tmm-menubar-mouse): New function, handles [menu-bar mouse-1].
Richard M. Stallman <rms@gnu.org>
parents: 13581
diff changeset
82 1)))
1319e4b9aa6c (tmm-menubar-mouse): New function, handles [menu-bar mouse-1].
Richard M. Stallman <rms@gnu.org>
parents: 13581
diff changeset
83 (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
84 (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
85 (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
86
14120
4d4eb72a8d65 (tmm-menubar-mouse): Add autoload cookie.
Karl Heuer <kwzh@gnu.org>
parents: 14011
diff changeset
87 ;;;###autoload
13915
1319e4b9aa6c (tmm-menubar-mouse): New function, handles [menu-bar mouse-1].
Richard M. Stallman <rms@gnu.org>
parents: 13581
diff changeset
88 (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
89 "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
90 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
91 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
92 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
93 (interactive "e")
1319e4b9aa6c (tmm-menubar-mouse): New function, handles [menu-bar mouse-1].
Richard M. Stallman <rms@gnu.org>
parents: 13581
diff changeset
94 (tmm-menubar (car (posn-x-y (event-start event)))))
10955
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
95
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
96 (defvar tmm-mid-prompt "==>"
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
97 "String to insert between shortcut and menu item or nil.")
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
98
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
99 (defvar tmm-mb-map nil
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
100 "A place to store minibuffer map.")
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
101
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
102 (defvar tmm-completion-prompt
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
103 "Press PageUp Key to reach this buffer from the minibuffer.
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
104 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
105 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
106 marked letters to pick up your choice. Type C-g or ESC ESC ESC to cancel.
10955
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
107 "
15564
1e86b1873c5e (tmm-add-prompt): If tmm-completion-prompt is nil,
Richard M. Stallman <rms@gnu.org>
parents: 14902
diff changeset
108 "String to insert at top of completion buffer.
1e86b1873c5e (tmm-add-prompt): If tmm-completion-prompt is nil,
Richard M. Stallman <rms@gnu.org>
parents: 14902
diff changeset
109 If this is nil, delete even the usual help text
1e86b1873c5e (tmm-add-prompt): If tmm-completion-prompt is nil,
Richard M. Stallman <rms@gnu.org>
parents: 14902
diff changeset
110 and show just the alternatives.")
10955
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
111
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
112 ;;;###autoload
13916
00065bf711b8 (tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents: 13915
diff changeset
113 (defun tmm-prompt (menu &optional in-popup default-item)
10955
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
114 "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
115 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
116 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
117 *) via history mechanism from minibuffer;
10955
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
118 *) Or via completion-buffer that is automatically shown.
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
119 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
120
00065bf711b8 (tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents: 13915
diff changeset
121 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
122 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
123 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
124 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
125 ;; 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
126 ;; 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
127 ;; 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
128 (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
129 ; 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
130 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
131 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
132 chosen-string choice
00065bf711b8 (tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents: 13915
diff changeset
133 (not-menu (not (keymapp menu))))
10955
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
134 (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
135 ;; 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
136 ;; 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
137 ;; 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
138 ;; The order of elements in tmm-km-list is the order of the menu bar.
10955
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
139 (mapcar (function (lambda (elt)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
140 (if (stringp elt)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
141 (setq gl-str elt)
13916
00065bf711b8 (tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents: 13915
diff changeset
142 (and (listp elt) (tmm-get-keymap elt not-menu)))))
00065bf711b8 (tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents: 13915
diff changeset
143 menu)
00065bf711b8 (tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents: 13915
diff changeset
144 ;; 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
145 (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
146 ;; 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
147 ;; 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
148 ;; 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
149 ;; 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
150 (setq choice (cdr (car tmm-km-list)))
00065bf711b8 (tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents: 13915
diff changeset
151 (and tmm-km-list
00065bf711b8 (tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents: 13915
diff changeset
152 (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
153 (if tmm-mid-prompt
00065bf711b8 (tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents: 13915
diff changeset
154 (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
155 t)
00065bf711b8 (tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents: 13915
diff changeset
156 ;; 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
157 ;; 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
158 ;; and initial history position.
00065bf711b8 (tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents: 13915
diff changeset
159 (if default-item
00065bf711b8 (tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents: 13915
diff changeset
160 (let ((tail menu))
00065bf711b8 (tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents: 13915
diff changeset
161 (while (and tail
00065bf711b8 (tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents: 13915
diff changeset
162 (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
163 ;; 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
164 ;; 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
165 (if (and (consp (car tail))
00065bf711b8 (tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents: 13915
diff changeset
166 (stringp (car-safe (cdr (car tail)))))
00065bf711b8 (tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents: 13915
diff changeset
167 (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
168 (setq tail (cdr tail)))))
00065bf711b8 (tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents: 13915
diff changeset
169 (setq history (reverse (mapcar 'car tmm-km-list)))
00065bf711b8 (tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents: 13915
diff changeset
170 (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
171 (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
172 (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
173 (add-hook 'minibuffer-setup-hook 'tmm-add-prompt)
00065bf711b8 (tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents: 13915
diff changeset
174 (unwind-protect
00065bf711b8 (tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents: 13915
diff changeset
175 (setq out
00065bf711b8 (tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents: 13915
diff changeset
176 (completing-read
00065bf711b8 (tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents: 13915
diff changeset
177 (concat gl-str " (up/down to change, PgUp to menu): ")
00065bf711b8 (tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents: 13915
diff changeset
178 tmm-km-list nil t nil
00065bf711b8 (tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents: 13915
diff changeset
179 (cons 'history (- (* 2 history-len) index-of-default))))
00065bf711b8 (tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents: 13915
diff changeset
180 (save-excursion
00065bf711b8 (tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents: 13915
diff changeset
181 (remove-hook 'minibuffer-setup-hook 'tmm-add-prompt)
00065bf711b8 (tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents: 13915
diff changeset
182 (if (get-buffer "*Completions*")
00065bf711b8 (tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents: 13915
diff changeset
183 (progn
00065bf711b8 (tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents: 13915
diff changeset
184 (set-buffer "*Completions*")
00065bf711b8 (tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents: 13915
diff changeset
185 (use-local-map tmm-old-comp-map)
00065bf711b8 (tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents: 13915
diff changeset
186 (bury-buffer (current-buffer)))))
00065bf711b8 (tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents: 13915
diff changeset
187 )))
00065bf711b8 (tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents: 13915
diff changeset
188 (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
189 (and (null choice)
00065bf711b8 (tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents: 13915
diff changeset
190 (> (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
191 (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
192 (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
193 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
194 (and (null choice)
00065bf711b8 (tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents: 13915
diff changeset
195 (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
196 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
197 ;; 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
198 (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
199 (setq choice (cdr choice))
00065bf711b8 (tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents: 13915
diff changeset
200 (cond (in-popup
00065bf711b8 (tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents: 13915
diff changeset
201 ;; 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
202 choice)
00065bf711b8 (tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents: 13915
diff changeset
203 ;; We just did the outer level. Do the inner level now.
00065bf711b8 (tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents: 13915
diff changeset
204 (not-menu (tmm-prompt choice t))
00065bf711b8 (tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents: 13915
diff changeset
205 ;; 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
206 ((keymapp choice)
00065bf711b8 (tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents: 13915
diff changeset
207 (if (symbolp choice)
00065bf711b8 (tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents: 13915
diff changeset
208 (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
209 (condition-case nil
00065bf711b8 (tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents: 13915
diff changeset
210 (require 'mouse)
00065bf711b8 (tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents: 13915
diff changeset
211 (error nil))
00065bf711b8 (tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents: 13915
diff changeset
212 (condition-case nil
00065bf711b8 (tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents: 13915
diff changeset
213 (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
214 (error nil))
00065bf711b8 (tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents: 13915
diff changeset
215 (tmm-prompt choice))
00065bf711b8 (tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents: 13915
diff changeset
216 ;; 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
217 (choice
00065bf711b8 (tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents: 13915
diff changeset
218 (if chosen-string
14282
63fbb2aeb1f2 (tmm-prompt): Set last-command-event before calling the
Karl Heuer <kwzh@gnu.org>
parents: 14169
diff changeset
219 (progn
63fbb2aeb1f2 (tmm-prompt): Set last-command-event before calling the
Karl Heuer <kwzh@gnu.org>
parents: 14169
diff changeset
220 (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
221 (call-interactively choice))
13916
00065bf711b8 (tmm-prompt): Major cleanups. Handle pop-menu case nicely.
Richard M. Stallman <rms@gnu.org>
parents: 13915
diff changeset
222 choice)))))
10955
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
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
225 (defun tmm-add-shortcuts (list)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
226 "Adds shortcuts to cars of elements of the list.
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
227 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
228 shortcuts added to these cars.
c55f17d3931f (tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents: 12960
diff changeset
229 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
230 (let ((next-shortcut-number 0))
c55f17d3931f (tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents: 12960
diff changeset
231 (mapcar (lambda (elt)
c55f17d3931f (tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents: 12960
diff changeset
232 (let ((str (car elt)) f b)
c55f17d3931f (tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents: 12960
diff changeset
233 (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
234 ;; 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
235 (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
236 (string-match " \\([^ ]\\)" str))
c55f17d3931f (tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents: 12960
diff changeset
237 (setq f (upcase (substring
c55f17d3931f (tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents: 12960
diff changeset
238 str
c55f17d3931f (tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents: 12960
diff changeset
239 (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
240 ;; 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
241 ;; 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
242 (if (member f tmm-short-cuts)
c55f17d3931f (tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents: 12960
diff changeset
243 (if (< next-shortcut-number 10)
c55f17d3931f (tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents: 12960
diff changeset
244 (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
245 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
246 (setq f nil)))
c55f17d3931f (tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents: 12960
diff changeset
247 (if (null f)
c55f17d3931f (tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents: 12960
diff changeset
248 elt
c55f17d3931f (tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents: 12960
diff changeset
249 (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
250 (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
251 (reverse list))))
10955
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
252
14902
6dc4dee167eb (tmm-define-keys): New arg MINIBUFFER.
Richard M. Stallman <rms@gnu.org>
parents: 14733
diff changeset
253 (defun tmm-define-keys (minibuffer)
13480
edc4a329403e (tmm-define-keys): New subroutine.
Richard M. Stallman <rms@gnu.org>
parents: 13337
diff changeset
254 (mapcar (lambda (str)
edc4a329403e (tmm-define-keys): New subroutine.
Richard M. Stallman <rms@gnu.org>
parents: 13337
diff changeset
255 (define-key (current-local-map) str 'tmm-shortcut)
edc4a329403e (tmm-define-keys): New subroutine.
Richard M. Stallman <rms@gnu.org>
parents: 13337
diff changeset
256 (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
257 tmm-short-cuts)
14902
6dc4dee167eb (tmm-define-keys): New arg MINIBUFFER.
Richard M. Stallman <rms@gnu.org>
parents: 14733
diff changeset
258 (if minibuffer
6dc4dee167eb (tmm-define-keys): New arg MINIBUFFER.
Richard M. Stallman <rms@gnu.org>
parents: 14733
diff changeset
259 (progn
6dc4dee167eb (tmm-define-keys): New arg MINIBUFFER.
Richard M. Stallman <rms@gnu.org>
parents: 14733
diff changeset
260 (define-key (current-local-map) [pageup] 'tmm-goto-completions)
6dc4dee167eb (tmm-define-keys): New arg MINIBUFFER.
Richard M. Stallman <rms@gnu.org>
parents: 14733
diff changeset
261 (define-key (current-local-map) [prior] 'tmm-goto-completions)
6dc4dee167eb (tmm-define-keys): New arg MINIBUFFER.
Richard M. Stallman <rms@gnu.org>
parents: 14733
diff changeset
262 (define-key (current-local-map) "\ev" 'tmm-goto-completions)
6dc4dee167eb (tmm-define-keys): New arg MINIBUFFER.
Richard M. Stallman <rms@gnu.org>
parents: 14733
diff changeset
263 (define-key (current-local-map) "\C-n" 'next-history-element)
6dc4dee167eb (tmm-define-keys): New arg MINIBUFFER.
Richard M. Stallman <rms@gnu.org>
parents: 14733
diff changeset
264 (define-key (current-local-map) "\C-p" 'previous-history-element))))
13480
edc4a329403e (tmm-define-keys): New subroutine.
Richard M. Stallman <rms@gnu.org>
parents: 13337
diff changeset
265
10955
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
266 (defun tmm-add-prompt ()
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
267 (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
268 (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
269 (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
270 (let ((win (selected-window)))
10955
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
271 (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
272 (use-local-map (append (make-sparse-keymap) tmm-old-mb-map))
14902
6dc4dee167eb (tmm-define-keys): New arg MINIBUFFER.
Richard M. Stallman <rms@gnu.org>
parents: 14733
diff changeset
273 (tmm-define-keys t)
10955
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
274 ;; Get window and hide it for electric mode to get correct size
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
275 (save-window-excursion
13334
c55f17d3931f (tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents: 12960
diff changeset
276 (let ((completions
c55f17d3931f (tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents: 12960
diff changeset
277 (mapcar 'car minibuffer-completion-table)))
c55f17d3931f (tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents: 12960
diff changeset
278 (with-output-to-temp-buffer "*Completions*"
c55f17d3931f (tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents: 12960
diff changeset
279 (display-completion-list completions)))
10955
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
280 (set-buffer "*Completions*")
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
281 (goto-char 1)
15564
1e86b1873c5e (tmm-add-prompt): If tmm-completion-prompt is nil,
Richard M. Stallman <rms@gnu.org>
parents: 14902
diff changeset
282 (if tmm-completion-prompt
1e86b1873c5e (tmm-add-prompt): If tmm-completion-prompt is nil,
Richard M. Stallman <rms@gnu.org>
parents: 14902
diff changeset
283 (insert tmm-completion-prompt)
1e86b1873c5e (tmm-add-prompt): If tmm-completion-prompt is nil,
Richard M. Stallman <rms@gnu.org>
parents: 14902
diff changeset
284 ;; Delete even the usual help info that all completion buffers have.
1e86b1873c5e (tmm-add-prompt): If tmm-completion-prompt is nil,
Richard M. Stallman <rms@gnu.org>
parents: 14902
diff changeset
285 (goto-char 1)
1e86b1873c5e (tmm-add-prompt): If tmm-completion-prompt is nil,
Richard M. Stallman <rms@gnu.org>
parents: 14902
diff changeset
286 (delete-region 1 (search-forward "Possible completions are:\n")))
10955
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 (save-excursion
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
289 (other-window 1) ; Electric-pop-up-window does
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
290 ; not work in minibuffer
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
291 (set-buffer (window-buffer (Electric-pop-up-window "*Completions*")))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
292 (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
293 (use-local-map (append (make-sparse-keymap) tmm-old-comp-map))
14902
6dc4dee167eb (tmm-define-keys): New arg MINIBUFFER.
Richard M. Stallman <rms@gnu.org>
parents: 14733
diff changeset
294 (tmm-define-keys nil)
10955
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
295 (select-window win) ; Cannot use
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
296 ; save-window-excursion, since
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
297 ; it restores the size
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
298 )
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
299 (insert tmm-c-prompt)))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
300
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
301 (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
302 (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
303 (if tmm-old-mb-map
c55f17d3931f (tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents: 12960
diff changeset
304 (use-local-map tmm-old-mb-map)))
10955
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 (defun tmm-shortcut ()
13334
c55f17d3931f (tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents: 12960
diff changeset
307 "Choose the shortcut that the user typed."
10955
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
308 (interactive)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
309 (let ((c (upcase (char-to-string last-command-char))) s)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
310 (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
311 (if (equal (buffer-name) "*Completions*")
c55f17d3931f (tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents: 12960
diff changeset
312 (progn
c55f17d3931f (tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents: 12960
diff changeset
313 (beginning-of-buffer)
c55f17d3931f (tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents: 12960
diff changeset
314 (re-search-forward
c55f17d3931f (tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents: 12960
diff changeset
315 (concat "\\(^\\|[ \t]\\)" c tmm-mid-prompt))
c55f17d3931f (tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents: 12960
diff changeset
316 (choose-completion))
c55f17d3931f (tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents: 12960
diff changeset
317 (erase-buffer) ; In minibuffer
c55f17d3931f (tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents: 12960
diff changeset
318 (mapcar (lambda (elt)
c55f17d3931f (tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents: 12960
diff changeset
319 (if (string=
c55f17d3931f (tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents: 12960
diff changeset
320 (substring (car elt) 0
c55f17d3931f (tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents: 12960
diff changeset
321 (min (1+ (length tmm-mid-prompt))
c55f17d3931f (tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents: 12960
diff changeset
322 (length (car elt))))
c55f17d3931f (tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents: 12960
diff changeset
323 (concat c tmm-mid-prompt))
c55f17d3931f (tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents: 12960
diff changeset
324 (setq s (car elt))))
c55f17d3931f (tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents: 12960
diff changeset
325 tmm-km-list)
c55f17d3931f (tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents: 12960
diff changeset
326 (insert s)
c55f17d3931f (tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents: 12960
diff changeset
327 (exit-minibuffer)))))
10955
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
328
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
329 (defun tmm-goto-completions ()
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
330 (interactive)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
331 (setq tmm-c-prompt (buffer-string))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
332 (erase-buffer)
13334
c55f17d3931f (tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents: 12960
diff changeset
333 (switch-to-buffer-other-window "*Completions*")
10955
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
334 (search-forward tmm-c-prompt)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
335 (search-backward tmm-c-prompt))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
336
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
337
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
338 (defun tmm-get-keymap (elt &optional in-x-menu)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
339 "Prepends (DOCSTRING EVENT BINDING) to free variable `tmm-km-list'.
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
340 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
341 element of keymap, an `x-popup-menu' argument, or an element of
10955
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
342 `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
343 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
344 It uses the free variable `tmm-table-undef' to keep undefined keys."
10955
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
345 (let (km str cache (event (car elt)))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
346 (setq elt (cdr elt))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
347 (if (eq elt 'undefined)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
348 (setq tmm-table-undef (cons (cons event nil) tmm-table-undef))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
349 (or
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
350 (assoc event tmm-table-undef)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
351 (and (if (listp elt)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
352 (keymapp elt)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
353 (fboundp elt))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
354 (setq km elt))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
355 (and (if (listp (cdr-safe elt))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
356 (keymapp (cdr-safe elt))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
357 (fboundp (cdr-safe elt)))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
358 (setq km (cdr elt))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
359 (and (stringp (car elt)) (setq str (car elt))))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
360 (and (if (listp (cdr-safe (cdr-safe elt)))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
361 (keymapp (cdr-safe (cdr-safe elt)))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
362 (fboundp (cdr-safe (cdr-safe elt))))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
363 (setq km (cdr (cdr elt)))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
364 (and (stringp (car elt)) (setq str (car elt)))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
365 (or (and str
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
366 (stringp (cdr (car (cdr elt)))) ; keyseq cache
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
367 (setq cache (cdr (car (cdr elt))))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
368 cache (setq str (concat str cache))) str))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
369 (and (if (listp (cdr-safe (cdr-safe (cdr-safe elt))))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
370 (keymapp (cdr-safe (cdr-safe (cdr-safe elt))))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
371 (fboundp (cdr-safe (cdr-safe (cdr-safe elt)))))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
372 ; New style of easy-menu
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
373 (setq km (cdr (cdr (cdr elt))))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
374 (and (stringp (car elt)) (setq str (car elt)))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
375 (or (and str
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
376 (stringp (cdr (car (cdr (cdr elt))))) ; keyseq cache
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
377 (setq cache (cdr (car (cdr (cdr elt)))))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
378 cache (setq str (concat str cache)))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
379 str))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
380 (and (stringp event) ; x-popup or x-popup element
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
381 (if (or in-x-menu (stringp (car-safe elt)))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
382 (setq str event event nil km elt)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
383 (setq str event event nil km (cons 'keymap elt))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
384 )))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
385 (and km (stringp km) (setq str km))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
386 (and km str
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
387 (or (assoc str tmm-km-list)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
388 (setq tmm-km-list
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
389 (cons (cons str (cons event km)) tmm-km-list)))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
390 ))))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
391
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
392
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
393 (defun tmm-get-keybind (keyseq)
13334
c55f17d3931f (tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents: 12960
diff changeset
394 "Return the current binding of KEYSEQ, merging prefix definitions.
14011
6427a3484344 (tmm-get-keybind): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 13916
diff changeset
395 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
396 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
397 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
398 of `menu-bar-final-items'."
10955
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
399 (let (allbind bind)
13334
c55f17d3931f (tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents: 12960
diff changeset
400 (setq bind (key-binding keyseq))
c55f17d3931f (tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents: 12960
diff changeset
401 ;; 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
402 ;; 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
403 (if (keymapp bind)
c55f17d3931f (tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents: 12960
diff changeset
404 (setq bind nil))
c55f17d3931f (tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents: 12960
diff changeset
405 ;; 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
406 (or bind
c55f17d3931f (tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents: 12960
diff changeset
407 (progn
c55f17d3931f (tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents: 12960
diff changeset
408 ;; 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
409 ;; 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
410 (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
411 (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
412 (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
413 ;; 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
414 (mapcar (lambda (in)
c55f17d3931f (tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents: 12960
diff changeset
415 (if (and (symbolp in) (keymapp in))
c55f17d3931f (tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents: 12960
diff changeset
416 (setq in (symbol-function in)))
c55f17d3931f (tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents: 12960
diff changeset
417 (and in (keymapp in)
c55f17d3931f (tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents: 12960
diff changeset
418 (if (keymapp bind)
c55f17d3931f (tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents: 12960
diff changeset
419 (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
420 (setq bind (copy-sequence in)))))
c55f17d3931f (tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents: 12960
diff changeset
421 allbind)
c55f17d3931f (tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents: 12960
diff changeset
422 ;; Return that keymap.
c55f17d3931f (tmm-old-mb-map): Initialize to nil.
Richard M. Stallman <rms@gnu.org>
parents: 12960
diff changeset
423 bind))))
10955
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
424
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
425 (add-hook 'calendar-load-hook (lambda () (require 'cal-menu)))
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
426
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
427 (provide 'tmm)
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
428
1bbdc8c907ea Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
429 ;;; tmm.el ends here