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

Contents of /src/hemlock/display.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.5 - (hide annotations)
Fri Mar 15 22:23:24 1991 UTC (23 years, 1 month ago) by ram
Branch: MAIN
Changes since 1.4: +65 -40 lines
Some changes to make things work better in the face of display aborting
and buffer modification during display output (due to servicing events
in LISTEN.)  The main change was making the redisplay functions return
a meaningful value: T means did something, call again.  NIL means
did nothing (except possibly cursor positioning), can go into an input
wait.  :EDITOR-INPUT means redisplay aborted due to pending input.
Also, changed the *SCREEN-IMAGE-TRASHED* logic to not clear the flag
if dumb redisplay is aborted.
1 ram 1.1 ;;; -*- Log: hemlock.log; Package: Hemlock-Internals -*-
2     ;;;
3     ;;; **********************************************************************
4 ram 1.2 ;;; 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 ram 1.5 "$Header: /tiger/var/lib/cvsroots/cmucl/src/hemlock/display.lisp,v 1.5 1991/03/15 22:23:24 ram Exp $")
11 ram 1.2 ;;;
12 ram 1.1 ;;; **********************************************************************
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 ram 1.5 ;;; We establish the REDISPLAY-CATCHER, and return T if any of the forms
51     ;;; returns true, otherwise NIL. People throw :EDITOR-INPUT to indicate an
52     ;;; abort. A return of T in effect indicates that redisplay should be called
53     ;;; again to make sure that it has converged.
54     ;;;
55     ;;; When we go to position the cursor, it is possible that we will find that it
56     ;;; doesn't lie within the window after all (due to buffer modifications during
57     ;;; output for previous redisplays.) If so, we just make sure to return T.
58     ;;;
59 ram 1.1 (defmacro redisplay-loop ((win-var) general-form current-window-form
60     &optional (afterp t))
61 ram 1.5 (let ((device (gensym)) (point (gensym)) (hunk (gensym))
62     (n-res (gensym)))
63     `(let ((,n-res nil))
64     (catch 'redisplay-catcher
65     (when (listen-editor-input *real-editor-input*)
66     (throw 'redisplay-catcher :editor-input))
67     (when ,current-window-form (setq ,n-res t))
68     (dolist (,win-var *window-list*)
69     (unless (eq ,win-var *current-window*)
70     (when (listen-editor-input *real-editor-input*)
71     (throw 'redisplay-catcher :editor-input))
72     (when ,general-form (setq ,n-res t))))
73     (let* ((,hunk (window-hunk *current-window*))
74     (,device (device-hunk-device ,hunk))
75     (,point (window-point *current-window*)))
76     (move-mark ,point (buffer-point (window-buffer *current-window*)))
77     (multiple-value-bind (x y)
78     (mark-to-cursorpos ,point *current-window*)
79     (if x
80     (funcall (device-put-cursor ,device) ,hunk x y)
81     (setq ,n-res t)))
82     (when (device-force-output ,device)
83     (funcall (device-force-output ,device)))
84     ,@(if afterp
85     `((when (device-after-redisplay ,device)
86     (funcall (device-after-redisplay ,device) ,device))))
87     ,n-res)))))
88 ram 1.1
89     ) ;eval-when
90    
91    
92     ;;; REDISPLAY -- Public
93     ;;;
94     ;;; This function updates the display of all windows which need it.
95     ;;; it assumes it's internal representation of the screen is accurate
96     ;;; and attempts to do the minimal amount of output to bring the screen
97     ;;; into correspondence. *screen-image-trashed* is only used by terminal
98     ;;; redisplay.
99     ;;;
100     (defun redisplay ()
101     "The main entry into redisplay; updates any windows that seem to need it."
102     (when *things-to-do-once*
103     (dolist (thing *things-to-do-once*) (apply (car thing) (cdr thing)))
104     (setq *things-to-do-once* nil))
105     (cond (*screen-image-trashed*
106 ram 1.5 (when (eq (redisplay-all) t)
107     (setq *screen-image-trashed* nil)
108     t))
109 ram 1.1 (t
110 ram 1.4 (redisplay-loop (w)
111     (redisplay-window w)
112     (redisplay-window-recentering *current-window*)))))
113 ram 1.1
114    
115     ;;; REDISPLAY-ALL -- Public
116     ;;;
117     ;;; Update the screen making no assumptions about what is on it.
118     ;;; useful if the screen (or redisplay) gets trashed. Since windows
119     ;;; potentially may be on different devices, we have to go through the
120 ram 1.5 ;;; list clearing all possible devices. Always returns T or :EDITOR-INPUT,
121     ;;; never NIL.
122 ram 1.1 ;;;
123     (defun redisplay-all ()
124     "An entry into redisplay; causes all windows to be fully refreshed."
125     (let ((cleared-devices nil))
126     (dolist (w *window-list*)
127     (let* ((hunk (window-hunk w))
128     (device (device-hunk-device hunk)))
129     (unless (member device cleared-devices :test #'eq)
130     (when (device-clear device)
131     (funcall (device-clear device) device))
132     ;;
133     ;; It's cleared whether we did clear it or there was no method.
134     (push device cleared-devices)))))
135     (redisplay-loop (w)
136     (redisplay-window-all w)
137     (progn
138     (setf (window-tick *current-window*) (tick))
139     (update-window-image *current-window*)
140     (maybe-recenter-window *current-window*)
141     (funcall (device-dumb-redisplay
142     (device-hunk-device (window-hunk *current-window*)))
143 ram 1.5 *current-window*)
144     t)))
145 ram 1.1
146    
147     ;;;; Internal redisplay entry points.
148    
149     (defun internal-redisplay ()
150     "The main internal entry into redisplay. This is just like REDISPLAY, but it
151     doesn't call the device's after-redisplay method."
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 ram 1.5 (when (eq (redisplay-all) t)
157     (setq *screen-image-trashed* nil)
158     t))
159 ram 1.1 (t
160 ram 1.4 (redisplay-loop (w)
161     (redisplay-window w)
162 ram 1.5 (redisplay-window-recentering *current-window*)))))
163 ram 1.1
164     ;;; REDISPLAY-WINDOWS-FROM-MARK is called from the hemlock-output-stream
165     ;;; methods to bring the screen up to date. It only redisplays windows which
166     ;;; are displaying the buffer concerned, and doesn't deal with making the
167     ;;; cursor track the point. *screen-image-trashed* is only used by terminal
168     ;;; redisplay. This must call the device after-redisplay method since stream
169     ;;; output may be done repeatedly without ever returning to the main Hemlock
170     ;;; read loop and event servicing.
171     ;;;
172     (defun redisplay-windows-from-mark (mark)
173     (when *things-to-do-once*
174     (dolist (thing *things-to-do-once*) (apply (car thing) (cdr thing)))
175     (setq *things-to-do-once* nil))
176 ram 1.3 (cond ((listen-editor-input *real-editor-input*))
177     (*screen-image-trashed*
178 ram 1.5 (when (eq (redisplay-all) t)
179     (setq *screen-image-trashed* nil)
180     t))
181 ram 1.1 (t
182     (catch 'redisplay-catcher
183     (let ((buffer (line-buffer (mark-line mark))))
184     (when buffer
185     (flet ((frob (win)
186     (let* ((device (device-hunk-device (window-hunk win)))
187     (force (device-force-output device))
188     (after (device-after-redisplay device)))
189     (when force (funcall force))
190     (when after (funcall after device)))))
191     (let ((windows (buffer-windows buffer)))
192     (when (member *current-window* windows :test #'eq)
193     (redisplay-window-recentering *current-window*)
194     (frob *current-window*))
195     (dolist (window windows)
196     (unless (eq window *current-window*)
197     (redisplay-window window)
198     (frob window)))))))))))
199    
200 ram 1.5 ;;; We return T if there are any changed lines, NIL otherwise.
201     ;;;
202 ram 1.1 (defun redisplay-window (window)
203     "Maybe updates the window's image and calls the device's smart redisplay
204     method. NOTE: the smart redisplay method may throw to
205     'hi::redisplay-catcher to abort redisplay."
206     (maybe-update-window-image window)
207 ram 1.5 (prog1
208     (not (eq (window-first-changed window) the-sentinel))
209     (funcall (device-smart-redisplay (device-hunk-device (window-hunk window)))
210     window)))
211 ram 1.1
212     (defun redisplay-window-all (window)
213     "Updates the window's image and calls the device's dumb redisplay method."
214     (setf (window-tick window) (tick))
215     (update-window-image window)
216     (funcall (device-dumb-redisplay (device-hunk-device (window-hunk window)))
217 ram 1.5 window)
218     t)
219 ram 1.1
220     (defun random-typeout-redisplay (window)
221     (catch 'redisplay-catcher
222     (maybe-update-window-image window)
223     (let* ((device (device-hunk-device (window-hunk window)))
224     (force (device-force-output device)))
225     (funcall (device-smart-redisplay device) window)
226     (when force (funcall force)))))
227    
228    
229     ;;;; Support for redisplay entry points.
230    
231     ;;; REDISPLAY-WINDOW-RECENTERING tries to be clever about updating the window
232     ;;; image unnecessarily, recenters the window if the window's buffer's point
233     ;;; moved off the window, and does a smart redisplay. We call the redisplay
234     ;;; method even if we didn't update the image or recenter because someone
235     ;;; else may have modified the window's image and already have updated it;
236     ;;; if nothing happened, then the smart method shouldn't do anything anyway.
237     ;;; NOTE: the smart redisplay method may throw to 'hi::redisplay-catcher to
238     ;;; abort redisplay.
239 ram 1.5 ;;;
240     ;;; We return T if there are any changed lines, NIL otherwise.
241 ram 1.1 ;;;
242     (defun redisplay-window-recentering (window)
243     (setup-for-recentering-redisplay window)
244     (invoke-hook ed::redisplay-hook window)
245     (setup-for-recentering-redisplay window)
246 ram 1.5 (prog1
247     (not (eq (window-first-changed window) the-sentinel))
248     (funcall (device-smart-redisplay (device-hunk-device (window-hunk window)))
249     window)))
250 ram 1.1
251     (defun setup-for-recentering-redisplay (window)
252     (let* ((display-start (window-display-start window))
253     (old-start (window-old-start window)))
254     ;;
255     ;; If the start is in the middle of a line and it wasn't before,
256     ;; then move the start there.
257     (when (and (same-line-p display-start old-start)
258     (not (start-line-p display-start))
259     (start-line-p old-start))
260     (line-start display-start))
261     (maybe-update-window-image window)
262     (maybe-recenter-window window)))
263    
264    
265     ;;; MAYBE-UPDATE-WINDOW-IMAGE only updates if the text has changed or the
266     ;;; display start.
267     ;;;
268     (defun maybe-update-window-image (window)
269     (when (or (> (buffer-modified-tick (window-buffer window))
270     (window-tick window))
271     (mark/= (window-display-start window)
272     (window-old-start window)))
273     (setf (window-tick window) (tick))
274     (update-window-image window)
275     t))

  ViewVC Help
Powered by ViewVC 1.1.5