Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Open sidebar
emacs
emacs
Commits
cc0a8174
Commit
cc0a8174
authored
Dec 20, 1991
by
Jim Blandy
Browse files
*** empty log message ***
parent
6367dc09
Changes
3
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
379 additions
and
312 deletions
+379
-312
lisp/mouse.el
lisp/mouse.el
+162
-230
lisp/term/news.el
lisp/term/news.el
+35
-65
src/keymap.c
src/keymap.c
+182
-17
No files found.
lisp/mouse.el
View file @
cc0a8174
;;
Mouse support that is independent of window systems
.
;; Copyright (C) 1988 Free Software Foundation, Inc.
;;
; Window system-independent mouse support
.
;;
;
Copyright (C) 1988 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
;;
;
This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 1, or (at your option)
;; any later version.
;;
;
GNU Emacs is free software; you can redistribute it and/or modify
;;
;
it under the terms of the GNU General Public License as published by
;;
;
the Free Software Foundation; either version 1, or (at your option)
;;
;
any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;
GNU Emacs is distributed in the hope that it will be useful,
;;
;
but WITHOUT ANY WARRANTY; without even the implied warranty of
;;
;
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;
;
GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
;;
;
You should have received a copy of the GNU General Public License
;;
;
along with GNU Emacs; see the file COPYING. If not, write to
;;
;
the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
(
provide
'mouse
)
(
defun
mouse-select
()
"Select the Emacs window the mouse is on."
(
interactive
"@"
))
;;; Utility functions.
(
defun
mouse-delete-window
()
"Delete the Emacs window the mouse is on."
(
interactive
"@"
)
(
delete-window
))
(
defun
mouse-movement-p
(
event
)
(
and
(
consp
event
)
(
eq
(
car
event
)
'mouse-movement
)))
(
defun
mouse-keep-one-window
(
)
"Select Emacs window mouse is on, then kill all other Emacs windows."
(
interactive
"@"
)
(
de
lete-other-windows
))
(
defun
event-window
(
event
)
(
nth
1
event
)
)
(
defun
event-point
(
event
)
(
nth
2
event
))
(
defun
mouse-coords
(
event
)
(
nth
3
event
)
)
(
de
fun
mouse-timestamp
(
event
)
(
nth
4
event
))
(
defun
mouse-select-and-split
()
"Select Emacs window mouse is on, then split it vertically in half."
(
interactive
"@"
)
(
split-window-vertically
nil
))
;;; Indent track-mouse like progn.
(
put
'track-mouse
'lisp-indent-function
0
)
(
defun
mouse-set-point
(
event
)
"Select Emacs window mouse is on, and move point to mouse position."
(
interactive
"@e"
)
(
let
((
relative-coordinate
(
coordinates-in-window-p
(
car
event
)
(
selected-window
))))
(
if
(
consp
relative-coordinate
)
(
progn
(
move-to-window-line
(
car
(
cdr
relative-coordinate
)))
;; Note that hscroll must get above 1
;; before the text actually starts to move.
(
move-to-column
(
+
(
car
relative-coordinate
)
(
current-column
)
(
1-
(
max
1
(
window-hscroll
(
selected-window
))))))
(
what-line
)))))
(
defun
mouse-eval-last-sexpr
(
event
)
(
interactive
"@e"
)
(
save-excursion
(
mouse-set-point
event
)
(
eval-last-sexp
nil
)))
(
defun
mouse-delete-window
(
click
)
"Delete the window clicked on.
This must be bound to a mouse click."
(
interactive
"K"
)
(
delete-window
(
event-window
click
)))
(
defun
mouse-delete-other-windows
(
click
)
"Select Emacs window clicked on, then kill all other Emacs windows.
This must be bound to a mouse click."
(
interactive
"K"
)
(
select-window
(
event-window
click
))
(
delete-other-windows
))
(
defun
mouse-line-length
(
event
)
"Print the length of the line indicated by the pointer."
(
interactive
"@e"
)
(
let
((
relative-coordinate
(
coordinates-in-window-p
(
car
event
)
(
selected-window
))))
(
if
(
consp
relative-coordinate
)
(
save-excursion
(
move-to-window-line
(
car
(
cdr
relative-coordinate
)))
(
end-of-line
)
(
push-mark
nil
t
)
(
beginning-of-line
)
(
message
"Line length: %d"
(
-
(
region-end
)
(
region-beginning
)))
(
sleep-for
1
)))))
(
defun
mouse-set-mark
(
event
)
"Select Emacs window mouse is on, and set mark at mouse position.
Display cursor at that position for a second."
(
interactive
"@e"
)
(
defun
mouse-split-window-vertically
(
click
)
"Select Emacs window mouse is on, then split it vertically in half.
The window is split at the line clicked on.
This command must be bound to a mouse click."
(
interactive
"K"
)
(
select-window
(
event-window
click
))
(
split-window-vertically
(
1+
(
cdr
(
mouse-coords
click
)))))
(
defun
mouse-set-point
(
click
)
"Move point to the position clicked on with the mouse.
This must be bound to a mouse click."
(
interactive
"K"
)
(
select-window
(
event-window
click
))
(
goto-char
(
event-point
click
)))
(
defun
mouse-set-mark
(
click
)
"Set mark at the position clicked on with the mouse.
Display cursor at that position for a second.
This must be bound to a mouse click."
(
interactive
"K"
)
(
let
((
point-save
(
point
)))
(
unwind-protect
(
progn
(
mouse-set-point
event
)
(
progn
(
mouse-set-point
click
)
(
push-mark
nil
t
)
(
sit-for
1
))
(
goto-char
point-save
))))
(
defun
mouse-fill-paragraph
(
event
)
"Fill the paragraph at the mouse position."
(
interactive
"@e"
)
(
save-excursion
(
mouse-set-point
event
)
(
fill-paragraph
)))
(
defun
mouse-fill-paragraph-with-prefix
(
event
)
"Fill the paragraph at the mouse position with specified fill prefix.
Click at the end of the fill prefix that you want;
The text before the mouse position, on the same line, is used as the prefix."
(
interactive
"@e"
)
(
save-excursion
(
mouse-set-point
event
)
(
let
((
fill-prefix
(
buffer-substring
(
save-excursion
(
beginning-of-line
)
(
point
))
(
point
))))
(
fill-paragraph
))))
(
defun
mouse-scroll
(
event
)
"Scroll point to the mouse position."
(
interactive
"@e"
)
(
let
((
relative-coordinate
(
coordinates-in-window-p
(
car
event
)
(
selected-window
))))
(
if
(
consp
relative-coordinate
)
(
progn
(
recenter
(
car
(
cdr
relative-coordinate
)))
(
scroll-right
(
+
(
car
relative-coordinate
)
(
current-column
)))))))
(
defun
mouse-del-char
(
event
)
"Delete the char pointed to by the mouse."
(
interactive
"@e"
)
(
let
((
relative-coordinate
(
coordinates-in-window-p
(
car
event
)
(
selected-window
))))
(
if
(
consp
relative-coordinate
)
(
progn
(
move-to-window-line
(
car
(
cdr
relative-coordinate
)))
(
move-to-column
(
+
(
car
relative-coordinate
)
(
current-column
)))
(
delete-char
1
nil
)))))
(
defun
mouse-kill
(
click
)
"Kill the region between point and the mouse click.
The text is saved in the kill ring, as with \\[kill-region]."
(
interactive
"K"
)
(
mouse-set-mark
click
)
(
kill-region
))
(
defun
mouse-kill-line
(
event
)
"Kill the line pointed to by the mouse."
(
interactive
"@e"
)
(
let
((
relative-coordinate
(
coordinates-in-window-p
(
car
event
)
(
selected-window
))))
(
if
(
consp
relative-coordinate
)
(
progn
(
move-to-window-line
(
car
(
cdr
relative-coordinate
)))
(
move-to-column
(
+
(
car
relative-coordinate
)
(
current-column
)))
(
kill-line
nil
)))))
(
defun
mouse-kill-ring-save
"Copy the region between point and the mouse click in the kill ring.
This does not delete the region; it acts like \\[kill-ring-save]."
(
interactive
"K"
)
(
mouse-set-mark
click
)
(
kill-ring-save
))
(
defun
narrow-window-to-region
(
m
n
)
"Narrow window to region between point and last mark"
(
interactive
"r"
)
(
save-excursion
(
save-restriction
(
if
(
eq
(
selected-window
)
(
next-window
))
(
split-window
))
(
goto-char
m
)
(
recenter
0
)
(
if
(
eq
(
selected-window
)
(
if
(
zerop
(
minibuffer-depth
))
(
next-window
)))
()
(
shrink-window
(
-
(
-
(
window-height
)
(
count-lines
m
n
))
1
))))))
(
defun
mouse-window-to-region
(
event
)
"Narrow window to region between cursor and mouse pointer."
(
interactive
"@e"
)
(
let
((
point-save
(
point
)))
(
unwind-protect
(
progn
(
mouse-set-point
event
)
(
push-mark
nil
t
)
(
sit-for
1
))
(
goto-char
point-save
)
(
narrow-window-to-region
(
region-beginning
)
(
region-end
)))))
(
defun
mouse-ignore
()
"Don't do anything."
(
interactive
))
;; Commands for the scroll bar.
...
...
@@ -231,77 +156,77 @@ The text before the mouse position, on the same line, is used as the prefix."
;; Set up these commands, including the prefix keys for the scroll bar.
(
fset
'mouse-vertical-scroll-bar-prefix
(
make-sparse-keymap
))
(
define-key
global-mouse-map
mouse-vertical-scroll-bar-prefix
'mouse-vertical-scroll-bar-prefix
)
(
defun
mouse-scroll-motion
(
event
)
(
interactive
"e"
)
(
let
((
pos
(
car
(
car
event
)))
(
length
(
car
(
cdr
(
car
event
)))))
(
message
"[%d %d]"
pos
length
)))
(
let
((
map
(
function
mouse-vertical-scroll-bar-prefix
)))
(
define-key
map
mouse-button-right
'mouse-scroll-down
)
(
define-key
map
mouse-button-left
'mouse-scroll-up
)
(
define-key
map
mouse-button-middle
'mouse-scroll-absolute
)
(
define-key
map
mouse-motion
'x-horizontal-line
))
;(fset 'mouse-vertical-slider-prefix (make-sparse-keymap))
;(define-key global-mouse-map mouse-vertical-slider-prefix
; 'mouse-vertical-slider-prefix)
;(let ((map (function mouse-vertical-slider-prefix)))
; (define-key map mouse-button-right 'mouse-scroll-move-cursor)
; (define-key map mouse-button-left 'mouse-scroll-move-cursor)
; (define-key map mouse-button-middle 'mouse-scroll-move-cursor))
(
fset
'mouse-vertical-thumbup-prefix
(
make-sparse-keymap
))
(
define-key
global-mouse-map
mouse-vertical-thumbup-prefix
'mouse-vertical-thumbup-prefix
)
(
let
((
map
(
function
mouse-vertical-thumbup-prefix
)))
(
define-key
map
mouse-button-right
'mouse-scroll-down-full
)
(
define-key
map
mouse-button-left
'mouse-scroll-down-full
)
(
define-key
map
mouse-button-middle
'mouse-scroll-down-full
))
(
fset
'mouse-vertical-thumbdown-prefix
(
make-sparse-keymap
))
(
define-key
global-mouse-map
mouse-vertical-thumbdown-prefix
'mouse-vertical-thumbdown-prefix
)
(
let
((
map
(
function
mouse-vertical-thumbdown-prefix
)))
(
define-key
map
mouse-button-right
'mouse-scroll-up-full
)
(
define-key
map
mouse-button-left
'mouse-scroll-up-full
)
(
define-key
map
mouse-button-middle
'mouse-scroll-up-full
))
;; Horizontal bar
(
fset
'mouse-horizontal-scroll-bar-prefix
(
make-sparse-keymap
))
(
define-key
global-mouse-map
mouse-horizontal-scroll-bar-prefix
'mouse-horizontal-scroll-bar-prefix
)
(
let
((
map
(
function
mouse-horizontal-scroll-bar-prefix
)))
(
define-key
map
mouse-button-right
'mouse-scroll-right
)
(
define-key
map
mouse-button-left
'mouse-scroll-left
)
(
define-key
map
mouse-button-middle
'mouse-scroll-absolute-horizontally
))
(
fset
'mouse-horizontal-thumbleft-prefix
(
make-sparse-keymap
))
(
define-key
global-mouse-map
mouse-horizontal-thumbleft-prefix
'mouse-horizontal-thumbleft-prefix
)
(
let
((
map
(
function
mouse-horizontal-thumbleft-prefix
)))
(
define-key
map
mouse-button-right
'mouse-scroll-left-full
)
(
define-key
map
mouse-button-left
'mouse-scroll-left-full
)
(
define-key
map
mouse-button-middle
'mouse-scroll-left-full
))
(
fset
'mouse-horizontal-thumbright-prefix
(
make-sparse-keymap
))
(
define-key
global-mouse-map
mouse-horizontal-thumbright-prefix
'mouse-horizontal-thumbright-prefix
)
(
let
((
map
(
function
mouse-horizontal-thumbright-prefix
)))
(
define-key
map
mouse-button-right
'mouse-scroll-right-full
)
(
define-key
map
mouse-button-left
'mouse-scroll-right-full
)
(
define-key
map
mouse-button-middle
'mouse-scroll-right-full
))
;;;
(fset 'mouse-vertical-scroll-bar-prefix (make-sparse-keymap))
;;;
(define-key global-mouse-map mouse-vertical-scroll-bar-prefix
;;;
'mouse-vertical-scroll-bar-prefix)
;;;
;;;
(defun mouse-scroll-motion (event)
;;;
(interactive "e")
;;;
(let ((pos (car (car event)))
;;;
(length (car (cdr (car event)))))
;;;
(message "[%d %d]" pos length)))
;;;
;;;
(let ((map (function mouse-vertical-scroll-bar-prefix)))
;;;
(define-key map mouse-button-right 'mouse-scroll-down)
;;;
(define-key map mouse-button-left 'mouse-scroll-up)
;;;
(define-key map mouse-button-middle 'mouse-scroll-absolute)
;;;
(define-key map mouse-motion 'x-horizontal-line))
;;;
;;;
;(fset 'mouse-vertical-slider-prefix (make-sparse-keymap))
;;;
;(define-key global-mouse-map mouse-vertical-slider-prefix
;;;
; 'mouse-vertical-slider-prefix)
;;;
;;;
;(let ((map (function mouse-vertical-slider-prefix)))
;;;
; (define-key map mouse-button-right 'mouse-scroll-move-cursor)
;;;
; (define-key map mouse-button-left 'mouse-scroll-move-cursor)
;;;
; (define-key map mouse-button-middle 'mouse-scroll-move-cursor))
;;;
;;;
(fset 'mouse-vertical-thumbup-prefix (make-sparse-keymap))
;;;
(define-key global-mouse-map mouse-vertical-thumbup-prefix
;;;
'mouse-vertical-thumbup-prefix)
;;;
;;;
(let ((map (function mouse-vertical-thumbup-prefix)))
;;;
(define-key map mouse-button-right 'mouse-scroll-down-full)
;;;
(define-key map mouse-button-left 'mouse-scroll-down-full)
;;;
(define-key map mouse-button-middle 'mouse-scroll-down-full))
;;;
;;;
(fset 'mouse-vertical-thumbdown-prefix (make-sparse-keymap))
;;;
(define-key global-mouse-map mouse-vertical-thumbdown-prefix
;;;
'mouse-vertical-thumbdown-prefix)
;;;
;;;
(let ((map (function mouse-vertical-thumbdown-prefix)))
;;;
(define-key map mouse-button-right 'mouse-scroll-up-full)
;;;
(define-key map mouse-button-left 'mouse-scroll-up-full)
;;;
(define-key map mouse-button-middle 'mouse-scroll-up-full))
;;;
;;;
;; Horizontal bar
;;;
;;;
(fset 'mouse-horizontal-scroll-bar-prefix (make-sparse-keymap))
;;;
(define-key global-mouse-map mouse-horizontal-scroll-bar-prefix
;;;
'mouse-horizontal-scroll-bar-prefix)
;;;
;;;
(let ((map (function mouse-horizontal-scroll-bar-prefix)))
;;;
(define-key map mouse-button-right 'mouse-scroll-right)
;;;
(define-key map mouse-button-left 'mouse-scroll-left)
;;;
(define-key map mouse-button-middle 'mouse-scroll-absolute-horizontally))
;;;
;;;
(fset 'mouse-horizontal-thumbleft-prefix (make-sparse-keymap))
;;;
(define-key global-mouse-map mouse-horizontal-thumbleft-prefix
;;;
'mouse-horizontal-thumbleft-prefix)
;;;
;;;
(let ((map (function mouse-horizontal-thumbleft-prefix)))
;;;
(define-key map mouse-button-right 'mouse-scroll-left-full)
;;;
(define-key map mouse-button-left 'mouse-scroll-left-full)
;;;
(define-key map mouse-button-middle 'mouse-scroll-left-full))
;;;
;;;
(fset 'mouse-horizontal-thumbright-prefix (make-sparse-keymap))
;;;
(define-key global-mouse-map mouse-horizontal-thumbright-prefix
;;;
'mouse-horizontal-thumbright-prefix)
;;;
;;;
(let ((map (function mouse-horizontal-thumbright-prefix)))
;;;
(define-key map mouse-button-right 'mouse-scroll-right-full)
;;;
(define-key map mouse-button-left 'mouse-scroll-right-full)
;;;
(define-key map mouse-button-middle 'mouse-scroll-right-full))
;;;;
...
...
@@ -402,10 +327,10 @@ The text before the mouse position, on the same line, is used as the prefix."
(
x-erase-rectangle
(
selected-screen
))
(
setq
last-line-drawn
nil
))))
(
defun
test-x-rectangle
()
(
use-local-mouse-map
(
setq
rectangle-test-map
(
make-sparse-keymap
)))
(
define-key
rectangle-test-map
mouse-motion-button-left
'mouse-boxing
)
(
define-key
rectangle-test-map
mouse-button-left-up
'mouse-erase-box
))
;;;
(defun test-x-rectangle ()
;;;
(use-local-mouse-map (setq rectangle-test-map (make-sparse-keymap)))
;;;
(define-key rectangle-test-map mouse-motion-button-left 'mouse-boxing)
;;;
(define-key rectangle-test-map mouse-button-left-up 'mouse-erase-box))
;;
;; 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."
(
>
(
-
(
nth
4
event
)
double-start
)
double-click-interval
)
(
setq
double-start
nil
)))
(
defun
x-test-doubleclick
()
(
use-local-mouse-map
(
setq
doubleclick-test-map
(
make-sparse-keymap
)))
(
define-key
doubleclick-test-map
mouse-button-left
'double-down
)
(
define-key
doubleclick-test-map
mouse-button-left-up
'double-up
))
;;;
(defun x-test-doubleclick ()
;;;
(use-local-mouse-map (setq doubleclick-test-map (make-sparse-keymap)))
;;;
(define-key doubleclick-test-map mouse-button-left 'double-down)
;;;
(define-key doubleclick-test-map mouse-button-left-up 'double-up))
;;
;; 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."
(
setq
scrolled-lines
0
)
(
sleep-for
1
))
(
defun
x-testing-scroll
()
(
let
((
scrolling-map
(
function
mouse-vertical-scroll-bar-prefix
)))
(
define-key
scrolling-map
mouse-button-left
'incr-scroll-down
)
(
define-key
scrolling-map
mouse-button-right
'incr-scroll-up
)
(
define-key
scrolling-map
mouse-button-left-up
'incr-scroll-stop
)
(
define-key
scrolling-map
mouse-button-right-up
'incr-scroll-stop
)))
;;;
(defun x-testing-scroll ()
;;;
(let ((scrolling-map (function mouse-vertical-scroll-bar-prefix)))
;;;
(define-key scrolling-map mouse-button-left 'incr-scroll-down)
;;;
(define-key scrolling-map mouse-button-right 'incr-scroll-up)
;;;
(define-key scrolling-map mouse-button-left-up 'incr-scroll-stop)
;;;
(define-key scrolling-map mouse-button-right-up 'incr-scroll-stop)))
;;
;; 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."
(
mouse-multiple-insert
(
-
(
car
relative-coordinate
)
(
current-column
))
" "
))
((
=
(
current-column
)
(
car
relative-coordinate
))
(
ding
))))))
;;; Bindings for mouse commands.
(
global-set-key
[mouse-1]
'mouse-set-point
)
(
global-set-key
[S-mouse-1]
'mouse-set-mark
)
(
global-set-key
[mouse-3]
'mouse-delete-other-windows
)
lisp/term/news.el
View file @
cc0a8174
...
...
@@ -18,68 +18,38 @@
;; file named COPYING. Among other things, the copyright notice
;; and this notice must be preserved on all copies.
;; This file effects a mapping from the raw escape sequences of various
;; keypad and function keys to the symbols used by emacs to represent
;; those keys. The mapping from key symbol to the function performed
;; when that key is pressed is handled keyboard-independently by the file
;; ../keypad.el.
;; Note that his file is also used under X11. For this to work, the variable
;; names must not change from keyboard file to keyboard file, nor can the
;; structure of keypad-maps change.
(
require
'keypad
)
(
defvar
keypads
nil
"Keypad and function keys keymap for Sony News machine."
)
(
defvar
keypad-maps
nil
"A list of strings sent by the keypad and function keys on the Sony News.
There is an element for each unique prefix. Each element is of the form
(PREFIX map map ...), each map being (string . symbol)."
)
(
setq
keypad-maps
'
((
"\eO"
(
"P"
.
function-1
)
(
"Q"
.
function-2
)
(
"R"
.
function-3
)
(
"S"
.
function-4
)
(
"T"
.
function-5
)
(
"U"
.
function-6
)
(
"V"
.
function-7
)
(
"W"
.
function-8
)
(
"X"
.
function-9
)
(
"Y"
.
function-10
)
(
"m"
.
keypad-subtract
)
(
"k"
.
keypad-add
)
(
"l"
.
keypad-comma
)
(
"n"
.
keypad-period
)
(
"M"
.
keypad-enter
)
(
"p"
.
keypad-0
)
(
"q"
.
keypad-1
)
(
"r"
.
keypad-2
)
(
"s"
.
keypad-3
)
(
"t"
.
keypad-4
)
(
"u"
.
keypad-5
)
(
"v"
.
keypad-6
)
(
"w"
.
keypad-7
)
(
"x"
.
keypad-8
)
(
"y"
.
keypad-9
)
; These three strings are just made up.
(
"a"
.
execute
)
; enter
(
"b"
.
select
)
; nfer
(
"c"
.
cancel
))))
; xfer
(
let
((
pads
keypad-maps
))
(
while
pads
(
unwind-protect
(
let*
((
prefix
(
car
(
car
pads
)))
(
stringmap
(
cdr
(
car
pads
)))
(
padmap
(
if
(
lookup-key
global-map
prefix
)
(
error
"Keymap entry for keypad prefix already exisists"
)
(
make-sparse-keymap
))))
(
define-key
global-map
prefix
padmap
)
(
setup-terminal-keymap
padmap
stringmap
))
(
setq
pads
(
cdr
pads
)))))
;; This file places entries in function-key-map for the raw escape
;; sequences of various keypad and function keys, binding them to
;; their symbolic forms.
(
define-prefix-command
'news-fkey-prefix
'news-fkey-map
)
(
define-key
function-key-map
"\eO"
'news-fkey-prefix
)
(
define-key
news-fkey-map
"P"
[f1]
)
(
define-key
news-fkey-map
"Q"
[f2]
)
(
define-key
news-fkey-map
"R"
[f3]
)
(
define-key
news-fkey-map
"S"
[f4]
)
(
define-key
news-fkey-map
"T"
[f5]
)
(
define-key
news-fkey-map
"U"
[f6]
)
(
define-key
news-fkey-map
"V"
[f7]
)
(
define-key
news-fkey-map
"W"
[f8]
)
(
define-key
news-fkey-map
"X"
[f9]
)
(
define-key
news-fkey-map
"Y"
[f10]
)
(
define-key
news-fkey-map
"m"
[kp-subtract]
)
(
define-key
news-fkey-map
"k"
[kp-add]
)
(
define-key
news-fkey-map
"l"
[kp-separator]
)
(
define-key
news-fkey-map
"n"
[kp-period]
)
(
define-key
news-fkey-map
"M"
[kp-enter]
)
(
define-key
news-fkey-map
"p"
[kp-0]
)
(
define-key
news-fkey-map
"q"
[kp-1]
)
(
define-key
news-fkey-map
"r"
[kp-2]
)
(
define-key
news-fkey-map
"s"
[kp-3]
)
(
define-key
news-fkey-map
"t"
[kp-4]
)
(
define-key
news-fkey-map
"u"
[kp-5]
)
(
define-key
news-fkey-map
"v"
[kp-6]
)
(
define-key
news-fkey-map
"w"
[kp-7]
)
(
define-key
news-fkey-map
"x"
[kp-8]
)
(
define-key
news-fkey-map
"y"
[kp-9]
)
(
define-key
news-fkey-map
"a"
[execute]
)
(
define-key
news-fkey-map
"b"
[select]
)
(
define-key
news-fkey-map
"c"
[cancel]
)
src/keymap.c
View file @
cc0a8174
...
...
@@ -64,6 +64,9 @@ Lisp_Object Vminibuffer_local_completion_map;
/* was MinibufLocalMustMatchMap */
Lisp_Object
Vminibuffer_local_must_match_map
;
/* Alist of minor mode variables and keymaps. */
Lisp_Object
Vminor_mode_map_alist
;
Lisp_Object
Qkeymapp
,
Qkeymap
;
/* A char over 0200 in a key sequence
...
...
@@ -77,6 +80,8 @@ static void describe_command ();
static
void
describe_map
();
static
void
describe_alist
();
/* Keymap object support - constructors and predicates. */
DEFUN
(
"make-keymap"
,
Fmake_keymap
,
Smake_keymap
,
0
,
0
,
0
,
"Construct and return a new keymap, of the form (keymap VECTOR . ALIST).
\n
\
VECTOR is a 128-element vector which holds the bindings for the ASCII
\n
\
...
...
@@ -173,7 +178,8 @@ get_keymap_1 (object, error)
return
tem
;
if
(
error
)
wrong_type_argument
(
Qkeymapp
,
object
);
else
return
Qnil
;
else
return
Qnil
;
}
Lisp_Object
...
...
@@ -387,6 +393,8 @@ is not copied.")
return
copy
;
}
/* Simple Keymap mutators and accessors. */
DEFUN
(
"define-key"
,
Fdefine_key
,
Sdefine_key
,
3
,
3
,
0
,
"Args KEYMAP, KEY, DEF. Define key sequence KEY, in KEYMAP, as DEF.
\n
\
KEYMAP is a keymap. KEY is a string or a vector of symbols and characters
\n
\
...
...
@@ -558,6 +566,75 @@ append_key (key_sequence, key)
}
/* Global, local, and minor mode keymap stuff. */
/* Store a pointer to an array of the keymaps of the currently active
minor modes in *buf, and return the number of maps it contains.
This function always returns a pointer to the same buffer, and may
free or reallocate it, so if you want to keep it for a long time or
hand it out to lisp code, copy it. This procedure will be called
for every key sequence read, so the nice lispy approach (return a
new assoclist, list, what have you) for each invocation would
result in a lot of consing over time.
If we used xrealloc/xmalloc and ran out of memory, they would throw
back to the command loop, which would try to read a key sequence,
which would call this function again, resulting in an infinite
loop. Instead, we'll use realloc/malloc and silently truncate the
list, let the key sequence be read, and hope some other piece of
code signals the error. */
int
current_minor_maps
(
modeptr
,
mapptr
)
Lisp_Object
**
modeptr
,
**
mapptr
;
{
static
Lisp_Object
*
modes
,
*
maps
;
static
int
size
;
int
i
=
0
;
Lisp_Object
alist
,
assoc
,
var
;
for
(
alist
=
Vminor_mode_map_alist
;
CONSP
(
alist
);
alist
=
XCONS
(
alist
)
->
cdr
)
if
(
CONSP
(
assoc
=
XCONS
(
alist
)
->
car
)
&&
XTYPE
(
var
=
XCONS
(
assoc
)
->
car
)
==
Lisp_Symbol
&&
!
NULL
(
Fboundp
(
var
))
&&
!
NULL
(
Fsymbol_value
(
var
)))
{
if
(
i
>=
size
)
{
Lisp_Object
*
newmodes
,
*
newmaps
;