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

Contents of /src/hemlock/display.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.9 - (show annotations)
Mon Oct 31 04:50:12 1994 UTC (19 years, 5 months ago) by ram
Branch: MAIN
CVS Tags: RELEASE_18a, RELEASE_18b, RELEASE_18c
Branch point for: RELENG_18
Changes since 1.8: +1 -3 lines
Fix headed boilerplate.
1 ;;; -*- Log: hemlock.log; Package: Hemlock-Internals -*-
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/display.lisp,v 1.9 1994/10/31 04:50:12 ram Exp $")
9 ;;;
10 ;;; **********************************************************************
11 ;;;
12 ;;; Written by Bill Chiles.
13 ;;;
14 ;;; This is the device independent redisplay entry points for Hemlock.
15 ;;;
16
17 (in-package "HEMLOCK-INTERNALS")
18
19 (export '(redisplay redisplay-all))
20
21
22
23 ;;;; Main redisplay entry points.
24
25 (defvar *things-to-do-once* ()
26 "This is a list of lists of functions and args to be applied to. The
27 functions are called with args supplied at the top of the command loop.")
28
29 (defvar *screen-image-trashed* ()
30 "This variable is set to true if the screen has been trashed by some screen
31 manager operation, and thus should be totally refreshed. This is currently
32 only used by tty redisplay.")
33
34 ;;; True if we are in redisplay, and thus don't want to enter it recursively.
35 ;;;
36 (defvar *in-redisplay* nil)
37
38 (proclaim '(special *window-list*))
39
40 (eval-when (compile eval)
41
42 ;;; REDISPLAY-LOOP -- Internal.
43 ;;;
44 ;;; This executes internal redisplay routines on all windows interleaved with
45 ;;; checking for input, and if any input shows up we punt returning
46 ;;; :editor-input. Special-fun is for windows that the redisplay interface
47 ;;; wants to recenter to keep the window's buffer's point visible. General-fun
48 ;;; is for other windows.
49 ;;;
50 ;;; Whenever we invoke one of the internal routines, we keep track of the
51 ;;; non-nil return values, so we can return t when we are done. Returning t
52 ;;; means redisplay should run again to make sure it converged. To err on the
53 ;;; safe side, if any window had any changed lines, then let's go through
54 ;;; redisplay again; that is, return t.
55 ;;;
56 ;;; After checking each window, we put the cursor in the appropriate place and
57 ;;; force output. When we try to position the cursor, it may no longer lie
58 ;;; within the window due to buffer modifications during redisplay. If it is
59 ;;; out of the window, return t to indicate we need to finish redisplaying.
60 ;;;
61 ;;; Then we check for the after-redisplay method. Routines such as REDISPLAY
62 ;;; and REDISPLAY-ALL want to invoke the after method to make sure we handle
63 ;;; any events generated from redisplaying. There wouldn't be a problem with
64 ;;; handling these events if we were going in and out of Hemlock's event
65 ;;; handling, but some user may loop over one of these interface functions for
66 ;;; a long time without going through Hemlock's input loop; when that happens,
67 ;;; each call to redisplay may not result in a complete redisplay of the
68 ;;; device. Routines such as INTERNAL-REDISPLAY don't want to worry about this
69 ;;; since Hemlock calls them while going in and out of the input/event-handling
70 ;;; loop.
71 ;;;
72 ;;; Around all of this, we establish the 'redisplay-catcher tag. Some device
73 ;;; redisplay methods throw to this to abort redisplay in addition to this
74 ;;; code.
75 ;;;
76 (defmacro redisplay-loop (general-fun special-fun &optional (afterp t))
77 (let* ((device (gensym)) (point (gensym)) (hunk (gensym)) (n-res (gensym))
78 (win-var (gensym))
79 (general-form (if (symbolp general-fun)
80 `(,general-fun ,win-var)
81 `(funcall ,general-fun ,win-var)))
82 (special-form (if (symbolp special-fun)
83 `(,special-fun ,win-var)
84 `(funcall ,special-fun ,win-var))))
85 `(let ((,n-res nil)
86 (*in-redisplay* t))
87 (catch 'redisplay-catcher
88 (when (listen-editor-input *real-editor-input*)
89 (throw 'redisplay-catcher :editor-input))
90 (let ((,win-var *current-window*))
91 (when ,special-form (setf ,n-res t)))
92 (dolist (,win-var *window-list*)
93 (unless (eq ,win-var *current-window*)
94 (when (listen-editor-input *real-editor-input*)
95 (throw 'redisplay-catcher :editor-input))
96 (when (if (window-display-recentering ,win-var)
97 ,special-form
98 ,general-form)
99 (setf ,n-res t))))
100 (let* ((,hunk (window-hunk *current-window*))
101 (,device (device-hunk-device ,hunk))
102 (,point (window-point *current-window*)))
103 (move-mark ,point (buffer-point (window-buffer *current-window*)))
104 (multiple-value-bind (x y)
105 (mark-to-cursorpos ,point *current-window*)
106 (if x
107 (funcall (device-put-cursor ,device) ,hunk x y)
108 (setf ,n-res t)))
109 (when (device-force-output ,device)
110 (funcall (device-force-output ,device)))
111 ,@(if afterp
112 `((when (device-after-redisplay ,device)
113 (funcall (device-after-redisplay ,device) ,device)
114 ;; The after method may have queued input that the input
115 ;; loop won't see until the next input arrives, so check
116 ;; here to return the correct value as per the redisplay
117 ;; contract.
118 (when (listen-editor-input *real-editor-input*)
119 (setf ,n-res :editor-input)))))
120 ,n-res)))))
121
122 ) ;eval-when
123
124
125 ;;; REDISPLAY -- Public.
126 ;;;
127 ;;; This function updates the display of all windows which need it. It assumes
128 ;;; it's internal representation of the screen is accurate and attempts to do
129 ;;; the minimal amount of output to bring the screen into correspondence.
130 ;;; *screen-image-trashed* is only used by terminal redisplay.
131 ;;;
132 (defun redisplay ()
133 "The main entry into redisplay; updates any windows that seem to need it."
134 (when *things-to-do-once*
135 (dolist (thing *things-to-do-once*) (apply (car thing) (cdr thing)))
136 (setf *things-to-do-once* nil))
137 (cond (*in-redisplay* t)
138 (*screen-image-trashed*
139 (when (eq (redisplay-all) t)
140 (setf *screen-image-trashed* nil)
141 t))
142 (t
143 (redisplay-loop redisplay-window redisplay-window-recentering))))
144
145
146 ;;; REDISPLAY-ALL -- Public.
147 ;;;
148 ;;; Update the screen making no assumptions about its correctness. This is
149 ;;; useful if the screen gets trashed, or redisplay gets lost. Since windows
150 ;;; may be on different devices, we have to go through the list clearing all
151 ;;; possible devices. Always returns T or :EDITOR-INPUT, never NIL.
152 ;;;
153 (defun redisplay-all ()
154 "An entry into redisplay; causes all windows to be fully refreshed."
155 (let ((cleared-devices nil))
156 (dolist (w *window-list*)
157 (let* ((hunk (window-hunk w))
158 (device (device-hunk-device hunk)))
159 (unless (member device cleared-devices :test #'eq)
160 (when (device-clear device)
161 (funcall (device-clear device) device))
162 ;;
163 ;; It's cleared whether we did clear it or there was no method.
164 (push device cleared-devices)))))
165 (redisplay-loop
166 redisplay-window-all
167 #'(lambda (window)
168 (setf (window-tick window) (tick))
169 (update-window-image window)
170 (maybe-recenter-window window)
171 (funcall (device-dumb-redisplay
172 (device-hunk-device (window-hunk window)))
173 window)
174 t)))
175
176
177
178 ;;;; Internal redisplay entry points.
179
180 (defun internal-redisplay ()
181 "The main internal entry into redisplay. This is just like REDISPLAY, but it
182 doesn't call the device's after-redisplay method."
183 (when *things-to-do-once*
184 (dolist (thing *things-to-do-once*) (apply (car thing) (cdr thing)))
185 (setf *things-to-do-once* nil))
186 (cond (*in-redisplay* t)
187 (*screen-image-trashed*
188 (when (eq (redisplay-all) t)
189 (setf *screen-image-trashed* nil)
190 t))
191 (t
192 (redisplay-loop redisplay-window redisplay-window-recentering))))
193
194 ;;; REDISPLAY-WINDOWS-FROM-MARK -- Internal Interface.
195 ;;;
196 ;;; hemlock-output-stream methods call this to update the screen. It only
197 ;;; redisplays windows which are displaying the buffer concerned and doesn't
198 ;;; deal with making the cursor track the point. *screen-image-trashed* is
199 ;;; only used by terminal redisplay. This must call the device after-redisplay
200 ;;; method since stream output may occur without ever returning to the
201 ;;; Hemlock input/event-handling loop.
202 ;;;
203 (defun redisplay-windows-from-mark (mark)
204 (when *things-to-do-once*
205 (dolist (thing *things-to-do-once*) (apply (car thing) (cdr thing)))
206 (setf *things-to-do-once* nil))
207 (cond ((or *in-redisplay* (not *in-the-editor*)) t)
208 ((listen-editor-input *real-editor-input*) :editor-input)
209 (*screen-image-trashed*
210 (when (eq (redisplay-all) t)
211 (setf *screen-image-trashed* nil)
212 t))
213 (t
214 (catch 'redisplay-catcher
215 (let ((buffer (line-buffer (mark-line mark))))
216 (when buffer
217 (flet ((frob (win)
218 (let* ((device (device-hunk-device (window-hunk win)))
219 (force (device-force-output device))
220 (after (device-after-redisplay device)))
221 (when force (funcall force))
222 (when after (funcall after device)))))
223 (let ((windows (buffer-windows buffer)))
224 (when (member *current-window* windows :test #'eq)
225 (redisplay-window-recentering *current-window*)
226 (frob *current-window*))
227 (dolist (window windows)
228 (unless (eq window *current-window*)
229 (redisplay-window window)
230 (frob window)))))))))))
231
232 ;;; REDISPLAY-WINDOW -- Internal.
233 ;;;
234 ;;; Return t if there are any changed lines, nil otherwise.
235 ;;;
236 (defun redisplay-window (window)
237 "Maybe updates the window's image and calls the device's smart redisplay
238 method. NOTE: the smart redisplay method may throw to
239 'hi::redisplay-catcher to abort redisplay."
240 (maybe-update-window-image window)
241 (prog1
242 (not (eq (window-first-changed window) the-sentinel))
243 (funcall (device-smart-redisplay (device-hunk-device (window-hunk window)))
244 window)))
245
246 (defun redisplay-window-all (window)
247 "Updates the window's image and calls the device's dumb redisplay method."
248 (setf (window-tick window) (tick))
249 (update-window-image window)
250 (funcall (device-dumb-redisplay (device-hunk-device (window-hunk window)))
251 window)
252 t)
253
254 (defun random-typeout-redisplay (window)
255 (catch 'redisplay-catcher
256 (maybe-update-window-image window)
257 (let* ((device (device-hunk-device (window-hunk window)))
258 (force (device-force-output device)))
259 (funcall (device-smart-redisplay device) window)
260 (when force (funcall force)))))
261
262
263 ;;;; Support for redisplay entry points.
264
265 ;;; REDISPLAY-WINDOW-RECENTERING -- Internal.
266 ;;;
267 ;;; This tries to be clever about updating the window image unnecessarily,
268 ;;; recenters the window if the window's buffer's point moved off the window,
269 ;;; and does a smart redisplay. We call the redisplay method even if we didn't
270 ;;; update the image or recenter because someone else may have modified the
271 ;;; window's image and already have updated it; if nothing happened, then the
272 ;;; smart method shouldn't do anything anyway. NOTE: the smart redisplay
273 ;;; method may throw to 'hi::redisplay-catcher to abort redisplay.
274 ;;;
275 ;;; This return t if there are any changed lines, nil otherwise.
276 ;;;
277 (defun redisplay-window-recentering (window)
278 (setup-for-recentering-redisplay window)
279 (invoke-hook ed::redisplay-hook window)
280 (setup-for-recentering-redisplay window)
281 (prog1
282 (not (eq (window-first-changed window) the-sentinel))
283 (funcall (device-smart-redisplay (device-hunk-device (window-hunk window)))
284 window)))
285
286 (defun setup-for-recentering-redisplay (window)
287 (let* ((display-start (window-display-start window))
288 (old-start (window-old-start window)))
289 ;;
290 ;; If the start is in the middle of a line and it wasn't before,
291 ;; then move the start there.
292 (when (and (same-line-p display-start old-start)
293 (not (start-line-p display-start))
294 (start-line-p old-start))
295 (line-start display-start))
296 (maybe-update-window-image window)
297 (maybe-recenter-window window)))
298
299
300 ;;; MAYBE-UPDATE-WINDOW-IMAGE only updates if the text has changed or the
301 ;;; display start.
302 ;;;
303 (defun maybe-update-window-image (window)
304 (when (or (> (buffer-modified-tick (window-buffer window))
305 (window-tick window))
306 (mark/= (window-display-start window)
307 (window-old-start window)))
308 (setf (window-tick window) (tick))
309 (update-window-image window)
310 t))

  ViewVC Help
Powered by ViewVC 1.1.5