/[cmucl]/src/hemlock/command.lisp
ViewVC logotype

Contents of /src/hemlock/command.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.8 - (show annotations)
Mon Oct 31 04:50:12 1994 UTC (19 years, 5 months ago) by ram
Branch: MAIN
CVS Tags: sparc-tramp-assem-base, double-double-array-base, post-merge-intl-branch, release-19b-pre1, release-19b-pre2, merged-unicode-utf16-extfmt-2009-06-11, double-double-init-sparc-2, unicode-utf16-extfmt-2009-03-27, double-double-base, snapshot-2007-09, snapshot-2007-08, snapshot-2008-08, snapshot-2008-09, ppc_gencgc_snap_2006-01-06, sse2-packed-2008-11-12, snapshot-2008-05, snapshot-2008-06, snapshot-2008-07, snapshot-2007-05, snapshot-2008-01, snapshot-2008-02, snapshot-2008-03, intl-branch-working-2010-02-19-1000, snapshot-2006-11, snapshot-2006-10, double-double-init-sparc, snapshot-2006-12, unicode-string-buffer-impl-base, sse2-base, release-20b-pre1, release-20b-pre2, unicode-string-buffer-base, RELEASE_18d, sse2-packed-base, sparc-tramp-assem-2010-07-19, amd64-dd-start, snapshot-2003-10, snapshot-2004-10, release-18e-base, release-19f-pre1, snapshot-2008-12, snapshot-2008-11, intl-2-branch-base, snapshot-2004-08, snapshot-2004-09, remove_negative_zero_not_zero, snapshot-2007-01, snapshot-2007-02, snapshot-2004-05, snapshot-2004-06, snapshot-2004-07, release-19e, release-19d, GIT-CONVERSION, double-double-init-ppc, release-19c, dynamic-extent-base, unicode-utf16-sync-2008-12, LINKAGE_TABLE, release-19c-base, cross-sol-x86-merged, label-2009-03-16, release-19f-base, PRE_LINKAGE_TABLE, merge-sse2-packed, mod-arith-base, sparc_gencgc_merge, merge-with-19f, snapshot-2004-12, snapshot-2004-11, intl-branch-working-2010-02-11-1000, RELEASE_18a, RELEASE_18b, RELEASE_18c, unicode-snapshot-2009-05, unicode-snapshot-2009-06, amd64-merge-start, ppc_gencgc_snap_2005-12-17, double-double-init-%make-sparc, unicode-utf16-sync-2008-07, release-18e-pre2, unicode-utf16-sync-2008-09, unicode-utf16-extfmts-sync-2008-12, prm-before-macosx-merge-tag, cold-pcl-base, RELEASE_20b, snapshot-2008-04, snapshot-2003-11, snapshot-2005-07, unicode-utf16-sync-label-2009-03-16, RELEASE_19f, snapshot-2007-03, release-20a-base, cross-sol-x86-base, unicode-utf16-char-support-2009-03-26, unicode-utf16-char-support-2009-03-25, release-19a-base, unicode-utf16-extfmts-pre-sync-2008-11, snapshot-2008-10, sparc_gencgc, snapshot-2007-04, snapshot-2010-12, snapshot-2010-11, unicode-utf16-sync-2008-11, snapshot-2007-07, snapshot-2011-09, snapshot-2011-06, snapshot-2011-07, snapshot-2011-04, snapshot-2007-06, snapshot-2011-02, snapshot-2011-03, snapshot-2011-01, snapshot-2003-12, release-19a-pre1, release-19a-pre3, release-19a-pre2, pre-merge-intl-branch, release-19a, UNICODE-BASE, double-double-array-checkpoint, double-double-reader-checkpoint-1, release-19d-base, release-19e-pre1, double-double-irrat-end, release-19e-pre2, snapshot-2010-05, snapshot-2010-04, snapshot-2010-07, snapshot-2010-06, snapshot-2010-01, snapshot-2010-03, snapshot-2010-02, release-19d-pre2, release-19d-pre1, snapshot-2010-08, release-18e, double-double-init-checkpoint-1, double-double-reader-base, label-2009-03-25, snapshot-2005-03, release-19b-base, cross-sol-x86-2010-12-20, double-double-init-x86, sse2-checkpoint-2008-10-01, intl-branch-2010-03-18-1300, snapshot-2005-11, double-double-sparc-checkpoint-1, snapshot-2004-04, sse2-merge-with-2008-11, sse2-merge-with-2008-10, snapshot-2005-10, RELEASE_20a, snapshot-2005-12, release-20a-pre1, snapshot-2005-01, snapshot-2009-11, snapshot-2009-12, unicode-utf16-extfmt-2009-06-11, portable-clx-import-2009-06-16, unicode-utf16-string-support, release-19c-pre1, cross-sparc-branch-base, release-19e-base, intl-branch-base, double-double-irrat-start, snapshot-2005-06, snapshot-2005-05, snapshot-2005-04, ppc_gencgc_snap_2005-05-14, snapshot-2005-02, unicode-utf16-base, portable-clx-base, snapshot-2005-09, snapshot-2005-08, lisp-executable-base, snapshot-2009-08, snapshot-2007-12, snapshot-2007-10, snapshot-2007-11, snapshot-2009-02, snapshot-2009-01, snapshot-2009-07, snapshot-2009-05, snapshot-2009-04, snapshot-2006-02, snapshot-2006-03, release-18e-pre1, snapshot-2006-01, snapshot-2006-06, snapshot-2006-07, snapshot-2006-04, snapshot-2006-05, pre-telent-clx, snapshot-2006-08, snapshot-2006-09, HEAD
Branch point for: release-19b-branch, double-double-reader-branch, double-double-array-branch, mod-arith-branch, RELEASE-19F-BRANCH, portable-clx-branch, sparc_gencgc_branch, cross-sparc-branch, RELEASE-20B-BRANCH, RELENG_18, unicode-string-buffer-branch, sparc-tramp-assem-branch, dynamic-extent, UNICODE-BRANCH, release-19d-branch, ppc_gencgc_branch, sse2-packed-branch, lisp-executable, RELEASE-20A-BRANCH, amd64-dd-branch, double-double-branch, unicode-string-buffer-impl-branch, intl-branch, release-18e-branch, cold-pcl, unicode-utf16-branch, cross-sol-x86-branch, release-19e-branch, sse2-branch, release-19a-branch, release-19c-branch, intl-2-branch, unicode-utf16-extfmt-branch
Changes since 1.7: +1 -3 lines
Fix headed boilerplate.
1 ;;; -*- Log: hemlock.log; Package: Hemlock -*-
2 ;;;
3 ;;; **********************************************************************
4 ;;; This code was written as part of the CMU Common Lisp project at
5 ;;; Carnegie Mellon University, and has been placed in the public domain.
6 ;;;
7 (ext:file-comment
8 "$Header: /tiger/var/lib/cvsroots/cmucl/src/hemlock/command.lisp,v 1.8 1994/10/31 04:50:12 ram Rel $")
9 ;;;
10 ;;; **********************************************************************
11 ;;;
12 ;;; This file contains the definitions for the basic Hemlock commands.
13 ;;;
14
15 (in-package "HEMLOCK")
16
17
18 ;;; Make a mark for buffers as they're consed:
19
20 (defun hcmd-new-buffer-hook-fun (buff)
21 (let ((ring (make-ring 10 #'delete-mark)))
22 (defhvar "Buffer Mark Ring"
23 "This variable holds this buffer's mark ring."
24 :buffer buff
25 :value ring)
26 (ring-push (copy-mark (buffer-point buff) :right-inserting) ring)))
27
28 (add-hook make-buffer-hook #'hcmd-new-buffer-hook-fun)
29 (dolist (buff *buffer-list*) (hcmd-new-buffer-hook-fun buff))
30
31 (defcommand "Exit Hemlock" (p)
32 "Exit hemlock returning to the Lisp top-level read-eval-print loop."
33 "Exit hemlock returning to the Lisp top-level read-eval-print loop."
34 (declare (ignore p))
35 (exit-hemlock))
36
37 (defcommand "Pause Hemlock" (p)
38 "Pause the Hemlock/Lisp process returning to the process that invoked the
39 Lisp."
40 "Pause the Hemlock/Lisp process returning to the process that invoked the
41 Lisp."
42 (declare (ignore p))
43 (pause-hemlock))
44
45
46
47 ;;;; Simple character manipulation:
48
49 (defcommand "Self Insert" (p)
50 "Insert the last character typed.
51 With prefix argument insert the character that many times."
52 "Implements ``Self Insert'', calling this function is not meaningful."
53 (let ((char (ext:key-event-char *last-key-event-typed*)))
54 (unless char (editor-error "Can't insert that character."))
55 (if (and p (> p 1))
56 (insert-string
57 (current-point)
58 (make-string p :initial-element char))
59 (insert-character (current-point) char))))
60
61 (defcommand "Quoted Insert" (p)
62 "Read a character from the terminal and insert it.
63 With prefix argument, insert the character that many times."
64 "Reads a key-event from *editor-input* and inserts it at the point."
65 (let ((char (ext:key-event-char (get-key-event *editor-input* t)))
66 (point (current-point)))
67 (unless char (editor-error "Can't insert that character."))
68 (if (and p (> p 1))
69 (insert-string point (make-string p :initial-element char))
70 (insert-character point char))))
71
72 (defcommand "Forward Character" (p)
73 "Move the point forward one character.
74 With prefix argument move that many characters, with negative argument
75 go backwards."
76 "Move the point of the current buffer forward p characters."
77 (let ((p (or p 1)))
78 (cond ((character-offset (current-point) p))
79 ((= p 1)
80 (editor-error "No next character."))
81 ((= p -1)
82 (editor-error "No previous character."))
83 (t
84 (if (plusp p)
85 (buffer-end (current-point))
86 (buffer-start (current-point)))
87 (editor-error "Not enough characters.")))))
88
89 (defcommand "Backward Character" (p)
90 "Move the point backward one character.
91 With prefix argument move that many characters backward."
92 "Move the point p characters backward."
93 (forward-character-command (if p (- p) -1)))
94
95 #|
96 (defcommand "Delete Next Character" (p)
97 "Deletes the character to the right of the point.
98 With prefix argument, delete that many characters to the right
99 (or left if prefix is negative)."
100 "Deletes p characters to the right of the point."
101 (unless (delete-characters (current-point) (or p 1))
102 (buffer-end (current-point))
103 (editor-error "No next character.")))
104
105 (defcommand "Delete Previous Character" (p)
106 "Deletes the character to the left of the point.
107 With prefix argument, delete that many characters to the left
108 (or right if prefix is negative)."
109 "Deletes p characters to the left of the point."
110 (unless (delete-characters (current-point) (if p (- p) -1))
111 (editor-error "No previous character.")))
112 |#
113
114 (defcommand "Delete Next Character" (p)
115 "Deletes the character to the right of the point.
116 With prefix argument, delete that many characters to the right
117 (or left if prefix is negative)."
118 "Deletes p characters to the right of the point."
119 (cond ((kill-characters (current-point) (or p 1)))
120 ((and p (minusp p))
121 (editor-error "Not enough previous characters."))
122 (t
123 (editor-error "Not enough next characters."))))
124
125 (defcommand "Delete Previous Character" (p)
126 "Deletes the character to the left of the point.
127 Will push characters from successive deletes on to the kill ring."
128 "Deletes the character to the left of the point.
129 Will push characters from successive deletes on to the kill ring."
130 (delete-next-character-command (- (or p 1))))
131
132 (defcommand "Transpose Characters" (p)
133 "Exchanges the characters on either side of the point and moves forward
134 With prefix argument, does this that many times. A negative prefix
135 argument causes the point to be moved backwards instead of forwards."
136 "Exchanges the characters on either side of the point and moves forward."
137 (let ((arg (or p 1))
138 (point (current-point)))
139 (dotimes (i (abs arg))
140 (when (or (minusp arg) (end-line-p point)) (mark-before point))
141 (let ((prev (previous-character point))
142 (next (next-character point)))
143 (cond ((not prev) (editor-error "No previous character."))
144 ((not next) (editor-error "No next character."))
145 (t
146 (setf (previous-character point) next)
147 (setf (next-character point) prev))))
148 (when (plusp arg) (mark-after point)))))
149
150 ;;;; Word hacking commands:
151
152 ;;; WORD-OFFSET
153 ;;;
154 ;;; Move a mark forward/backward some words.
155 ;;;
156 (defun word-offset (mark offset)
157 "Move Mark by Offset words."
158 (if (minusp offset)
159 (do ((cnt offset (1+ cnt)))
160 ((zerop cnt) mark)
161 (cond
162 ((null (reverse-find-attribute mark :word-delimiter #'zerop))
163 (return nil))
164 ((reverse-find-attribute mark :word-delimiter))
165 (t
166 (move-mark
167 mark (buffer-start-mark (line-buffer (mark-line mark)))))))
168 (do ((cnt offset (1- cnt)))
169 ((zerop cnt) mark)
170 (cond
171 ((null (find-attribute mark :word-delimiter #'zerop))
172 (return nil))
173 ((null (find-attribute mark :word-delimiter))
174 (return nil))))))
175
176 (defcommand "Forward Word" (p)
177 "Moves forward one word.
178 With prefix argument, moves the point forward over that many words."
179 "Moves the point forward p words."
180 (cond ((word-offset (current-point) (or p 1)))
181 ((and p (minusp p))
182 (buffer-start (current-point))
183 (editor-error "No previous word."))
184 (t
185 (buffer-end (current-point))
186 (editor-error "No next word."))))
187
188 (defcommand "Backward Word" (p)
189 "Moves forward backward word.
190 With prefix argument, moves the point back over that many words."
191 "Moves the point backward p words."
192 (forward-word-command (- (or p 1))))
193
194
195
196 ;;;; Moving around:
197
198 (defvar *target-column* 0)
199
200 (defun set-target-column (mark)
201 (if (eq (last-command-type) :line-motion)
202 *target-column*
203 (setq *target-column* (mark-column mark))))
204
205 (defcommand "Next Line" (p)
206 "Moves the point to the next line.
207 With prefix argument, moves the point that many lines down (or up if
208 the prefix is negative)."
209 "Moves the down p lines."
210 (let* ((point (current-point))
211 (target (set-target-column point)))
212 (unless (line-offset point (or p 1))
213 (cond ((not p)
214 (when (same-line-p point (buffer-end-mark (current-buffer)))
215 (line-end point))
216 (insert-character point #\newline))
217 ((minusp p)
218 (buffer-start point)
219 (editor-error "No previous line."))
220 (t
221 (buffer-end point)
222 (when p (editor-error "No next line.")))))
223 (unless (move-to-column point target) (line-end point))
224 (setf (last-command-type) :line-motion)))
225
226
227 (defcommand "Previous Line" (p)
228 "Moves the point to the previous line.
229 With prefix argument, moves the point that many lines up (or down if
230 the prefix is negative)."
231 "Moves the point up p lines."
232 (next-line-command (- (or p 1))))
233
234 (defcommand "Mark to End of Buffer" (p)
235 "Sets the current region from point to the end of the buffer."
236 "Sets the current region from point to the end of the buffer."
237 (declare (ignore p))
238 (push-buffer-mark (buffer-end (copy-mark (current-point))) t))
239
240 (defcommand "Mark to Beginning of Buffer" (p)
241 "Sets the current region from the beginning of the buffer to point."
242 "Sets the current region from the beginning of the buffer to point."
243 (declare (ignore p))
244 (push-buffer-mark (buffer-start (copy-mark (current-point))) t))
245
246 (defcommand "Beginning of Buffer" (p)
247 "Moves the point to the beginning of the current buffer."
248 "Moves the point to the beginning of the current buffer."
249 (declare (ignore p))
250 (let ((point (current-point)))
251 (push-buffer-mark (copy-mark point))
252 (buffer-start point)))
253
254 (defcommand "End of Buffer" (p)
255 "Moves the point to the end of the current buffer."
256 "Moves the point to the end of the current buffer."
257 (declare (ignore p))
258 (let ((point (current-point)))
259 (push-buffer-mark (copy-mark point))
260 (buffer-end point)))
261
262 (defcommand "Beginning of Line" (p)
263 "Moves the point to the beginning of the current line.
264 With prefix argument, moves the point to the beginning of the prefix'th
265 next line."
266 "Moves the point down p lines and then to the beginning of the line."
267 (let ((point (current-point)))
268 (unless (line-offset point (if p p 0)) (editor-error "No such line."))
269 (line-start point)))
270
271 (defcommand "End of Line" (p)
272 "Moves the point to the end of the current line.
273 With prefix argument, moves the point to the end of the prefix'th next line."
274 "Moves the point down p lines and then to the end of the line."
275 (let ((point (current-point)))
276 (unless (line-offset point (if p p 0)) (editor-error "No such line."))
277 (line-end point)))
278
279 (defhvar "Scroll Overlap"
280 "The \"Scroll Window\" commands leave this much overlap between screens."
281 :value 2)
282
283 (defhvar "Scroll Redraw Ratio"
284 "This is a ratio of \"inserted\" lines to the size of a window. When this
285 ratio is exceeded, insert/delete line terminal optimization is aborted, and
286 every altered line is simply redrawn as efficiently as possible. For example,
287 setting this to 1/4 will cause scrolling commands to redraw the entire window
288 instead of moving the bottom two lines of the window to the top (typically
289 3/4 of the window is being deleted upward and inserted downward, hence a
290 redraw); however, commands line \"New Line\" and \"Open Line\" will still
291 efficiently, insert a line moving the rest of the window's text downward."
292 :value nil)
293
294 (defcommand "Scroll Window Down" (p &optional (window (current-window)))
295 "Move down one screenfull.
296 With prefix argument scroll down that many lines."
297 "If P is NIL then scroll Window, which defaults to the current
298 window, down one screenfull. If P is supplied then scroll that
299 many lines."
300 (if p
301 (scroll-window window p)
302 (let ((height (window-height window))
303 (overlap (value scroll-overlap)))
304 (scroll-window window (if (<= height overlap)
305 height (- height overlap))))))
306
307 (defcommand "Scroll Window Up" (p &optional (window (current-window)))
308 "Move up one screenfull.
309 With prefix argument scroll up that many lines."
310 "If P is NIL then scroll Window, which defaults to the current
311 window, up one screenfull. If P is supplied then scroll that
312 many lines."
313 (if p
314 (scroll-window window (- p))
315 (let ((height (- (window-height window)))
316 (overlap (- (value scroll-overlap))))
317 (scroll-window window (if (>= height overlap)
318 height (- height overlap))))))
319
320 (defcommand "Scroll Next Window Down" (p)
321 "Do a \"Scroll Window Down\" on the next window."
322 "Do a \"Scroll Window Down\" on the next window."
323 (let ((win (next-window (current-window))))
324 (when (eq win (current-window)) (editor-error "Only one window."))
325 (scroll-window-down-command p win)))
326
327 (defcommand "Scroll Next Window Up" (p)
328 "Do a \"Scroll Window Up\" on the next window."
329 "Do a \"Scroll Window Up\" on the next window."
330 (let ((win (next-window (current-window))))
331 (when (eq win (current-window)) (editor-error "Only one window."))
332 (scroll-window-up-command p win)))
333
334 (defcommand "Top of Window" (p)
335 "Move the point to the top of the current window.
336 The point is left before the first character displayed in the window."
337 "Move the point to the top of the current window."
338 (declare (ignore p))
339 (move-mark (current-point) (window-display-start (current-window))))
340
341 (defcommand "Bottom of Window" (p)
342 "Move the point to the bottom of the current window.
343 The point is left at the start of the bottom line."
344 "Move the point to the bottom of the current window."
345 (declare (ignore p))
346 (line-start (current-point)
347 (mark-line (window-display-end (current-window)))))
348
349 ;;;; Kind of miscellaneous commands:
350
351 ;;; "Refresh Screen" may not be right with respect to wrapping lines in
352 ;;; the case where an argument is supplied due the use of
353 ;;; WINDOW-DISPLAY-START instead of SCROLL-WINDOW, but using the latter
354 ;;; messed with point and did other hard to predict stuff.
355 ;;;
356 (defcommand "Refresh Screen" (p)
357 "Refreshes everything in the window, centering current line.
358 Given an argument, scroll that many lines."
359 "Refreshes everything in the window, centering current line.
360 Given an argument, scroll that many lines."
361 (let ((window (current-window)))
362 (cond ((not p) (center-window window (current-point)))
363 ((zerop p) (line-to-top-of-window-command nil))
364 ((line-offset (window-display-start window)
365 (if (plusp p) (1- p) (1+ p))
366 0))
367 (t (editor-error "Not enough lines."))))
368 (unless p (redisplay-all)))
369
370
371 (defcommand "Track Buffer Point" (p)
372 "Make the current window track the buffer's point.
373 This means that each time Hemlock redisplays, it will make sure the buffer's
374 point is visible in the window. This is useful for windows into buffer's
375 that receive output from streams coming from other processes."
376 "Make the current window track the buffer's point."
377 (declare (ignore p))
378 (setf (window-display-recentering (current-window)) t))
379 ;;;
380 (defun reset-window-display-recentering (window &optional buffer)
381 (declare (ignore buffer))
382 (setf (window-display-recentering window) nil))
383 ;;;
384 (add-hook window-buffer-hook #'reset-window-display-recentering)
385
386
387 (defcommand "Extended Command" (p)
388 "Prompts for and executes an extended command."
389 "Prompts for and executes an extended command. The prefix argument is
390 passed to the command."
391 (let* ((name (prompt-for-keyword (list *command-names*)
392 :prompt "Extended Command: "
393 :help "Name of a Hemlock command"))
394 (function (command-function (getstring name *command-names*))))
395 (funcall function p)))
396
397 (defhvar "Universal Argument Default"
398 "Default value for \"Universal Argument\" command."
399 :value 4)
400
401 (defcommand "Universal Argument" (p)
402 "Sets prefix argument for next command.
403 Typing digits, regardless of any modifier keys, specifies the argument.
404 Optionally, you may first type a sign (- or +). While typing digits, if you
405 type C-U or C-u, the digits following the C-U form a number this command
406 multiplies by the digits preceding the C-U. The default value for this
407 command and any number following a C-U is the value of \"Universal Argument
408 Default\"."
409 "You probably don't want to use this as a function."
410 (declare (ignore p))
411 (clear-echo-area)
412 (write-string "C-U " *echo-area-stream*)
413 (let* ((key-event (get-key-event *editor-input*))
414 (char (ext:key-event-char key-event)))
415 (if char
416 (case char
417 (#\-
418 (write-char #\- *echo-area-stream*)
419 (universal-argument-loop (get-key-event *editor-input*) -1))
420 (#\+
421 (write-char #\+ *echo-area-stream*)
422 (universal-argument-loop (get-key-event *editor-input*) -1))
423 (t
424 (universal-argument-loop key-event 1)))
425 (universal-argument-loop key-event 1))))
426
427 (defcommand "Negative Argument" (p)
428 "This command is equivalent to invoking \"Universal Argument\" and typing
429 a minus sign (-). It waits for more digits and a command to which to give
430 the prefix argument."
431 "Don't call this as a function."
432 (when p (editor-error "Must type minus sign first."))
433 (clear-echo-area)
434 (write-string "C-U -" *echo-area-stream*)
435 (universal-argument-loop (get-key-event *editor-input*) -1))
436
437 (defcommand "Argument Digit" (p)
438 "This command is equivalent to invoking \"Universal Argument\" and typing
439 the digit used to invoke this command. It waits for more digits and a
440 command to which to give the prefix argument."
441 "Don't call this as a function."
442 (declare (ignore p))
443 (clear-echo-area)
444 (write-string "C-U " *echo-area-stream*)
445 (universal-argument-loop *last-key-event-typed* 1))
446
447 (defun universal-argument-loop (key-event sign &optional (multiplier 1))
448 (flet ((prefix (sign multiplier read-some-digit-p result)
449 ;; read-some-digit-p and (zerop result) are not
450 ;; equivalent if the user invokes this and types 0.
451 (* sign multiplier
452 (if read-some-digit-p
453 result
454 (value universal-argument-default)))))
455 (let* ((stripped-key-event (if key-event (ext:make-key-event key-event)))
456 (char (ext:key-event-char stripped-key-event))
457 (digit (if char (digit-char-p char)))
458 (result 0)
459 (read-some-digit-p nil))
460 (loop
461 (cond (digit
462 (setf read-some-digit-p t)
463 (write-char char *echo-area-stream*)
464 (setf result (+ digit (* 10 result)))
465 (setf key-event (get-key-event *editor-input*))
466 (setf stripped-key-event (if key-event
467 (ext:make-key-event key-event)))
468 (setf char (ext:key-event-char stripped-key-event))
469 (setf digit (if char (digit-char-p char))))
470 ((or (eq key-event #k"C-u") (eq key-event #k"C-U"))
471 (write-string " C-U " *echo-area-stream*)
472 (universal-argument-loop
473 (get-key-event *editor-input*) 1
474 (prefix sign multiplier read-some-digit-p result))
475 (return))
476 (t
477 (unget-key-event key-event *editor-input*)
478 (setf (prefix-argument)
479 (prefix sign multiplier read-some-digit-p result))
480 (return))))))
481 (setf (last-command-type) (last-command-type)))

  ViewVC Help
Powered by ViewVC 1.1.5