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

Contents of /src/hemlock/display.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (hide annotations)
Wed May 9 13:03:37 1990 UTC (23 years, 11 months ago) by ram
Branch: MAIN
Initial revision
1 ram 1.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