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

Diff of /src/hemlock/display.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.6 by ram, Mon Mar 18 13:23:49 1991 UTC revision 1.7 by chiles, Mon May 27 12:03:35 1991 UTC
# Line 41  Line 41 
41    
42  (eval-when (compile eval)  (eval-when (compile eval)
43    
44  ;;; REDISPLAY-LOOP binds win-var to each window that is not the  ;;; REDISPLAY-LOOP -- Internal.
45  ;;; *current-window*, and calls the executes the general-form after executing  ;;;
46  ;;; the current-window-form.  Then we put the cursor in the appropriate place  ;;; This executes internal redisplay routines on all windows interleaved with
47  ;;; and force output.  Routines such as REDISPLAY and REDISPLAY-ALL want to  ;;; checking for input, and if any input shows up we punt returning
48  ;;; invoke the after-redisplay method to make sure we've handled any events  ;;; :editor-input.  Special-fun is for windows that the redisplay interface
49  ;;; generated from redisplaying.  This is in case some user loops over one of  ;;; wants to recenter to keep the window's buffer's point visible.  General-fun
50  ;;; these for a long time without going through Hemlock's input loop and event  ;;; is for other windows.
51  ;;; handling.  Routines such as INTERNAL-REDISPLAY don't want to worry about  ;;;
52  ;;; this since they are called from the input/event-handling loop.  ;;; Whenever we invoke one of the internal routines, we keep track of the
53  ;;;  ;;; non-nil return values, so we can return t when we are done.  Returning t
54  ;;; We establish the REDISPLAY-CATCHER, and return T if any of the forms  ;;; means redisplay should run again to make sure it converged.  To err on the
55  ;;; returns true, otherwise NIL.  People throw :EDITOR-INPUT to indicate an  ;;; safe side, if any window had any changed lines, then let's go through
56  ;;; abort.  A return of T in effect indicates that redisplay should be called  ;;; redisplay again; that is, return t.
57  ;;; again to make sure that it has converged.  ;;;
58  ;;;  ;;; After checking each window, we put the cursor in the appropriate place and
59  ;;; When we go to position the cursor, it is possible that we will find that it  ;;; force output.  When we try to position the cursor, it may no longer lie
60  ;;; doesn't lie within the window after all (due to buffer modifications during  ;;; within the window due to buffer modifications during redisplay.  If it is
61  ;;; output for previous redisplays.)  If so, we just make sure to return T.  ;;; out of the window, return t to indicate we need to finish redisplaying.
62  ;;;  ;;;
63  (defmacro redisplay-loop ((win-var) general-form current-window-form  ;;; Then we check for the after-redisplay method.  Routines such as REDISPLAY
64                            &optional (afterp t))  ;;; and REDISPLAY-ALL want to invoke the after method to make sure we handle
65    (let ((device (gensym)) (point (gensym)) (hunk (gensym))  ;;; any events generated from redisplaying.  There wouldn't be a problem with
66          (n-res (gensym)))  ;;; handling these events if we were going in and out of Hemlock's event
67    ;;; handling, but some user may loop over one of these interface functions for
68    ;;; a long time without going through Hemlock's input loop; when that happens,
69    ;;; each call to redisplay may not result in a complete redisplay of the
70    ;;; device.  Routines such as INTERNAL-REDISPLAY don't want to worry about this
71    ;;; since Hemlock calls them while going in and out of the input/event-handling
72    ;;; loop.
73    ;;;
74    ;;; Around all of this, we establish the 'redisplay-catcher tag.  Some device
75    ;;; redisplay methods throw to this to abort redisplay in addition to this
76    ;;; code.
77    ;;;
78    (defmacro redisplay-loop (general-fun special-fun &optional (afterp t))
79      (let* ((device (gensym)) (point (gensym)) (hunk (gensym)) (n-res (gensym))
80             (win-var (gensym))
81             (general-form (if (symbolp general-fun)
82                               `(,general-fun ,win-var)
83                               `(funcall ,general-fun ,win-var)))
84             (special-form (if (symbolp special-fun)
85                               `(,special-fun ,win-var)
86                               `(funcall ,special-fun ,win-var))))
87      `(let ((,n-res nil)      `(let ((,n-res nil)
88             (*in-redisplay* t))             (*in-redisplay* t))
89         (catch 'redisplay-catcher         (catch 'redisplay-catcher
90           (when (listen-editor-input *real-editor-input*)           (when (listen-editor-input *real-editor-input*)
91             (throw 'redisplay-catcher :editor-input))             (throw 'redisplay-catcher :editor-input))
92           (when ,current-window-form (setq ,n-res t))           (let ((,win-var *current-window*))
93               (when ,special-form (setf ,n-res t)))
94           (dolist (,win-var *window-list*)           (dolist (,win-var *window-list*)
95             (unless (eq ,win-var *current-window*)             (unless (eq ,win-var *current-window*)
96               (when (listen-editor-input *real-editor-input*)               (when (listen-editor-input *real-editor-input*)
97                 (throw 'redisplay-catcher :editor-input))                 (throw 'redisplay-catcher :editor-input))
98               (when ,general-form (setq ,n-res t))))               (when (if (window-display-recentering ,win-var)
99                           ,special-form
100                           ,general-form)
101                    (setf ,n-res t))))
102           (let* ((,hunk (window-hunk *current-window*))           (let* ((,hunk (window-hunk *current-window*))
103                  (,device (device-hunk-device ,hunk))                  (,device (device-hunk-device ,hunk))
104                  (,point (window-point *current-window*)))                  (,point (window-point *current-window*)))
# Line 83  Line 107 
107                                  (mark-to-cursorpos ,point *current-window*)                                  (mark-to-cursorpos ,point *current-window*)
108               (if x               (if x
109                   (funcall (device-put-cursor ,device) ,hunk x y)                   (funcall (device-put-cursor ,device) ,hunk x y)
110                   (setq ,n-res t)))                   (setf ,n-res t)))
111             (when (device-force-output ,device)             (when (device-force-output ,device)
112               (funcall (device-force-output ,device)))               (funcall (device-force-output ,device)))
113             ,@(if afterp             ,@(if afterp
# Line 94  Line 118 
118  ) ;eval-when  ) ;eval-when
119    
120    
121  ;;; REDISPLAY  --  Public  ;;; REDISPLAY -- Public.
122  ;;;  ;;;
123  ;;;    This function updates the display of all windows which need it.  ;;; This function updates the display of all windows which need it.  It assumes
124  ;;; it assumes it's internal representation of the screen is accurate  ;;; it's internal representation of the screen is accurate and attempts to do
125  ;;; and attempts to do the minimal amount of output to bring the screen  ;;; the minimal amount of output to bring the screen into correspondence.
126  ;;; into correspondence.  *screen-image-trashed* is only used by terminal  ;;; *screen-image-trashed* is only used by terminal redisplay.
 ;;; redisplay.  
127  ;;;  ;;;
128  (defun redisplay ()  (defun redisplay ()
129    "The main entry into redisplay; updates any windows that seem to need it."    "The main entry into redisplay; updates any windows that seem to need it."
130    (when *things-to-do-once*    (when *things-to-do-once*
131      (dolist (thing *things-to-do-once*) (apply (car thing) (cdr thing)))      (dolist (thing *things-to-do-once*) (apply (car thing) (cdr thing)))
132      (setq *things-to-do-once* nil))      (setf *things-to-do-once* nil))
133    (cond (*in-redisplay* t)    (cond (*in-redisplay* t)
134          (*screen-image-trashed*          (*screen-image-trashed*
135           (when (eq (redisplay-all) t)           (when (eq (redisplay-all) t)
136             (setq *screen-image-trashed* nil)             (setf *screen-image-trashed* nil)
137             t))             t))
138          (t          (t
139           (redisplay-loop (w)           (redisplay-loop redisplay-window redisplay-window-recentering))))
            (redisplay-window w)  
            (redisplay-window-recentering *current-window*)))))  
140    
141    
142  ;;; REDISPLAY-ALL  --  Public  ;;; REDISPLAY-ALL -- Public.
143  ;;;  ;;;
144  ;;;    Update the screen making no assumptions about what is on it.  ;;; Update the screen making no assumptions about its correctness.  This is
145  ;;; useful if the screen (or redisplay) gets trashed.  Since windows  ;;; useful if the screen gets trashed, or redisplay gets lost.  Since windows
146  ;;; potentially may be on different devices, we have to go through the  ;;; may be on different devices, we have to go through the list clearing all
147  ;;; list clearing all possible devices.  Always returns T or :EDITOR-INPUT,  ;;; possible devices.  Always returns T or :EDITOR-INPUT, never NIL.
 ;;; never NIL.  
148  ;;;  ;;;
149  (defun redisplay-all ()  (defun redisplay-all ()
150    "An entry into redisplay; causes all windows to be fully refreshed."    "An entry into redisplay; causes all windows to be fully refreshed."
# Line 138  Line 158 
158            ;;            ;;
159            ;; It's cleared whether we did clear it or there was no method.            ;; It's cleared whether we did clear it or there was no method.
160            (push device cleared-devices)))))            (push device cleared-devices)))))
161    (redisplay-loop (w)    (redisplay-loop
162      (redisplay-window-all w)     redisplay-window-all
163      (progn     #'(lambda (window)
164        (setf (window-tick *current-window*) (tick))         (setf (window-tick window) (tick))
165        (update-window-image *current-window*)         (update-window-image window)
166        (maybe-recenter-window *current-window*)         (maybe-recenter-window window)
167        (funcall (device-dumb-redisplay         (funcall (device-dumb-redisplay
168                  (device-hunk-device (window-hunk *current-window*)))                   (device-hunk-device (window-hunk window)))
169                 *current-window*)                  window)
170        t)))         t)))
171    
172    
173    
174  ;;;; Internal redisplay entry points.  ;;;; Internal redisplay entry points.
# Line 157  Line 178 
178     doesn't call the device's after-redisplay method."     doesn't call the device's after-redisplay method."
179    (when *things-to-do-once*    (when *things-to-do-once*
180      (dolist (thing *things-to-do-once*) (apply (car thing) (cdr thing)))      (dolist (thing *things-to-do-once*) (apply (car thing) (cdr thing)))
181      (setq *things-to-do-once* nil))      (setf *things-to-do-once* nil))
182    (cond (*in-redisplay* t)    (cond (*in-redisplay* t)
183          (*screen-image-trashed*          (*screen-image-trashed*
184           (when (eq (redisplay-all) t)           (when (eq (redisplay-all) t)
185             (setq *screen-image-trashed* nil)             (setf *screen-image-trashed* nil)
186             t))             t))
187          (t          (t
188           (redisplay-loop (w)           (redisplay-loop redisplay-window redisplay-window-recentering))))
189             (redisplay-window w)  
190             (redisplay-window-recentering *current-window*)))))  ;;; REDISPLAY-WINDOWS-FROM-MARK -- Internal Interface.
191    ;;;
192  ;;; REDISPLAY-WINDOWS-FROM-MARK is called from the hemlock-output-stream  ;;; hemlock-output-stream methods call this to update the screen.  It only
193  ;;; methods to bring the screen up to date.  It only redisplays windows which  ;;; redisplays windows which are displaying the buffer concerned and doesn't
194  ;;; are displaying the buffer concerned, and doesn't deal with making the  ;;; deal with making the cursor track the point.  *screen-image-trashed* is
195  ;;; cursor track the point.  *screen-image-trashed* is only used by terminal  ;;; only used by terminal redisplay.  This must call the device after-redisplay
196  ;;; redisplay.  This must call the device after-redisplay method since stream  ;;; method since stream output may occur without ever returning to the
197  ;;; output may be done repeatedly without ever returning to the main Hemlock  ;;; Hemlock input/event-handling loop.
 ;;; read loop and event servicing.  
