source: trunk/ccl/hemlock/src/display.lisp @ 56

Last change on this file since 56 was 56, checked in by gb, 16 years ago

Use asterisks in (more) special variable names.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 11.7 KB
Line 
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;;;
7#+CMU (ext:file-comment
8  "$Header$")
9;;;
10;;; **********************************************************************
11;;;
12;;; Written by Bill Chiles.
13;;;
14;;; This is the device independent redisplay entry points for Hemlock.
15;;;
16
17(in-package :hemlock-internals)
18
19
20;;;; Main redisplay entry points.
21
22(defvar *things-to-do-once* ()
23  "This is a list of lists of functions and args to be applied to.  The
24  functions are called with args supplied at the top of the command loop.")
25
26(defvar *screen-image-trashed* ()
27  "This variable is set to true if the screen has been trashed by some screen
28   manager operation, and thus should be totally refreshed.  This is currently
29   only used by tty redisplay.")
30
31;;; True if we are in redisplay, and thus don't want to enter it recursively.
32;;;
33(defvar *in-redisplay* nil)
34
35(declaim (special *window-list*))
36
37(eval-when (:compile-toplevel :execute)
38
39;;; REDISPLAY-LOOP -- Internal.
40;;;
41;;; This executes internal redisplay routines on all windows interleaved with
42;;; checking for input, and if any input shows up we punt returning
43;;; :editor-input.  Special-fun is for windows that the redisplay interface
44;;; wants to recenter to keep the window's buffer's point visible.  General-fun
45;;; is for other windows.
46;;;
47;;; Whenever we invoke one of the internal routines, we keep track of the
48;;; non-nil return values, so we can return t when we are done.  Returning t
49;;; means redisplay should run again to make sure it converged.  To err on the
50;;; safe side, if any window had any changed lines, then let's go through
51;;; redisplay again; that is, return t.
52;;;
53;;; After checking each window, we put the cursor in the appropriate place and
54;;; force output.  When we try to position the cursor, it may no longer lie
55;;; within the window due to buffer modifications during redisplay.  If it is
56;;; out of the window, return t to indicate we need to finish redisplaying.
57;;;
58;;; Then we check for the after-redisplay method.  Routines such as REDISPLAY
59;;; and REDISPLAY-ALL want to invoke the after method to make sure we handle
60;;; any events generated from redisplaying.  There wouldn't be a problem with
61;;; handling these events if we were going in and out of Hemlock's event
62;;; handling, but some user may loop over one of these interface functions for
63;;; a long time without going through Hemlock's input loop; when that happens,
64;;; each call to redisplay may not result in a complete redisplay of the
65;;; device.  Routines such as INTERNAL-REDISPLAY don't want to worry about this
66;;; since Hemlock calls them while going in and out of the input/event-handling
67;;; loop.
68;;;
69;;; Around all of this, we establish the 'redisplay-catcher tag.  Some device
70;;; redisplay methods throw to this to abort redisplay in addition to this
71;;; code.
72;;;
73(defmacro redisplay-loop (general-fun special-fun &optional (afterp t))
74  (let* ((device (gensym)) (point (gensym)) (hunk (gensym)) (n-res (gensym))
75         (win-var (gensym))
76         (general-form (if (symbolp general-fun)
77                           `(,general-fun ,win-var)
78                           `(funcall ,general-fun ,win-var)))
79         (special-form (if (symbolp special-fun)
80                           `(,special-fun ,win-var)
81                           `(funcall ,special-fun ,win-var))))
82    `(let ((,n-res nil)
83           (*in-redisplay* t))
84       (catch 'redisplay-catcher
85         (when (listen-editor-input *real-editor-input*)
86           (throw 'redisplay-catcher :editor-input))
87         (let ((,win-var *current-window*))
88           (when ,special-form (setf ,n-res t)))
89         (dolist (,win-var *window-list*)
90           (unless (eq ,win-var *current-window*)
91             (when (listen-editor-input *real-editor-input*)
92               (throw 'redisplay-catcher :editor-input))
93             (when (if (window-display-recentering ,win-var)
94                       ,special-form
95                       ,general-form)
96                (setf ,n-res t))))
97         (let* ((,hunk (window-hunk *current-window*))
98                (,device (device-hunk-device ,hunk))
99                (,point (window-point *current-window*)))
100           (move-mark ,point (buffer-point (window-buffer *current-window*)))
101           (multiple-value-bind (x y)
102                                (mark-to-cursorpos ,point *current-window*)
103             (if x
104                 (funcall (device-put-cursor ,device) ,hunk x y)
105                 (setf ,n-res t)))
106           (when (device-force-output ,device)
107             (funcall (device-force-output ,device)))
108           ,@(if afterp
109                 `((when (device-after-redisplay ,device)
110                     (funcall (device-after-redisplay ,device) ,device)
111                     ;; The after method may have queued input that the input
112                     ;; loop won't see until the next input arrives, so check
113                     ;; here to return the correct value as per the redisplay
114                     ;; contract.
115                     (when (listen-editor-input *real-editor-input*)
116                       (setf ,n-res :editor-input)))))
117           ,n-res)))))
118
119) ;eval-when
120
121
122;;; REDISPLAY -- Public.
123;;;
124;;; This function updates the display of all windows which need it.  It assumes
125;;; it's internal representation of the screen is accurate and attempts to do
126;;; the minimal amount of output to bring the screen into correspondence.
127;;; *screen-image-trashed* is only used by terminal redisplay.
128;;;
129(defun redisplay ()
130  "The main entry into redisplay; updates any windows that seem to need it."
131  (when *things-to-do-once*
132    (dolist (thing *things-to-do-once*) (apply (car thing) (cdr thing)))
133    (setf *things-to-do-once* nil))
134  (cond (*in-redisplay* t)
135        (*screen-image-trashed*
136         (when (eq (redisplay-all) t)
137           (setf *screen-image-trashed* nil)
138           t))
139        (t
140         (redisplay-loop redisplay-window redisplay-window-recentering))))
141
142
143;;; REDISPLAY-ALL -- Public.
144;;;
145;;; Update the screen making no assumptions about its correctness.  This is
146;;; useful if the screen gets trashed, or redisplay gets lost.  Since windows
147;;; may be on different devices, we have to go through the list clearing all
148;;; possible devices.  Always returns T or :EDITOR-INPUT, never NIL.
149;;;
150(defun redisplay-all ()
151  "An entry into redisplay; causes all windows to be fully refreshed."
152  (let ((cleared-devices nil))
153    (dolist (w *window-list*)
154      (let* ((hunk (window-hunk w))
155             (device (device-hunk-device hunk)))
156        (unless (member device cleared-devices :test #'eq)
157          (when (device-clear device)
158            (funcall (device-clear device) device))
159          ;;
160          ;; It's cleared whether we did clear it or there was no method.
161          (push device cleared-devices)))))
162  (redisplay-loop
163   redisplay-window-all
164   #'(lambda (window)
165       (setf (window-tick window) (tick))
166       (update-window-image window)
167       (maybe-recenter-window window)
168       (funcall (device-dumb-redisplay
169                 (device-hunk-device (window-hunk window)))
170                window)
171       t)))
172
173
174
175;;;; Internal redisplay entry points.
176
177(defun internal-redisplay ()
178  "The main internal entry into redisplay.  This is just like REDISPLAY, but it
179   doesn't call the device's after-redisplay method."
180  (when *things-to-do-once*
181    (dolist (thing *things-to-do-once*) (apply (car thing) (cdr thing)))
182    (setf *things-to-do-once* nil))
183  (cond (*in-redisplay* t)
184        (*screen-image-trashed*
185         (when (eq (redisplay-all) t)
186           (setf *screen-image-trashed* nil)
187           t))
188        (t
189         (redisplay-loop redisplay-window redisplay-window-recentering))))
190
191;;; REDISPLAY-WINDOWS-FROM-MARK -- Internal Interface.
192;;;
193;;; hemlock-output-stream methods call this to update the screen.  It only
194;;; redisplays windows which are displaying the buffer concerned and doesn't
195;;; deal with making the cursor track the point.  *screen-image-trashed* is
196;;; only used by terminal redisplay.  This must call the device after-redisplay
197;;; method since stream output may occur without ever returning to the
198;;; Hemlock input/event-handling loop.
199;;;
200(defun redisplay-windows-from-mark (mark)
201  (when *things-to-do-once*
202    (dolist (thing *things-to-do-once*) (apply (car thing) (cdr thing)))
203    (setf *things-to-do-once* nil))
204  (cond ((or *in-redisplay* (not *in-the-editor*)) t)
205        ((listen-editor-input *real-editor-input*) :editor-input)
206        (*screen-image-trashed*
207         (when (eq (redisplay-all) t)
208           (setf *screen-image-trashed* nil)
209           t))
210        (t
211         (catch 'redisplay-catcher
212           (let ((buffer (line-buffer (mark-line mark))))
213             (when buffer
214               (flet ((frob (win)
215                        (let* ((device (device-hunk-device (window-hunk win)))
216                               (force (device-force-output device))
217                               (after (device-after-redisplay device)))
218                          (when force (funcall force))
219                          (when after (funcall after device)))))
220                 (let ((windows (buffer-windows buffer)))
221                   (when (member *current-window* windows :test #'eq)
222                     (redisplay-window-recentering *current-window*)
223                     (frob *current-window*))
224                   (dolist (window windows)
225                     (unless (eq window *current-window*)
226                       (redisplay-window window)
227                       (frob window)))))))))))
228
229;;; REDISPLAY-WINDOW -- Internal.
230;;;
231;;; Return t if there are any changed lines, nil otherwise.
232;;;
233(defun redisplay-window (window)
234  "Maybe updates the window's image and calls the device's smart redisplay
235   method.  NOTE: the smart redisplay method may throw to
236   'hi::redisplay-catcher to abort redisplay."
237  (maybe-update-window-image window)
238  (prog1
239      (not (eq (window-first-changed window) *the-sentinel*))
240    (funcall (device-smart-redisplay (device-hunk-device (window-hunk window)))
241             window)))
242
243(defun redisplay-window-all (window)
244  "Updates the window's image and calls the device's dumb redisplay method."
245  (setf (window-tick window) (tick))
246  (update-window-image window)
247  (funcall (device-dumb-redisplay (device-hunk-device (window-hunk window)))
248           window)
249  t)
250
251(defun random-typeout-redisplay (window)
252  (catch 'redisplay-catcher
253    (maybe-update-window-image window)
254    (let* ((device (device-hunk-device (window-hunk window)))
255           (force (device-force-output device)))
256      (funcall (device-smart-redisplay device) window)
257      (when force (funcall force)))))
258
259
260;;;; Support for redisplay entry points.
261
262;;; REDISPLAY-WINDOW-RECENTERING -- Internal.
263;;;
264;;; This tries to be clever about updating the window image unnecessarily,
265;;; recenters the window if the window's buffer's point moved off the window,
266;;; and does a smart redisplay.  We call the redisplay method even if we didn't
267;;; update the image or recenter because someone else may have modified the
268;;; window's image and already have updated it; if nothing happened, then the
269;;; smart method shouldn't do anything anyway.  NOTE: the smart redisplay
270;;; method may throw to 'hi::redisplay-catcher to abort redisplay.
271;;;
272;;; This return t if there are any changed lines, nil otherwise.
273;;;
274(defun redisplay-window-recentering (window)
275  (setup-for-recentering-redisplay window)
276  (invoke-hook hemlock::redisplay-hook window)
277  (setup-for-recentering-redisplay window)
278  (prog1
279      (not (eq (window-first-changed window) *the-sentinel*))
280    (funcall (device-smart-redisplay (device-hunk-device (window-hunk window)))
281             window)))
282
283(defun setup-for-recentering-redisplay (window)
284  (let* ((display-start (window-display-start window))
285         (old-start (window-old-start window)))
286    ;;
287    ;; If the start is in the middle of a line and it wasn't before,
288    ;; then move the start there.
289    (when (and (same-line-p display-start old-start)
290               (not (start-line-p display-start))
291               (start-line-p old-start))
292      (line-start display-start))
293    (maybe-update-window-image window)
294    (maybe-recenter-window window)))
295
296
297;;; MAYBE-UPDATE-WINDOW-IMAGE only updates if the text has changed or the
298;;; display start.
299;;;
300(defun maybe-update-window-image (window)
301  (when (or (> (buffer-modified-tick (window-buffer window))
302               (window-tick window))
303            (mark/= (window-display-start window)
304                    (window-old-start window)))
305    (setf (window-tick window) (tick))
306    (update-window-image window)
307    t))
Note: See TracBrowser for help on using the repository browser.