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

Contents of /src/hemlock/display.lisp

Parent Directory Parent Directory | Revision Log Revision Log


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

  ViewVC Help
Powered by ViewVC 1.1.5