annotate lisp/tmm.el @ 90523:5cb3d86fe6f0

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