198  ;;;  ;;;
199  (defun redisplay-windows-from-mark (mark)  (defun redisplay-windows-from-mark (mark)
200    (when *things-to-do-once*    (when *things-to-do-once*
201      (dolist (thing *things-to-do-once*) (apply (car thing) (cdr thing)))      (dolist (thing *things-to-do-once*) (apply (car thing) (cdr thing)))
202      (setq *things-to-do-once* nil))      (setf *things-to-do-once* nil))
203    (cond ((or *in-redisplay* (not *in-the-editor*)) t)    (cond ((or *in-redisplay* (not *in-the-editor*)) t)
204          ((listen-editor-input *real-editor-input*) :editor-input)          ((listen-editor-input *real-editor-input*) :editor-input)
205          (*screen-image-trashed*          (*screen-image-trashed*
206           (when (eq (redisplay-all) t)           (when (eq (redisplay-all) t)
207             (setq *screen-image-trashed* nil)             (setf *screen-image-trashed* nil)
208             t))             t))
209          (t          (t
210           (catch 'redisplay-catcher           (catch 'redisplay-catcher
# Line 205  Line 225 
225                         (redisplay-window window)                         (redisplay-window window)
226                         (frob window)))))))))))                         (frob window)))))))))))
227    
228  ;;; We return T if there are any changed lines, NIL otherwise.  ;;; REDISPLAY-WINDOW -- Internal.
229    ;;;
230    ;;; Return t if there are any changed lines, nil otherwise.
231  ;;;  ;;;
232  (defun redisplay-window (window)  (defun redisplay-window (window)
233    "Maybe updates the window's image and calls the device's smart redisplay    "Maybe updates the window's image and calls the device's smart redisplay
# Line 236  Line 258 
258    
259  ;;;; Support for redisplay entry points.  ;;;; Support for redisplay entry points.
260    
261  ;;; REDISPLAY-WINDOW-RECENTERING tries to be clever about updating the window  ;;; REDISPLAY-WINDOW-RECENTERING -- Internal.
262  ;;; image unnecessarily, recenters the window if the window's buffer's point  ;;;
263  ;;; moved off the window, and does a smart redisplay.  We call the redisplay  ;;; This tries to be clever about updating the window image unnecessarily,
264  ;;; method even if we didn't update the image or recenter because someone  ;;; recenters the window if the window's buffer's point moved off the window,
265  ;;; else may have modified the window's image and already have updated it;  ;;; and does a smart redisplay.  We call the redisplay method even if we didn't
266  ;;; if nothing happened, then the smart method shouldn't do anything anyway.  ;;; update the image or recenter because someone else may have modified the
267  ;;; NOTE: the smart redisplay method may throw to 'hi::redisplay-catcher to  ;;; window's image and already have updated it; if nothing happened, then the
268  ;;; abort redisplay.  ;;; smart method shouldn't do anything anyway.  NOTE: the smart redisplay
269    ;;; method may throw to 'hi::redisplay-catcher to abort redisplay.
270  ;;;  ;;;
271  ;;; We return T if there are any changed lines, NIL otherwise.  ;;; This return t if there are any changed lines, nil otherwise.
272  ;;;  ;;;
273  (defun redisplay-window-recentering (window)  (defun redisplay-window-recentering (window)
274    (setup-for-recentering-redisplay window)    (setup-for-recentering-redisplay window)

Legend:
Removed from v.1.6  
changed lines
  Added in v.1.7

  ViewVC Help
Powered by ViewVC 1.1.5