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

Contents of /src/hemlock/display.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.4 - (show annotations)
Fri Mar 15 13:37:56 1991 UTC (23 years, 1 month ago) by ram
Branch: MAIN
Changes since 1.3: +17 -14 lines
Changed REDISPLAY-LOOP to check for pending input before display of 
each window.  Also, eliminated the "Cursor not on the screen" check,
which can be violated when redisplay is aborted.
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.4 1991/03/15 13:37:56 ram 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 (proclaim '(special *window-list*))
37
38 (eval-when (compile eval)
39
40 ;;; REDISPLAY-LOOP binds win-var to each window that is not the
41 ;;; *current-window*, and calls the executes the general-form after executing
42 ;;; the current-window-form. Then we put the cursor in the appropriate place
43 ;;; and force output. Routines such as REDISPLAY and REDISPLAY-ALL want to
44 ;;; invoke the after-redisplay method to make sure we've handled any events
45 ;;; generated from redisplaying. This is in case some user loops over one of
46 ;;; these for a long time without going through Hemlock's input loop and event
47 ;;; handling. Routines such as INTERNAL-REDISPLAY don't want to worry about
48 ;;; this since they are called from the input/event-handling loop.
49 ;;;
50 (defmacro redisplay-loop ((win-var) general-form current-window-form
51 &optional (afterp t))
52 (let ((device (gensym)) (point (gensym)) (hunk (gensym)))
53 `(catch 'redisplay-catcher
54 (when (listen-editor-input *real-editor-input*)
55 (throw 'redisplay-catcher nil))
56 ,current-window-form
57 (dolist (,win-var *window-list*)
58 (unless (eq ,win-var *current-window*)
59 (when (listen-editor-input *real-editor-input*)
60 (throw 'redisplay-catcher nil))
61 ,general-form))
62 (let* ((,hunk (window-hunk *current-window*))
63 (,device (device-hunk-device ,hunk))
64 (,point (window-point *current-window*)))
65 (move-mark ,point (buffer-point (window-buffer *current-window*)))
66 (multiple-value-bind (x y) (mark-to-cursorpos ,point *current-window*)
67 (when x
68 (funcall (device-put-cursor ,device) ,hunk x y)))
69 (when (device-force-output ,device)
70 (funcall (device-force-output ,device)))
71 ,@(if afterp
72 `((when (device-after-redisplay ,device)
73 (funcall (device-after-redisplay ,device) ,device))))
74 t))))
75
76 ) ;eval-when
77
78
79 ;;; REDISPLAY -- Public
80 ;;;
81 ;;; This function updates the display of all windows which need it.
82 ;;; it assumes it's internal representation of the screen is accurate
83 ;;; and attempts to do the minimal amount of output to bring the screen
84 ;;; into correspondence. *screen-image-trashed* is only used by terminal
85 ;;; redisplay.
86 ;;;
87 (defun redisplay ()
88 "The main entry into redisplay; updates any windows that seem to need it."
89 (when *things-to-do-once*
90 (dolist (thing *things-to-do-once*) (apply (car thing) (cdr thing)))
91 (setq *things-to-do-once* nil))
92 (cond (*screen-image-trashed*
93 (setq *screen-image-trashed* nil)
94 (redisplay-all))
95 (t
96 (redisplay-loop (w)
97 (redisplay-window w)
98 (redisplay-window-recentering *current-window*)))))
99
100
101 ;;; REDISPLAY-ALL -- Public
102 ;;;
103 ;;; Update the screen making no assumptions about what is on it.
104 ;;; useful if the screen (or redisplay) gets trashed. Since windows
105 ;;; potentially may be on different devices, we have to go through the
106 ;;; list clearing all possible devices.
107 ;;;
108 (defun redisplay-all ()
109 "An entry into redisplay; causes all windows to be fully refreshed."
110 (let ((cleared-devices nil))
111 (dolist (w *window-list*)
112 (let* ((hunk (window-hunk w))
113 (device (device-hunk-device hunk)))
114 (unless (member device cleared-devices :test #'eq)
115 (when (device-clear device)
116 (funcall (device-clear device) device))
117 ;;
118 ;; It's cleared whether we did clear it or there was no method.
119 (push device cleared-devices)))))
120 (redisplay-loop (w)
121 (redisplay-window-all w)
122 (progn
123 (setf (window-tick *current-window*) (tick))
124 (update-window-image *current-window*)
125 (maybe-recenter-window *current-window*)
126 (funcall (device-dumb-redisplay
127 (device-hunk-device (window-hunk *current-window*)))
128 *current-window*))))
129
130
131
132 ;;;; Internal redisplay entry points.
133
134 (defun internal-redisplay ()
135 "The main internal entry into redisplay. This is just like REDISPLAY, but it
136 doesn't call the device's after-redisplay method."
137 (when *things-to-do-once*
138 (dolist (thing *things-to-do-once*) (apply (car thing) (cdr thing)))
139 (setq *things-to-do-once* nil))
140 (cond (*screen-image-trashed*
141 (setq *screen-image-trashed* nil)
142 (redisplay-all))
143 (t
144 (redisplay-loop (w)
145 (redisplay-window w)
146 (redisplay-window-recentering *current-window*)
147 nil))))
148
149 ;;; REDISPLAY-WINDOWS-FROM-MARK is called from the hemlock-output-stream
150 ;;; methods to bring the screen up to date. It only redisplays windows which
151 ;;; are displaying the buffer concerned, and doesn't deal with making the
152 ;;; cursor track the point. *screen-image-trashed* is only used by terminal
153 ;;; redisplay. This must call the device after-redisplay method since stream
154 ;;; output may be done repeatedly without ever returning to the main Hemlock
155 ;;; read loop and event servicing.
156 ;;;
157 (defun redisplay-windows-from-mark (mark)
158 (when *things-to-do-once*
159 (dolist (thing *things-to-do-once*) (apply (car thing) (cdr thing)))
160 (setq *things-to-do-once* nil))
161 (cond ((listen-editor-input *real-editor-input*))
162 (*screen-image-trashed*
163 (redisplay-all)
164 (setq *screen-image-trashed* nil))
165 (t
166 (catch 'redisplay-catcher
167 (let ((buffer (line-buffer (mark-line mark))))
168 (when buffer
169 (flet ((frob (win)
170 (let* ((device (device-hunk-device (window-hunk win)))
171 (force (device-force-output device))
172 (after (device-after-redisplay device)))
173 (when force (funcall force))
174 (when after (funcall after device)))))
175 (let ((windows (buffer-windows buffer)))
176 (when (member *current-window* windows :test #'eq)
177 (redisplay-window-recentering *current-window*)
178 (frob *current-window*))
179 (dolist (window windows)
180 (unless (eq window *current-window*)
181 (redisplay-window window)
182 (frob window)))))))))))
183
184 (defun redisplay-window (window)
185 "Maybe updates the window's image and calls the device's smart redisplay
186 method. NOTE: the smart redisplay method may throw to
187 'hi::redisplay-catcher to abort redisplay."
188 (maybe-update-window-image window)
189 (funcall (device-smart-redisplay (device-hunk-device (window-hunk window)))
190 window))
191
192 (defun redisplay-window-all (window)
193 "Updates the window's image and calls the device's dumb redisplay method."
194 (setf (window-tick window) (tick))
195 (update-window-image window)
196 (funcall (device-dumb-redisplay (device-hunk-device (window-hunk window)))
197 window))
198
199 (defun random-typeout-redisplay (window)
200 (catch 'redisplay-catcher
201 (maybe-update-window-image window)
202 (let* ((device (device-hunk-device (window-hunk window)))
203 (force (device-force-output device)))
204 (funcall (device-smart-redisplay device) window)
205 (when force (funcall force)))))
206
207
208 ;;;; Support for redisplay entry points.
209
210 ;;; REDISPLAY-WINDOW-RECENTERING tries to be clever about updating the window
211 ;;; image unnecessarily, recenters the window if the window's buffer's point
212 ;;; moved off the window, and does a smart redisplay. We call the redisplay
213 ;;; method even if we didn't update the image or recenter because someone
214 ;;; else may have modified the window's image and already have updated it;
215 ;;; if nothing happened, then the smart method shouldn't do anything anyway.
216 ;;; NOTE: the smart redisplay method may throw to 'hi::redisplay-catcher to
217 ;;; abort redisplay.
218 ;;;
219 (defun redisplay-window-recentering (window)
220 (setup-for-recentering-redisplay window)
221 (invoke-hook ed::redisplay-hook window)
222 (setup-for-recentering-redisplay window)
223 (funcall (device-smart-redisplay (device-hunk-device (window-hunk window)))
224 window))
225
226 (defun setup-for-recentering-redisplay (window)
227 (let* ((display-start (window-display-start window))
228 (old-start (window-old-start window)))
229 ;;
230 ;; If the start is in the middle of a line and it wasn't before,
231 ;; then move the start there.
232 (when (and (same-line-p display-start old-start)
233 (not (start-line-p display-start))
234 (start-line-p old-start))
235 (line-start display-start))
236 (maybe-update-window-image window)
237 (maybe-recenter-window window)))
238
239
240 ;;; MAYBE-UPDATE-WINDOW-IMAGE only updates if the text has changed or the
241 ;;; display start.
242 ;;;
243 (defun maybe-update-window-image (window)
244 (when (or (> (buffer-modified-tick (window-buffer window))
245 (window-tick window))
246 (mark/= (window-display-start window)
247 (window-old-start window)))
248 (setf (window-tick window) (tick))
249 (update-window-image window)
250 t))

  ViewVC Help
Powered by ViewVC 1.1.5