/[cmucl]/src/hemlock/ed-integrity.lisp
ViewVC logotype

Contents of /src/hemlock/ed-integrity.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.4.2.1 - (show annotations)
Sat Mar 23 18:50:43 2002 UTC (12 years ago) by pw
Branch: RELENG_18
CVS Tags: RELEASE_18d
Changes since 1.4: +6 -6 lines
Mega commit to bring RELENG_18 branch in sync with HEAD in preparation
for release tagging 18d.
1 ;;; -*- Package: hemlock; Log: hemlock.log; Mode: Lisp -*-
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/ed-integrity.lisp,v 1.4.2.1 2002/03/23 18:50:43 pw Exp $")
9 ;;;
10 ;;; **********************************************************************
11 ;;;
12 ;;; This stuff can be used for testing tty redisplay. There are four
13 ;;; commands that, given "Setup Tty Buffer", that test
14 ;;; HI::COMPUTE-TTY-CHANGES: "Two Deletes", "Two Inserts", "One Delete One
15 ;;; Insert", and "One Insert One Delete. Each can be called with an
16 ;;; argument to generate a grand total of eight screen permutations.
17 ;;; "Setup Tty Buffer" numbers the lines of the main window 0 through 19
18 ;;; inclusively.
19 ;;;
20 ;;; "Setup for Debugging" and "Cleanup for Debugging" were helpful in
21 ;;; conjunction with some alternate versions of COMPUTE-TTY-CHANGES and
22 ;;; TTY-SMART-WINDOW-REDISPLAY. When something went wrong with on
23
24 (in-package "ED")
25
26
27 (declaim (special hemlock-internals::*debugging-tty-redisplay*
28 hemlock-internals::*testing-delete-queue*
29 hemlock-internals::*testing-insert-queue*
30 hemlock-internals::*testing-moved*
31 hemlock-internals::*testing-writes*))
32
33
34 (defcommand "Setup Tty Buffer" (p)
35 "Clear buffer and insert numbering strings 0..19."
36 "Clear buffer and insert numbering strings 0..19."
37 (declare (ignore p))
38 (delete-region (buffer-region (current-buffer)))
39 (let ((point (current-point)))
40 (dotimes (i 20)
41 (insert-string point (prin1-to-string i))
42 (insert-character point #\newline))
43 (buffer-start point)))
44
45 (defcommand "Setup for Debugging" (p)
46 "Set *debugging-tty-redisplay* to t, and some other stuff to nil."
47 "Set *debugging-tty-redisplay* to t, and some other stuff to nil."
48 (declare (ignore p))
49 (setf hi::*debugging-tty-redisplay* t)
50 (setf hi::*testing-delete-queue* nil)
51 (setf hi::*testing-insert-queue* nil)
52 (setf hi::*testing-moved* nil)
53 (setf hi::*testing-writes* nil))
54
55 (defcommand "Cleanup for Debugging" (p)
56 "Set *debugging-tty-redisplay* to nil."
57 "Set *debugging-tty-redisplay* to nil."
58 (declare (ignore p))
59 (setf hi::*debugging-tty-redisplay* nil))
60
61 ;;; Given "Setup Tty Buffer", deletes lines numbered 3, 4, 5, 10, 11, 12,
62 ;;; 13, and 14. With argument, 3..7 and 12..14.
63 ;;;
64 (defcommand "Two Deletes" (p)
65 "At line 3, delete 3 lines. At line 3+4, delete 5 lines.
66 With an argument, switch the number deleted."
67 "At line 3, delete 3 lines. At line 3+4, delete 5 lines.
68 With an argument, switch the number deleted."
69 (multiple-value-bind (dnum1 dnum2)
70 (if p (values 5 3) (values 3 5))
71 (let ((point (current-point)))
72 (move-mark point (window-display-start (current-window)))
73 (line-offset point 3)
74 (with-mark ((end point :left-inserting))
75 (line-offset end dnum1)
76 (delete-region (region point end))
77 (line-offset point 4)
78 (line-offset (move-mark end point) dnum2)
79 (delete-region (region point end))))))
80
81
82 ;;; Given "Setup Tty Buffer", opens two blank lines between 2 and 3, and
83 ;;; opens four blank lines between 6 and 7, leaving line numbered 13 at
84 ;;; the bottom. With argument, four lines between 2 and 3, two lines
85 ;;; between 6 and 7, and line 13 at the bottom of the window.
86 ;;;
87 (defcommand "Two Inserts" (p)
88 "At line 3, open 2 lines. At line 3+2+4, open 4 lines.
89 With an argument, switch the number opened."
90 "At line 3, open 2 lines. At line 3+2+4, open 4 lines.
91 With an argument, switch the number opened."
92 (multiple-value-bind (onum1 onum2)
93 (if p (values 4 2) (values 2 4))
94 (let ((point (current-point)))
95 (move-mark point (window-display-start (current-window)))
96 (line-offset point 3)
97 (dotimes (i onum1)
98 (insert-character point #\newline))
99 (line-offset point 4)
100 (dotimes (i onum2)
101 (insert-character point #\newline)))))
102
103
104 ;;; Given "Setup Tty Buffer", deletes lines numbered 3, 4, and 5, and
105 ;;; opens five lines between lines numbered 9 and 10, leaving line numbered
106 ;;; 17 on the bottom. With an argument, deletes lines numbered 3, 4, 5, 6,
107 ;;; and 7, and opens three lines between 11 and 12, creating two blank lines
108 ;;; at the end of the screen.
109 ;;;
110 (defcommand "One Delete One Insert" (p)
111 "At line 3, delete 3 lines. At line 3+4, open 5 lines.
112 With an argument, switch the number of lines affected."
113 "At line 3, delete 3 lines. At line 3+4, open 5 lines.
114 With an argument, switch the number of lines affected."
115 (multiple-value-bind (dnum onum)
116 (if p (values 5 3) (values 3 5))
117 (let ((point (current-point)))
118 (move-mark point (window-display-start (current-window)))
119 (line-offset point 3)
120 (with-mark ((end point :left-inserting))
121 (line-offset end dnum)
122 (delete-region (region point end))
123 (line-offset point 4)
124 (dotimes (i onum)
125 (insert-character point #\newline))))))
126
127 ;;; Given "Setup Tty Buffer", opens three blank lines between lines numbered
128 ;;; 2 and 3, and deletes lines numbered 7, 8, 9, 10, and 11, leaving two
129 ;;; blank lines at the bottom of the window. With an argument, opens five
130 ;;; blank lines between lines numbered 2 and 3, and deletes lines 7, 8, and
131 ;;; 9, leaving line 17 at the bottom of the window.
132 ;;;
133 (defcommand "One Insert One Delete" (p)
134 "At line 3, open 3 lines. At line 3+3+4, delete 5 lines.
135 With an argument, switch the number of lines affected."
136 "At line 3, open 3 lines. At line 3+3+4, delete 5 lines.
137 With an argument, switch the number of lines affected."
138 (multiple-value-bind (onum dnum)
139 (if p (values 5 3) (values 3 5))
140 (let ((point (current-point)))
141 (move-mark point (window-display-start (current-window)))
142 (line-offset point 3)
143 (dotimes (i onum)
144 (insert-character point #\newline))
145 (line-offset point 4)
146 (with-mark ((end point :left-inserting))
147 (line-offset end dnum)
148 (delete-region (region point end))))))
149
150
151 ;;; This could be thrown away, but I'll leave it here. When I was testing
152 ;;; the problem of generating EQ screen image lines due to faulty
153 ;;; COMPUTE-TTY-CHANGES, this was a convenient command to get the editor
154 ;;; back under control.
155 ;;;
156 (defcommand "Fix Screen Image Lines" (p)
157 ""
158 ""
159 (declare (ignore p))
160 (let* ((device (hi::device-hunk-device (hi::window-hunk (current-window))))
161 (lines (hi::tty-device-lines device))
162 (columns (hi::tty-device-columns device))
163 (screen-image (hi::tty-device-screen-image device)))
164 (dotimes (i lines)
165 (setf (svref screen-image i) (hi::make-si-line columns)))))

  ViewVC Help
Powered by ViewVC 1.1.5