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

Contents of /src/hemlock/overwrite.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (hide annotations)
Fri Jul 13 15:14:05 1990 UTC (23 years, 9 months ago) by ram
Branch: MAIN
Changes since 1.1: +1 -1 lines
*** empty log message ***
1 ram 1.1 ;;; -*- Log: hemlock.log; Package: Hemlock -*-
2     ;;;
3     ;;; **********************************************************************
4     ;;; This code was written as part of the Spice Lisp project at
5     ;;; Carnegie-Mellon University, and has been placed in the public domain.
6     ;;; Spice Lisp is currently incomplete and under active development.
7     ;;; If you want to use this code or any part of Spice Lisp, please contact
8     ;;; Scott Fahlman (FAHLMAN@CMUC).
9     ;;; **********************************************************************
10     ;;;
11     ;;; Written by Bill Chiles.
12     ;;;
13    
14     (in-package 'hemlock)
15    
16    
17     (defmode "Overwrite")
18    
19    
20     (defcommand "Overwrite Mode" (p)
21     "Printing characters overwrite characters instead of pushing them to the right.
22     A positive argument turns Overwrite mode on, while zero or a negative
23     argument turns it off. With no arguments, it is toggled. Use C-Q to
24     insert characters normally."
25     "Determine if in Overwrite mode or not and set the mode accordingly."
26     (setf (buffer-minor-mode (current-buffer) "Overwrite")
27     (if p
28     (plusp p)
29     (not (buffer-minor-mode (current-buffer) "Overwrite")))))
30    
31    
32     (defcommand "Self Overwrite" (p)
33     "Replace the next character with the last character typed,
34     but insert at end of line. With prefix argument, do it that many times."
35     "Implements ``Self Overwrite'', calling this function is not meaningful."
36 ram 1.2 (let ((char (ext:key-event-char *last-key-event-typed*))
37 ram 1.1 (point (current-point)))
38     (unless char (editor-error "Can't insert that character."))
39     (do ((n (or p 1) (1- n)))
40     ((zerop n))
41     (case (next-character point)
42     (#\tab
43     (let ((col1 (mark-column point))
44     (col2 (mark-column (mark-after point))))
45     (if (= (- col2 col1) 1)
46     (setf (previous-character point) char)
47     (insert-character (mark-before point) char))))
48     ((#\newline nil) (insert-character point char))
49     (t (setf (next-character point) char)
50     (mark-after point))))))
51    
52    
53     (defcommand "Overwrite Delete Previous Character" (p)
54     "Replaces previous character with space, but tabs and newlines are deleted.
55     With prefix argument, do it that many times."
56     "Replaces previous character with space, but tabs and newlines are deleted."
57     (do ((point (current-point))
58     (n (or p 1) (1- n)))
59     ((zerop n))
60     (case (previous-character point)
61     ((#\newline #\tab) (delete-characters point -1))
62     ((nil) (editor-error))
63     (t (setf (previous-character point) #\space)
64     (mark-before point)))))

  ViewVC Help
Powered by ViewVC 1.1.5