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

Contents of /src/hemlock/display.lisp

Parent Directory Parent Directory | Revision Log Revision Log


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

  ViewVC Help
Powered by ViewVC 1.1.5