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

Contents of /src/hemlock/display.lisp

Parent Directory Parent Directory | Revision Log Revision Log


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

  ViewVC Help
Powered by ViewVC 1.1.5