aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJim Blandy1991-12-20 07:15:37 +0000
committerJim Blandy1991-12-20 07:15:37 +0000
commitcc0a8174baf4c25d69545fe5cd6cabddba6b1d2c (patch)
tree571d3cff4372149149e4ddd84e484f97e3ab846f
parent6367dc09a13bb1944db02f9f76ab25e4ccb159d6 (diff)
downloademacs-cc0a8174baf4c25d69545fe5cd6cabddba6b1d2c.tar.gz
emacs-cc0a8174baf4c25d69545fe5cd6cabddba6b1d2c.zip
*** empty log message ***
-rw-r--r--lisp/mouse.el392
-rw-r--r--lisp/term/news.el100
-rw-r--r--src/keymap.c199
3 files changed, 379 insertions, 312 deletions
diff --git a/lisp/mouse.el b/lisp/mouse.el
index 533731290ef..2fa8cecf9e6 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -1,170 +1,95 @@
1;; Mouse support that is independent of window systems. 1;;; Window system-independent mouse support.
2;; Copyright (C) 1988 Free Software Foundation, Inc. 2;;; Copyright (C) 1988 Free Software Foundation, Inc.
3 3
4;; This file is part of GNU Emacs. 4;;; This file is part of GNU Emacs.
5 5
6;; GNU Emacs is free software; you can redistribute it and/or modify 6;;; GNU Emacs is free software; you can redistribute it and/or modify
7;; it under the terms of the GNU General Public License as published by 7;;; it under the terms of the GNU General Public License as published by
8;; the Free Software Foundation; either version 1, or (at your option) 8;;; the Free Software Foundation; either version 1, or (at your option)
9;; any later version. 9;;; any later version.
10 10
11;; GNU Emacs is distributed in the hope that it will be useful, 11;;; GNU Emacs is distributed in the hope that it will be useful,
12;; but WITHOUT ANY WARRANTY; without even the implied warranty of 12;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14;; GNU General Public License for more details. 14;;; GNU General Public License for more details.
15 15
16;; You should have received a copy of the GNU General Public License 16;;; You should have received a copy of the GNU General Public License
17;; along with GNU Emacs; see the file COPYING. If not, write to 17;;; along with GNU Emacs; see the file COPYING. If not, write to
18;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. 18;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
19 19
20(provide 'mouse) 20(provide 'mouse)
21 21
22 22
23(defun mouse-select () 23;;; Utility functions.
24 "Select the Emacs window the mouse is on."
25 (interactive "@"))
26 24
27(defun mouse-delete-window () 25(defun mouse-movement-p (event)
28 "Delete the Emacs window the mouse is on." 26 (and (consp event)
29 (interactive "@") 27 (eq (car event) 'mouse-movement)))
30 (delete-window))
31 28
32(defun mouse-keep-one-window () 29(defun event-window (event) (nth 1 event))
33 "Select Emacs window mouse is on, then kill all other Emacs windows." 30(defun event-point (event) (nth 2 event))
34 (interactive "@") 31(defun mouse-coords (event) (nth 3 event))
35 (delete-other-windows)) 32(defun mouse-timestamp (event) (nth 4 event))
36 33
37(defun mouse-select-and-split () 34;;; Indent track-mouse like progn.
38 "Select Emacs window mouse is on, then split it vertically in half." 35(put 'track-mouse 'lisp-indent-function 0)
39 (interactive "@")
40 (split-window-vertically nil))
41 36
42(defun mouse-set-point (event) 37
43 "Select Emacs window mouse is on, and move point to mouse position." 38(defun mouse-delete-window (click)
44 (interactive "@e") 39 "Delete the window clicked on.
45 (let ((relative-coordinate 40This must be bound to a mouse click."
46 (coordinates-in-window-p (car event) (selected-window)))) 41 (interactive "K")
47 (if (consp relative-coordinate) 42 (delete-window (event-window click)))
48 (progn 43
49 (move-to-window-line (car (cdr relative-coordinate))) 44(defun mouse-delete-other-windows (click)
50 ;; Note that hscroll must get above 1 45 "Select Emacs window clicked on, then kill all other Emacs windows.
51 ;; before the text actually starts to move. 46This must be bound to a mouse click."
52 (move-to-column (+ (car relative-coordinate) (current-column) 47 (interactive "K")
53 (1- (max 1 (window-hscroll (selected-window)))))) 48 (select-window (event-window click))
54 (what-line))))) 49 (delete-other-windows))
55
56(defun mouse-eval-last-sexpr (event)
57 (interactive "@e")
58 (save-excursion
59 (mouse-set-point event)
60 (eval-last-sexp nil)))
61 50
62(defun mouse-line-length (event) 51(defun mouse-split-window-vertically (click)
63 "Print the length of the line indicated by the pointer." 52 "Select Emacs window mouse is on, then split it vertically in half.
64 (interactive "@e") 53The window is split at the line clicked on.
65 (let ((relative-coordinate 54This command must be bound to a mouse click."
66 (coordinates-in-window-p (car event) (selected-window)))) 55 (interactive "K")
67 (if (consp relative-coordinate) 56 (select-window (event-window click))
68 (save-excursion 57 (split-window-vertically (1+ (cdr (mouse-coords click)))))
69 (move-to-window-line (car (cdr relative-coordinate))) 58
70 (end-of-line) 59(defun mouse-set-point (click)
71 (push-mark nil t) 60 "Move point to the position clicked on with the mouse.
72 (beginning-of-line) 61This must be bound to a mouse click."
73 (message "Line length: %d" 62 (interactive "K")
74 (- (region-end) (region-beginning))) 63 (select-window (event-window click))
75 (sleep-for 1))))) 64 (goto-char (event-point click)))
76 65
77(defun mouse-set-mark (event) 66(defun mouse-set-mark (click)
78 "Select Emacs window mouse is on, and set mark at mouse position. 67 "Set mark at the position clicked on with the mouse.
79Display cursor at that position for a second." 68Display cursor at that position for a second.
80 (interactive "@e") 69This must be bound to a mouse click."
70 (interactive "K")
81 (let ((point-save (point))) 71 (let ((point-save (point)))
82 (unwind-protect 72 (unwind-protect
83 (progn (mouse-set-point event) 73 (progn (mouse-set-point click)
84 (push-mark nil t) 74 (push-mark nil t)
85 (sit-for 1)) 75 (sit-for 1))
86 (goto-char point-save)))) 76 (goto-char point-save))))
87 77
88(defun mouse-fill-paragraph (event) 78(defun mouse-kill (click)
89 "Fill the paragraph at the mouse position." 79 "Kill the region between point and the mouse click.
90 (interactive "@e") 80The text is saved in the kill ring, as with \\[kill-region]."
91 (save-excursion 81 (interactive "K")
92 (mouse-set-point event) 82 (mouse-set-mark click)
93 (fill-paragraph))) 83 (kill-region))
94
95(defun mouse-fill-paragraph-with-prefix (event)
96 "Fill the paragraph at the mouse position with specified fill prefix.
97Click at the end of the fill prefix that you want;
98The text before the mouse position, on the same line, is used as the prefix."
99 (interactive "@e")
100 (save-excursion
101 (mouse-set-point event)
102 (let ((fill-prefix (buffer-substring (save-excursion (beginning-of-line)
103 (point))
104 (point))))
105 (fill-paragraph))))
106
107(defun mouse-scroll (event)
108 "Scroll point to the mouse position."
109 (interactive "@e")
110 (let ((relative-coordinate
111 (coordinates-in-window-p (car event) (selected-window))))
112 (if (consp relative-coordinate)
113 (progn
114 (recenter (car (cdr relative-coordinate)))
115 (scroll-right (+ (car relative-coordinate) (current-column)))))))
116
117(defun mouse-del-char (event)
118 "Delete the char pointed to by the mouse."
119 (interactive "@e")
120 (let ((relative-coordinate
121 (coordinates-in-window-p (car event) (selected-window))))
122 (if (consp relative-coordinate)
123 (progn
124 (move-to-window-line (car (cdr relative-coordinate)))
125 (move-to-column (+ (car relative-coordinate) (current-column)))
126 (delete-char 1 nil)))))
127 84
128(defun mouse-kill-line (event) 85(defun mouse-kill-ring-save
129 "Kill the line pointed to by the mouse." 86 "Copy the region between point and the mouse click in the kill ring.
130 (interactive "@e") 87This does not delete the region; it acts like \\[kill-ring-save]."
131 (let ((relative-coordinate 88 (interactive "K")
132 (coordinates-in-window-p (car event) (selected-window)))) 89 (mouse-set-mark click)
133 (if (consp relative-coordinate) 90 (kill-ring-save))
134 (progn
135 (move-to-window-line (car (cdr relative-coordinate)))
136 (move-to-column (+ (car relative-coordinate) (current-column)))
137 (kill-line nil)))))
138 91
139(defun narrow-window-to-region (m n)
140 "Narrow window to region between point and last mark"
141 (interactive "r")
142 (save-excursion
143 (save-restriction
144 (if (eq (selected-window) (next-window))
145 (split-window))
146 (goto-char m)
147 (recenter 0)
148 (if (eq (selected-window)
149 (if (zerop (minibuffer-depth))
150 (next-window)))
151 ()
152 (shrink-window (- (- (window-height) (count-lines m n)) 1))))))
153
154(defun mouse-window-to-region (event)
155 "Narrow window to region between cursor and mouse pointer."
156 (interactive "@e")
157 (let ((point-save (point)))
158 (unwind-protect
159 (progn (mouse-set-point event)
160 (push-mark nil t)
161 (sit-for 1))
162 (goto-char point-save)
163 (narrow-window-to-region (region-beginning) (region-end)))))
164 92
165(defun mouse-ignore ()
166 "Don't do anything."
167 (interactive))
168 93
169;; Commands for the scroll bar. 94;; Commands for the scroll bar.
170 95
@@ -231,77 +156,77 @@ The text before the mouse position, on the same line, is used as the prefix."
231 156
232;; Set up these commands, including the prefix keys for the scroll bar. 157;; Set up these commands, including the prefix keys for the scroll bar.
233 158
234(fset 'mouse-vertical-scroll-bar-prefix (make-sparse-keymap)) 159;;; (fset 'mouse-vertical-scroll-bar-prefix (make-sparse-keymap))
235(define-key global-mouse-map mouse-vertical-scroll-bar-prefix 160;;; (define-key global-mouse-map mouse-vertical-scroll-bar-prefix
236 'mouse-vertical-scroll-bar-prefix) 161;;; 'mouse-vertical-scroll-bar-prefix)
237 162;;;
238(defun mouse-scroll-motion (event) 163;;; (defun mouse-scroll-motion (event)
239 (interactive "e") 164;;; (interactive "e")
240 (let ((pos (car (car event))) 165;;; (let ((pos (car (car event)))
241 (length (car (cdr (car event))))) 166;;; (length (car (cdr (car event)))))
242 (message "[%d %d]" pos length))) 167;;; (message "[%d %d]" pos length)))
243 168;;;
244(let ((map (function mouse-vertical-scroll-bar-prefix))) 169;;; (let ((map (function mouse-vertical-scroll-bar-prefix)))
245 (define-key map mouse-button-right 'mouse-scroll-down) 170;;; (define-key map mouse-button-right 'mouse-scroll-down)
246 (define-key map mouse-button-left 'mouse-scroll-up) 171;;; (define-key map mouse-button-left 'mouse-scroll-up)
247 (define-key map mouse-button-middle 'mouse-scroll-absolute) 172;;; (define-key map mouse-button-middle 'mouse-scroll-absolute)
248 (define-key map mouse-motion 'x-horizontal-line)) 173;;; (define-key map mouse-motion 'x-horizontal-line))
249 174;;;
250;(fset 'mouse-vertical-slider-prefix (make-sparse-keymap)) 175;;; ;(fset 'mouse-vertical-slider-prefix (make-sparse-keymap))
251;(define-key global-mouse-map mouse-vertical-slider-prefix 176;;; ;(define-key global-mouse-map mouse-vertical-slider-prefix
252; 'mouse-vertical-slider-prefix) 177;;; ; 'mouse-vertical-slider-prefix)
253 178;;;
254;(let ((map (function mouse-vertical-slider-prefix))) 179;;; ;(let ((map (function mouse-vertical-slider-prefix)))
255; (define-key map mouse-button-right 'mouse-scroll-move-cursor) 180;;; ; (define-key map mouse-button-right 'mouse-scroll-move-cursor)
256; (define-key map mouse-button-left 'mouse-scroll-move-cursor) 181;;; ; (define-key map mouse-button-left 'mouse-scroll-move-cursor)
257; (define-key map mouse-button-middle 'mouse-scroll-move-cursor)) 182;;; ; (define-key map mouse-button-middle 'mouse-scroll-move-cursor))
258 183;;;
259(fset 'mouse-vertical-thumbup-prefix (make-sparse-keymap)) 184;;; (fset 'mouse-vertical-thumbup-prefix (make-sparse-keymap))
260(define-key global-mouse-map mouse-vertical-thumbup-prefix 185;;; (define-key global-mouse-map mouse-vertical-thumbup-prefix
261 'mouse-vertical-thumbup-prefix) 186;;; 'mouse-vertical-thumbup-prefix)
262 187;;;
263(let ((map (function mouse-vertical-thumbup-prefix))) 188;;; (let ((map (function mouse-vertical-thumbup-prefix)))
264 (define-key map mouse-button-right 'mouse-scroll-down-full) 189;;; (define-key map mouse-button-right 'mouse-scroll-down-full)
265 (define-key map mouse-button-left 'mouse-scroll-down-full) 190;;; (define-key map mouse-button-left 'mouse-scroll-down-full)
266 (define-key map mouse-button-middle 'mouse-scroll-down-full)) 191;;; (define-key map mouse-button-middle 'mouse-scroll-down-full))
267 192;;;
268(fset 'mouse-vertical-thumbdown-prefix (make-sparse-keymap)) 193;;; (fset 'mouse-vertical-thumbdown-prefix (make-sparse-keymap))
269(define-key global-mouse-map mouse-vertical-thumbdown-prefix 194;;; (define-key global-mouse-map mouse-vertical-thumbdown-prefix
270 'mouse-vertical-thumbdown-prefix) 195;;; 'mouse-vertical-thumbdown-prefix)
271 196;;;
272(let ((map (function mouse-vertical-thumbdown-prefix))) 197;;; (let ((map (function mouse-vertical-thumbdown-prefix)))
273 (define-key map mouse-button-right 'mouse-scroll-up-full) 198;;; (define-key map mouse-button-right 'mouse-scroll-up-full)
274 (define-key map mouse-button-left 'mouse-scroll-up-full) 199;;; (define-key map mouse-button-left 'mouse-scroll-up-full)
275 (define-key map mouse-button-middle 'mouse-scroll-up-full)) 200;;; (define-key map mouse-button-middle 'mouse-scroll-up-full))
276 201;;;
277;; Horizontal bar 202;;; ;; Horizontal bar
278 203;;;
279(fset 'mouse-horizontal-scroll-bar-prefix (make-sparse-keymap)) 204;;; (fset 'mouse-horizontal-scroll-bar-prefix (make-sparse-keymap))
280(define-key global-mouse-map mouse-horizontal-scroll-bar-prefix 205;;; (define-key global-mouse-map mouse-horizontal-scroll-bar-prefix
281 'mouse-horizontal-scroll-bar-prefix) 206;;; 'mouse-horizontal-scroll-bar-prefix)
282 207;;;
283(let ((map (function mouse-horizontal-scroll-bar-prefix))) 208;;; (let ((map (function mouse-horizontal-scroll-bar-prefix)))
284 (define-key map mouse-button-right 'mouse-scroll-right) 209;;; (define-key map mouse-button-right 'mouse-scroll-right)
285 (define-key map mouse-button-left 'mouse-scroll-left) 210;;; (define-key map mouse-button-left 'mouse-scroll-left)
286 (define-key map mouse-button-middle 'mouse-scroll-absolute-horizontally)) 211;;; (define-key map mouse-button-middle 'mouse-scroll-absolute-horizontally))
287 212;;;
288(fset 'mouse-horizontal-thumbleft-prefix (make-sparse-keymap)) 213;;; (fset 'mouse-horizontal-thumbleft-prefix (make-sparse-keymap))
289(define-key global-mouse-map mouse-horizontal-thumbleft-prefix 214;;; (define-key global-mouse-map mouse-horizontal-thumbleft-prefix
290 'mouse-horizontal-thumbleft-prefix) 215;;; 'mouse-horizontal-thumbleft-prefix)
291 216;;;
292(let ((map (function mouse-horizontal-thumbleft-prefix))) 217;;; (let ((map (function mouse-horizontal-thumbleft-prefix)))
293 (define-key map mouse-button-right 'mouse-scroll-left-full) 218;;; (define-key map mouse-button-right 'mouse-scroll-left-full)
294 (define-key map mouse-button-left 'mouse-scroll-left-full) 219;;; (define-key map mouse-button-left 'mouse-scroll-left-full)
295 (define-key map mouse-button-middle 'mouse-scroll-left-full)) 220;;; (define-key map mouse-button-middle 'mouse-scroll-left-full))
296 221;;;
297(fset 'mouse-horizontal-thumbright-prefix (make-sparse-keymap)) 222;;; (fset 'mouse-horizontal-thumbright-prefix (make-sparse-keymap))
298(define-key global-mouse-map mouse-horizontal-thumbright-prefix 223;;; (define-key global-mouse-map mouse-horizontal-thumbright-prefix
299 'mouse-horizontal-thumbright-prefix) 224;;; 'mouse-horizontal-thumbright-prefix)
300 225;;;
301(let ((map (function mouse-horizontal-thumbright-prefix))) 226;;; (let ((map (function mouse-horizontal-thumbright-prefix)))
302 (define-key map mouse-button-right 'mouse-scroll-right-full) 227;;; (define-key map mouse-button-right 'mouse-scroll-right-full)
303 (define-key map mouse-button-left 'mouse-scroll-right-full) 228;;; (define-key map mouse-button-left 'mouse-scroll-right-full)
304 (define-key map mouse-button-middle 'mouse-scroll-right-full)) 229;;; (define-key map mouse-button-middle 'mouse-scroll-right-full))
305 230
306 231
307;;;; 232;;;;
@@ -402,10 +327,10 @@ The text before the mouse position, on the same line, is used as the prefix."
402 (x-erase-rectangle (selected-screen)) 327 (x-erase-rectangle (selected-screen))
403 (setq last-line-drawn nil)))) 328 (setq last-line-drawn nil))))
404 329
405(defun test-x-rectangle () 330;;; (defun test-x-rectangle ()
406 (use-local-mouse-map (setq rectangle-test-map (make-sparse-keymap))) 331;;; (use-local-mouse-map (setq rectangle-test-map (make-sparse-keymap)))
407 (define-key rectangle-test-map mouse-motion-button-left 'mouse-boxing) 332;;; (define-key rectangle-test-map mouse-motion-button-left 'mouse-boxing)
408 (define-key rectangle-test-map mouse-button-left-up 'mouse-erase-box)) 333;;; (define-key rectangle-test-map mouse-button-left-up 'mouse-erase-box))
409 334
410;; 335;;
411;; Here is how to do double clicking in lisp. About to change. 336;; Here is how to do double clicking in lisp. About to change.
@@ -433,10 +358,10 @@ The text before the mouse position, on the same line, is used as the prefix."
433 (> (- (nth 4 event ) double-start) double-click-interval) 358 (> (- (nth 4 event ) double-start) double-click-interval)
434 (setq double-start nil))) 359 (setq double-start nil)))
435 360
436(defun x-test-doubleclick () 361;;; (defun x-test-doubleclick ()
437 (use-local-mouse-map (setq doubleclick-test-map (make-sparse-keymap))) 362;;; (use-local-mouse-map (setq doubleclick-test-map (make-sparse-keymap)))
438 (define-key doubleclick-test-map mouse-button-left 'double-down) 363;;; (define-key doubleclick-test-map mouse-button-left 'double-down)
439 (define-key doubleclick-test-map mouse-button-left-up 'double-up)) 364;;; (define-key doubleclick-test-map mouse-button-left-up 'double-up))
440 365
441;; 366;;
442;; This scrolls while button is depressed. Use preferable in scrollbar. 367;; This scrolls while button is depressed. Use preferable in scrollbar.
@@ -467,12 +392,12 @@ The text before the mouse position, on the same line, is used as the prefix."
467 (setq scrolled-lines 0) 392 (setq scrolled-lines 0)
468 (sleep-for 1)) 393 (sleep-for 1))
469 394
470(defun x-testing-scroll () 395;;; (defun x-testing-scroll ()
471 (let ((scrolling-map (function mouse-vertical-scroll-bar-prefix))) 396;;; (let ((scrolling-map (function mouse-vertical-scroll-bar-prefix)))
472 (define-key scrolling-map mouse-button-left 'incr-scroll-down) 397;;; (define-key scrolling-map mouse-button-left 'incr-scroll-down)
473 (define-key scrolling-map mouse-button-right 'incr-scroll-up) 398;;; (define-key scrolling-map mouse-button-right 'incr-scroll-up)
474 (define-key scrolling-map mouse-button-left-up 'incr-scroll-stop) 399;;; (define-key scrolling-map mouse-button-left-up 'incr-scroll-stop)
475 (define-key scrolling-map mouse-button-right-up 'incr-scroll-stop))) 400;;; (define-key scrolling-map mouse-button-right-up 'incr-scroll-stop)))
476 401
477;; 402;;
478;; Some playthings suitable for picture mode? They need work. 403;; Some playthings suitable for picture mode? They need work.
@@ -522,3 +447,10 @@ The text before the mouse position, on the same line, is used as the prefix."
522 (mouse-multiple-insert 447 (mouse-multiple-insert
523 (- (car relative-coordinate) (current-column)) " ")) 448 (- (car relative-coordinate) (current-column)) " "))
524 ((= (current-column) (car relative-coordinate)) (ding)))))) 449 ((= (current-column) (car relative-coordinate)) (ding))))))
450
451
452;;; Bindings for mouse commands.
453
454(global-set-key [mouse-1] 'mouse-set-point)
455(global-set-key [S-mouse-1] 'mouse-set-mark)
456(global-set-key [mouse-3] 'mouse-delete-other-windows)
diff --git a/lisp/term/news.el b/lisp/term/news.el
index 16b79e291c9..9a755000298 100644
--- a/lisp/term/news.el
+++ b/lisp/term/news.el
@@ -18,68 +18,38 @@
18;; file named COPYING. Among other things, the copyright notice 18;; file named COPYING. Among other things, the copyright notice
19;; and this notice must be preserved on all copies. 19;; and this notice must be preserved on all copies.
20 20
21;; This file effects a mapping from the raw escape sequences of various 21;; This file places entries in function-key-map for the raw escape
22;; keypad and function keys to the symbols used by emacs to represent 22;; sequences of various keypad and function keys, binding them to
23;; those keys. The mapping from key symbol to the function performed 23;; their symbolic forms.
24;; when that key is pressed is handled keyboard-independently by the file 24
25;; ../keypad.el. 25(define-prefix-command 'news-fkey-prefix 'news-fkey-map)
26 26(define-key function-key-map "\eO" 'news-fkey-prefix)
27;; Note that his file is also used under X11. For this to work, the variable 27
28;; names must not change from keyboard file to keyboard file, nor can the 28(define-key news-fkey-map "P" [f1])
29;; structure of keypad-maps change. 29(define-key news-fkey-map "Q" [f2])
30 30(define-key news-fkey-map "R" [f3])
31(require 'keypad) 31(define-key news-fkey-map "S" [f4])
32 32(define-key news-fkey-map "T" [f5])
33(defvar keypads nil 33(define-key news-fkey-map "U" [f6])
34 "Keypad and function keys keymap for Sony News machine.") 34(define-key news-fkey-map "V" [f7])
35 35(define-key news-fkey-map "W" [f8])
36(defvar keypad-maps nil 36(define-key news-fkey-map "X" [f9])
37 "A list of strings sent by the keypad and function keys on the Sony News. 37(define-key news-fkey-map "Y" [f10])
38There is an element for each unique prefix. Each element is of the form 38(define-key news-fkey-map "m" [kp-subtract])
39(PREFIX map map ...), each map being (string . symbol).") 39(define-key news-fkey-map "k" [kp-add])
40 40(define-key news-fkey-map "l" [kp-separator])
41(setq keypad-maps '(("\eO" 41(define-key news-fkey-map "n" [kp-period])
42 ("P" . function-1) 42(define-key news-fkey-map "M" [kp-enter])
43 ("Q" . function-2) 43(define-key news-fkey-map "p" [kp-0])
44 ("R" . function-3) 44(define-key news-fkey-map "q" [kp-1])
45 ("S" . function-4) 45(define-key news-fkey-map "r" [kp-2])
46 ("T" . function-5) 46(define-key news-fkey-map "s" [kp-3])
47 ("U" . function-6) 47(define-key news-fkey-map "t" [kp-4])
48 ("V" . function-7) 48(define-key news-fkey-map "u" [kp-5])
49 ("W" . function-8) 49(define-key news-fkey-map "v" [kp-6])
50 ("X" . function-9) 50(define-key news-fkey-map "w" [kp-7])
51 ("Y" . function-10) 51(define-key news-fkey-map "x" [kp-8])
52 52(define-key news-fkey-map "y" [kp-9])
53 ("m" . keypad-subtract) 53(define-key news-fkey-map "a" [execute])
54 ("k" . keypad-add) 54(define-key news-fkey-map "b" [select])
55 ("l" . keypad-comma) 55(define-key news-fkey-map "c" [cancel])
56 ("n" . keypad-period)
57 ("M" . keypad-enter)
58
59 ("p" . keypad-0)
60 ("q" . keypad-1)
61 ("r" . keypad-2)
62 ("s" . keypad-3)
63 ("t" . keypad-4)
64 ("u" . keypad-5)
65 ("v" . keypad-6)
66 ("w" . keypad-7)
67 ("x" . keypad-8)
68 ("y" . keypad-9)
69
70 ; These three strings are just made up.
71 ("a" . execute) ; enter
72 ("b" . select) ; nfer
73 ("c" . cancel)))) ; xfer
74
75(let ((pads keypad-maps))
76 (while pads
77 (unwind-protect
78 (let* ((prefix (car (car pads)))
79 (stringmap (cdr (car pads)))
80 (padmap (if (lookup-key global-map prefix)
81 (error "Keymap entry for keypad prefix already exisists")
82 (make-sparse-keymap))))
83 (define-key global-map prefix padmap)
84 (setup-terminal-keymap padmap stringmap))
85 (setq pads (cdr pads)))))
diff --git a/src/keymap.c b/src/keymap.c
index 344b600a6be..d55c369356d 100644
--- a/src/keymap.c
+++ b/src/keymap.c
@@ -64,6 +64,9 @@ Lisp_Object Vminibuffer_local_completion_map;
64/* was MinibufLocalMustMatchMap */ 64/* was MinibufLocalMustMatchMap */
65Lisp_Object Vminibuffer_local_must_match_map; 65Lisp_Object Vminibuffer_local_must_match_map;
66 66
67/* Alist of minor mode variables and keymaps. */
68Lisp_Object Vminor_mode_map_alist;
69
67Lisp_Object Qkeymapp, Qkeymap; 70Lisp_Object Qkeymapp, Qkeymap;
68 71
69/* A char over 0200 in a key sequence 72/* A char over 0200 in a key sequence
@@ -77,6 +80,8 @@ static void describe_command ();
77static void describe_map (); 80static void describe_map ();
78static void describe_alist (); 81static void describe_alist ();
79 82
83/* Keymap object support - constructors and predicates. */
84
80DEFUN ("make-keymap", Fmake_keymap, Smake_keymap, 0, 0, 0, 85DEFUN ("make-keymap", Fmake_keymap, Smake_keymap, 0, 0, 0,
81 "Construct and return a new keymap, of the form (keymap VECTOR . ALIST).\n\ 86 "Construct and return a new keymap, of the form (keymap VECTOR . ALIST).\n\
82VECTOR is a 128-element vector which holds the bindings for the ASCII\n\ 87VECTOR is a 128-element vector which holds the bindings for the ASCII\n\
@@ -173,7 +178,8 @@ get_keymap_1 (object, error)
173 return tem; 178 return tem;
174 if (error) 179 if (error)
175 wrong_type_argument (Qkeymapp, object); 180 wrong_type_argument (Qkeymapp, object);
176 else return Qnil; 181 else
182 return Qnil;
177} 183}
178 184
179Lisp_Object 185Lisp_Object
@@ -387,6 +393,8 @@ is not copied.")
387 return copy; 393 return copy;
388} 394}
389 395
396/* Simple Keymap mutators and accessors. */
397
390DEFUN ("define-key", Fdefine_key, Sdefine_key, 3, 3, 0, 398DEFUN ("define-key", Fdefine_key, Sdefine_key, 3, 3, 0,
391 "Args KEYMAP, KEY, DEF. Define key sequence KEY, in KEYMAP, as DEF.\n\ 399 "Args KEYMAP, KEY, DEF. Define key sequence KEY, in KEYMAP, as DEF.\n\
392KEYMAP is a keymap. KEY is a string or a vector of symbols and characters\n\ 400KEYMAP is a keymap. KEY is a string or a vector of symbols and characters\n\
@@ -558,6 +566,75 @@ append_key (key_sequence, key)
558} 566}
559 567
560 568
569/* Global, local, and minor mode keymap stuff. */
570
571/* Store a pointer to an array of the keymaps of the currently active
572 minor modes in *buf, and return the number of maps it contains.
573
574 This function always returns a pointer to the same buffer, and may
575 free or reallocate it, so if you want to keep it for a long time or
576 hand it out to lisp code, copy it. This procedure will be called
577 for every key sequence read, so the nice lispy approach (return a
578 new assoclist, list, what have you) for each invocation would
579 result in a lot of consing over time.
580
581 If we used xrealloc/xmalloc and ran out of memory, they would throw
582 back to the command loop, which would try to read a key sequence,
583 which would call this function again, resulting in an infinite
584 loop. Instead, we'll use realloc/malloc and silently truncate the
585 list, let the key sequence be read, and hope some other piece of
586 code signals the error. */
587int
588current_minor_maps (modeptr, mapptr)
589 Lisp_Object **modeptr, **mapptr;
590{
591 static Lisp_Object *modes, *maps;
592 static int size;
593
594 int i = 0;
595 Lisp_Object alist, assoc, var;
596
597 for (alist = Vminor_mode_map_alist;
598 CONSP (alist);
599 alist = XCONS (alist)->cdr)
600 if (CONSP (assoc = XCONS (alist)->car)
601 && XTYPE (var = XCONS (assoc)->car) == Lisp_Symbol
602 && ! NULL (Fboundp (var))
603 && ! NULL (Fsymbol_value (var)))
604 {
605 if (i >= size)
606 {
607 Lisp_Object *newmodes, *newmaps;
608
609 if (maps)
610 {
611 newmodes = (Lisp_Object *) realloc (modes, size *= 2);
612 newmaps = (Lisp_Object *) realloc (maps, size);
613 }
614 else
615 {
616 newmodes = (Lisp_Object *) malloc (size = 30);
617 newmaps = (Lisp_Object *) malloc (size);
618 }
619
620 if (newmaps && newmodes)
621 {
622 modes = newmodes;
623 maps = newmaps;
624 }
625 else
626 break;
627 }
628 modes[i] = var;
629 maps [i] = XCONS (assoc)->cdr;
630 i++;
631 }
632
633 if (modeptr) *modeptr = modes;
634 if (mapptr) *mapptr = maps;
635 return i;
636}
637
561DEFUN ("key-binding", Fkey_binding, Skey_binding, 1, 1, 0, 638DEFUN ("key-binding", Fkey_binding, Skey_binding, 1, 1, 0,
562 "Return the binding for command KEY in current keymaps.\n\ 639 "Return the binding for command KEY in current keymaps.\n\
563KEY is a string, a sequence of keystrokes.\n\ 640KEY is a string, a sequence of keystrokes.\n\
@@ -565,22 +642,30 @@ The binding is probably a symbol with a function definition.")
565 (key) 642 (key)
566 Lisp_Object key; 643 Lisp_Object key;
567{ 644{
568 register Lisp_Object map, value, value1; 645 Lisp_Object *maps, value;
569 map = current_buffer->keymap; 646 int nmaps, i;
570 if (!NULL (map)) 647
648 nmaps = current_minor_maps (0, &maps);
649 for (i = 0; i < nmaps; i++)
650 if (! NULL (maps[i]))
651 {
652 value = Flookup_key (maps[i], key);
653 if (! NULL (value) && XTYPE (value) != Lisp_Int)
654 return value;
655 }
656
657 if (! NULL (current_buffer->keymap))
571 { 658 {
572 value = Flookup_key (map, key); 659 value = Flookup_key (current_buffer->keymap, key);
573 if (NULL (value)) 660 if (! NULL (value) && XTYPE (value) != Lisp_Int)
574 {
575 value1 = Flookup_key (current_global_map, key);
576 if (XTYPE (value1) == Lisp_Int)
577 return Qnil;
578 return value1;
579 }
580 else if (XTYPE (value) != Lisp_Int)
581 return value; 661 return value;
582 } 662 }
583 return Flookup_key (current_global_map, key); 663
664 value = Flookup_key (current_global_map, key);
665 if (! NULL (value) && XTYPE (value) != Lisp_Int)
666 return value;
667
668 return Qnil;
584} 669}
585 670
586DEFUN ("local-key-binding", Flocal_key_binding, Slocal_key_binding, 1, 1, 0, 671DEFUN ("local-key-binding", Flocal_key_binding, Slocal_key_binding, 1, 1, 0,
@@ -607,6 +692,38 @@ The binding is probably a symbol with a function definition.")
607 return Flookup_key (current_global_map, keys); 692 return Flookup_key (current_global_map, keys);
608} 693}
609 694
695DEFUN ("minor-mode-key-binding", Fminor_mode_key_binding, Sminor_mode_key_binding, 1, 1, 0,
696 "Find the visible minor mode bindings of KEY.\n\
697Return an alist of pairs (MODENAME . BINDING), where MODENAME is the\n\
698the symbol which names the minor mode binding KEY, and BINDING is\n\
699KEY's definition in that mode. In particular, if KEY has no\n\
700minor-mode bindings, return nil. If the first binding is a\n\
701non-prefix, all subsequent bindings will be omitted, since they would\n\
702be ignored. Similarly, the list doesn't include non-prefix bindings\n\
703that come after prefix bindings.")
704 (key)
705{
706 Lisp_Object *modes, *maps;
707 int nmaps;
708 Lisp_Object binding;
709 int i, j;
710
711 nmaps = current_minor_maps (&modes, &maps);
712
713 for (i = j = 0; i < nmaps; i++)
714 if (! NULL (maps[i])
715 && ! NULL (binding = Flookup_key (maps[i], key))
716 && XTYPE (binding) != Lisp_Int)
717 {
718 if (! NULL (get_keymap_1 (binding, 0)))
719 maps[j++] = Fcons (modes[i], binding);
720 else if (j == 0)
721 return Fcons (Fcons (modes[i], binding), Qnil);
722 }
723
724 return Flist (j, maps);
725}
726
610DEFUN ("global-set-key", Fglobal_set_key, Sglobal_set_key, 2, 2, 727DEFUN ("global-set-key", Fglobal_set_key, Sglobal_set_key, 2, 2,
611 "kSet key globally: \nCSet key %s to command: ", 728 "kSet key globally: \nCSet key %s to command: ",
612 "Give KEY a global binding as COMMAND.\n\ 729 "Give KEY a global binding as COMMAND.\n\
@@ -729,7 +846,19 @@ DEFUN ("current-global-map", Fcurrent_global_map, Scurrent_global_map, 0, 0, 0,
729{ 846{
730 return current_global_map; 847 return current_global_map;
731} 848}
849
850DEFUN ("current-minor-mode-maps", Fcurrent_minor_mode_maps, Scurrent_minor_mode_maps, 0, 0, 0,
851 "Return a list of keymaps for the minor modes of the current buffer.")
852 ()
853{
854 Lisp_Object *maps;
855 int nmaps = current_minor_maps (0, &maps);
856
857 return Flist (nmaps, maps);
858}
732 859
860/* Help functions for describing and documenting keymaps. */
861
733DEFUN ("accessible-keymaps", Faccessible_keymaps, Saccessible_keymaps, 862DEFUN ("accessible-keymaps", Faccessible_keymaps, Saccessible_keymaps,
734 1, 1, 0, 863 1, 1, 0,
735 "Find all keymaps accessible via prefix characters from KEYMAP.\n\ 864 "Find all keymaps accessible via prefix characters from KEYMAP.\n\
@@ -1021,6 +1150,8 @@ Control characters turn into \"^char\", etc.")
1021 return build_string (tem); 1150 return build_string (tem);
1022} 1151}
1023 1152
1153/* where-is - finding a command in a set of keymaps. */
1154
1024DEFUN ("where-is-internal", Fwhere_is_internal, Swhere_is_internal, 1, 5, 0, 1155DEFUN ("where-is-internal", Fwhere_is_internal, Swhere_is_internal, 1, 5, 0,
1025 "Return list of keys that invoke DEFINITION in KEYMAP or KEYMAP1.\n\ 1156 "Return list of keys that invoke DEFINITION in KEYMAP or KEYMAP1.\n\
1026If KEYMAP is nil, search only KEYMAP1.\n\ 1157If KEYMAP is nil, search only KEYMAP1.\n\
@@ -1212,6 +1343,8 @@ Argument is a command definition, usually a symbol with a function definition.")
1212 return Qnil; 1343 return Qnil;
1213} 1344}
1214 1345
1346/* describe-bindings - summarizing all the bindings in a set of keymaps. */
1347
1215DEFUN ("describe-bindings", Fdescribe_bindings, Sdescribe_bindings, 0, 0, "", 1348DEFUN ("describe-bindings", Fdescribe_bindings, Sdescribe_bindings, 0, 0, "",
1216 "Show a list of all defined keys, and their definitions.\n\ 1349 "Show a list of all defined keys, and their definitions.\n\
1217The list is put in a buffer, which is displayed.") 1350The list is put in a buffer, which is displayed.")
@@ -1236,19 +1369,41 @@ describe_buffer_bindings (descbuf)
1236 1369
1237 Fset_buffer (Vstandard_output); 1370 Fset_buffer (Vstandard_output);
1238 1371
1372 {
1373 int i, nmaps;
1374 Lisp_Object *modes, *maps;
1375
1376 nmaps = current_minor_maps (&modes, &maps);
1377 for (i = 0; i < nmaps; i++)
1378 {
1379 if (XTYPE (modes[i]) == Lisp_Symbol)
1380 {
1381 insert_char ('`');
1382 insert_string (XSYMBOL (modes[i])->name->data);
1383 insert_char ('\'');
1384 }
1385 else
1386 insert_string ("Strangely Named");
1387 insert_string (" Minor Mode Bindings:\n");
1388 insert_string (heading);
1389 describe_map_tree (maps[i], 0, Qnil);
1390 insert_char ('\n');
1391 }
1392 }
1393
1239 start1 = XBUFFER (descbuf)->keymap; 1394 start1 = XBUFFER (descbuf)->keymap;
1240 if (!NULL (start1)) 1395 if (!NULL (start1))
1241 { 1396 {
1242 insert_string ("Local Bindings:\n"); 1397 insert_string ("Local Bindings:\n");
1243 insert_string (heading); 1398 insert_string (heading);
1244 describe_map_tree (start1, 0, Qnil, Qnil); 1399 describe_map_tree (start1, 0, Qnil);
1245 insert_string ("\n"); 1400 insert_string ("\n");
1246 } 1401 }
1247 1402
1248 insert_string ("Global Bindings:\n"); 1403 insert_string ("Global Bindings:\n");
1249 insert_string (heading); 1404 insert_string (heading);
1250 1405
1251 describe_map_tree (current_global_map, 0, XBUFFER (descbuf)->keymap, Qnil); 1406 describe_map_tree (current_global_map, 0, XBUFFER (descbuf)->keymap);
1252 1407
1253 Fset_buffer (descbuf); 1408 Fset_buffer (descbuf);
1254 return Qnil; 1409 return Qnil;
@@ -1563,7 +1718,7 @@ describe_vector (vector, elt_prefix, elt_describer, partial, shadow)
1563 UNGCPRO; 1718 UNGCPRO;
1564} 1719}
1565 1720
1566/* Apropos */ 1721/* Apropos - finding all symbols whose names match a regexp. */
1567Lisp_Object apropos_predicate; 1722Lisp_Object apropos_predicate;
1568Lisp_Object apropos_accumulate; 1723Lisp_Object apropos_accumulate;
1569 1724
@@ -1639,6 +1794,14 @@ syms_of_keymap ()
1639 1794
1640 current_global_map = global_map; 1795 current_global_map = global_map;
1641 1796
1797 DEFVAR_LISP ("minor-mode-map-alist", &Vminor_mode_map_alist,
1798 "Alist of keymaps to use for minor modes.\n\
1799Each element looks like (VARIABLE . KEYMAP); KEYMAP is used to read\n\
1800key sequences and look up bindings iff VARIABLE's value is non-nil.\n\
1801If two active keymaps bind the same key, the keymap appearing earlier\n\
1802in the list takes precedence.");
1803 Vminor_mode_map_alist = Qnil;
1804
1642 Qsingle_key_description = intern ("single-key-description"); 1805 Qsingle_key_description = intern ("single-key-description");
1643 staticpro (&Qsingle_key_description); 1806 staticpro (&Qsingle_key_description);
1644 1807
@@ -1655,6 +1818,7 @@ syms_of_keymap ()
1655 defsubr (&Skey_binding); 1818 defsubr (&Skey_binding);
1656 defsubr (&Slocal_key_binding); 1819 defsubr (&Slocal_key_binding);
1657 defsubr (&Sglobal_key_binding); 1820 defsubr (&Sglobal_key_binding);
1821 defsubr (&Sminor_mode_key_binding);
1658 defsubr (&Sglobal_set_key); 1822 defsubr (&Sglobal_set_key);
1659 defsubr (&Slocal_set_key); 1823 defsubr (&Slocal_set_key);
1660 defsubr (&Sdefine_key); 1824 defsubr (&Sdefine_key);
@@ -1666,6 +1830,7 @@ syms_of_keymap ()
1666 defsubr (&Suse_local_map); 1830 defsubr (&Suse_local_map);
1667 defsubr (&Scurrent_local_map); 1831 defsubr (&Scurrent_local_map);
1668 defsubr (&Scurrent_global_map); 1832 defsubr (&Scurrent_global_map);
1833 defsubr (&Scurrent_minor_mode_maps);
1669 defsubr (&Saccessible_keymaps); 1834 defsubr (&Saccessible_keymaps);
1670 defsubr (&Skey_description); 1835 defsubr (&Skey_description);
1671 defsubr (&Sdescribe_vector); 1836 defsubr (&Sdescribe_vector);