1 ;;; Simple built-in editing commands.
5 (defun forward-point (n)
6 "Return buffer position N characters after (before if N negative) point."
10 (defcommand forward-char
((&optional
(n 1))
12 "Move the point forward N characters in the current buffer."
13 (incf (marker-position (buffer-point (current-buffer))) n
)
14 (cond ((< (pt) (begv))
16 (signal 'beginning-of-buffer
))
19 (signal 'end-of-buffer
))))
21 (defcommand backward-char
((&optional
(n 1))
25 (defun forward-line (n)
26 "Move n lines forward (backward if n is negative).
27 Precisely, if point is on line I, move to the start of line I + n.
28 If there isn't room, go as far as possible (no error).
29 Returns the count of lines left to move. If moving forward,
30 that is n - number of lines moved; if backward, n + number moved.
31 With positive n, a non-empty line at the end counts as one line
32 successfully moved (for the return value)."
35 (signal 'end-of-buffer
))
38 (signal 'beginning-of-buffer
)))
40 (multiple-value-bind (p lines
) (buffer-scan-newline (current-buffer)
42 (1- (buffer-size (current-buffer)))
44 ;; Increment p by one so the point is at the beginning of the
46 (when (or (char= (buffer-char-after (current-buffer) p
) #\Newline
)
47 (= p
(1- (buffer-size (current-buffer)))))
51 (signal 'end-of-buffer
))
54 (not (buffer-char-before (current-buffer) (pt))))
56 ;; A little mess to figure out how many newlines to search
57 ;; for to give the proper output.
58 (let ((lines (if (and (buffer-char-after (current-buffer) (pt))
59 (char= (buffer-char-after (current-buffer) (pt)) #\Newline
))
62 (multiple-value-bind (p flines
)
63 (buffer-scan-newline (current-buffer)
66 (when (and (char= (buffer-char-after (current-buffer) p
) #\Newline
)
72 (signal 'beginning-of-buffer
))
75 (defun beginning_of_line ()
76 (error "unimplemented beginning_of_line"))
79 (error "unimplemented end_of_line"))
81 (defcommand delete-char
()
82 "Delete the following N characters."
83 (buffer-delete (current-buffer) (pt) 1))
85 (defcommand delete-backward-char
()
86 "Delete the previous N characters."
87 (buffer-delete (current-buffer) (pt) -
1))
89 (defcommand self-insert-command
((arg)
91 "Insert the character you type.
92 Whichever character you type to run this command is inserted."
93 (dformat +debug-v
+ "currentb: ~a ~a~%" (current-buffer) *current-buffer
*)
95 (insert-move-point (current-buffer) (make-string arg
:initial-element
(key-char *current-event
*)))
97 (insert-move-point (current-buffer) (key-char *current-event
*)))))
101 (define-key *global-map
* "C-i" 'self-insert-command
)
103 (loop for i in
'(#\
0 #\
1 #\
2 #\
3 #\
4 #\
5 #\
6 #\
7 #\
8 #\
9
104 #\a #\b #\c
#\d
#\e
#\f #\g
#\h
#\i
#\j
105 #\k
#\l
#\m
#\n #\o
#\p
#\q
#\r #\s
#\t
106 #\u
#\v #\w
#\x
#\y
#\z
107 #\A
#\B
#\C
#\D
#\E
#\F
#\G
#\H
#\I
#\J
108 #\K
#\L
#\M
#\N
#\O
#\P
#\Q
#\R
#\S
#\T
109 #\U
#\V
#\W
#\X
#\Y
#\Z
110 #\Space
#\
! #\" #\
# #\$
#\%
#\
& #\' #\
(
111 #\
) #\
* #\
+ #\
, #\-
#\.
#\
/ #\
: #\
; #\<
112 #\
= #\
> #\? #\
@ #\
[ #\\ #\
] #\^
#\_
#\
`
114 do
(define-key *global-map
* (make-key :char i
) 'self-insert-command
))
116 (define-key *global-map
* "C-a" 'beginning-of-line
)
117 (define-key *global-map
* "C-b" 'backward-char
)
118 (define-key *global-map
* "C-d" 'delete-char
)
119 (define-key *global-map
* "C-e" 'end-of-line
)
120 (define-key *global-map
* "C-f" 'forward-char
)
121 (define-key *global-map
* "DEL" 'delete-backward-char
)