diff --git a/hemlock/display.lisp b/hemlock/display.lisp index ba1c2fd9725a2bbed862320cc82353f52674308a..efd336971f4fb4815395c90956c3490259af2883 100644 --- a/hemlock/display.lisp +++ b/hemlock/display.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/display.lisp,v 1.6 1991/03/18 13:23:49 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/display.lisp,v 1.7 1991/05/27 12:03:35 chiles Exp $") ;;; ;;; ********************************************************************** ;;; @@ -41,40 +41,64 @@ (eval-when (compile eval) -;;; REDISPLAY-LOOP binds win-var to each window that is not the -;;; *current-window*, and calls the executes the general-form after executing -;;; the current-window-form. Then we put the cursor in the appropriate place -;;; and force output. Routines such as REDISPLAY and REDISPLAY-ALL want to -;;; invoke the after-redisplay method to make sure we've handled any events -;;; generated from redisplaying. This is in case some user loops over one of -;;; these for a long time without going through Hemlock's input loop and event -;;; handling. Routines such as INTERNAL-REDISPLAY don't want to worry about -;;; this since they are called from the input/event-handling loop. +;;; REDISPLAY-LOOP -- Internal. ;;; -;;; We establish the REDISPLAY-CATCHER, and return T if any of the forms -;;; returns true, otherwise NIL. People throw :EDITOR-INPUT to indicate an -;;; abort. A return of T in effect indicates that redisplay should be called -;;; again to make sure that it has converged. +;;; This executes internal redisplay routines on all windows interleaved with +;;; checking for input, and if any input shows up we punt returning +;;; :editor-input. Special-fun is for windows that the redisplay interface +;;; wants to recenter to keep the window's buffer's point visible. General-fun +;;; is for other windows. ;;; -;;; When we go to position the cursor, it is possible that we will find that it -;;; doesn't lie within the window after all (due to buffer modifications during -;;; output for previous redisplays.) If so, we just make sure to return T. +;;; Whenever we invoke one of the internal routines, we keep track of the +;;; non-nil return values, so we can return t when we are done. Returning t +;;; means redisplay should run again to make sure it converged. To err on the +;;; safe side, if any window had any changed lines, then let's go through +;;; redisplay again; that is, return t. ;;; -(defmacro redisplay-loop ((win-var) general-form current-window-form - &optional (afterp t)) - (let ((device (gensym)) (point (gensym)) (hunk (gensym)) - (n-res (gensym))) +;;; After checking each window, we put the cursor in the appropriate place and +;;; force output. When we try to position the cursor, it may no longer lie +;;; within the window due to buffer modifications during redisplay. If it is +;;; out of the window, return t to indicate we need to finish redisplaying. +;;; +;;; Then we check for the after-redisplay method. Routines such as REDISPLAY +;;; and REDISPLAY-ALL want to invoke the after method to make sure we handle +;;; any events generated from redisplaying. There wouldn't be a problem with +;;; handling these events if we were going in and out of Hemlock's event +;;; handling, but some user may loop over one of these interface functions for +;;; a long time without going through Hemlock's input loop; when that happens, +;;; each call to redisplay may not result in a complete redisplay of the +;;; device. Routines such as INTERNAL-REDISPLAY don't want to worry about this +;;; since Hemlock calls them while going in and out of the input/event-handling +;;; loop. +;;; +;;; Around all of this, we establish the 'redisplay-catcher tag. Some device +;;; redisplay methods throw to this to abort redisplay in addition to this +;;; code. +;;; +(defmacro redisplay-loop (general-fun special-fun &optional (afterp t)) + (let* ((device (gensym)) (point (gensym)) (hunk (gensym)) (n-res (gensym)) + (win-var (gensym)) + (general-form (if (symbolp general-fun) + `(,general-fun ,win-var) + `(funcall ,general-fun ,win-var))) + (special-form (if (symbolp special-fun) + `(,special-fun ,win-var) + `(funcall ,special-fun ,win-var)))) `(let ((,n-res nil) (*in-redisplay* t)) (catch 'redisplay-catcher (when (listen-editor-input *real-editor-input*) (throw 'redisplay-catcher :editor-input)) - (when ,current-window-form (setq ,n-res t)) + (let ((,win-var *current-window*)) + (when ,special-form (setf ,n-res t))) (dolist (,win-var *window-list*) (unless (eq ,win-var *current-window*) (when (listen-editor-input *real-editor-input*) (throw 'redisplay-catcher :editor-input)) - (when ,general-form (setq ,n-res t)))) + (when (if (window-display-recentering ,win-var) + ,special-form + ,general-form) + (setf ,n-res t)))) (let* ((,hunk (window-hunk *current-window*)) (,device (device-hunk-device ,hunk)) (,point (window-point *current-window*))) @@ -83,7 +107,7 @@ (mark-to-cursorpos ,point *current-window*) (if x (funcall (device-put-cursor ,device) ,hunk x y) - (setq ,n-res t))) + (setf ,n-res t))) (when (device-force-output ,device) (funcall (device-force-output ,device))) ,@(if afterp @@ -94,37 +118,33 @@ ) ;eval-when -;;; REDISPLAY -- Public +;;; REDISPLAY -- Public. ;;; -;;; This function updates the display of all windows which need it. -;;; it assumes it's internal representation of the screen is accurate -;;; and attempts to do the minimal amount of output to bring the screen -;;; into correspondence. *screen-image-trashed* is only used by terminal -;;; redisplay. +;;; This function updates the display of all windows which need it. It assumes +;;; it's internal representation of the screen is accurate and attempts to do +;;; the minimal amount of output to bring the screen into correspondence. +;;; *screen-image-trashed* is only used by terminal redisplay. ;;; (defun redisplay () "The main entry into redisplay; updates any windows that seem to need it." (when *things-to-do-once* (dolist (thing *things-to-do-once*) (apply (car thing) (cdr thing))) - (setq *things-to-do-once* nil)) + (setf *things-to-do-once* nil)) (cond (*in-redisplay* t) (*screen-image-trashed* (when (eq (redisplay-all) t) - (setq *screen-image-trashed* nil) + (setf *screen-image-trashed* nil) t)) (t - (redisplay-loop (w) - (redisplay-window w) - (redisplay-window-recentering *current-window*))))) + (redisplay-loop redisplay-window redisplay-window-recentering)))) -;;; REDISPLAY-ALL -- Public +;;; REDISPLAY-ALL -- Public. ;;; -;;; Update the screen making no assumptions about what is on it. -;;; useful if the screen (or redisplay) gets trashed. Since windows -;;; potentially may be on different devices, we have to go through the -;;; list clearing all possible devices. Always returns T or :EDITOR-INPUT, -;;; never NIL. +;;; Update the screen making no assumptions about its correctness. This is +;;; useful if the screen gets trashed, or redisplay gets lost. Since windows +;;; may be on different devices, we have to go through the list clearing all +;;; possible devices. Always returns T or :EDITOR-INPUT, never NIL. ;;; (defun redisplay-all () "An entry into redisplay; causes all windows to be fully refreshed." @@ -138,16 +158,17 @@ ;; ;; It's cleared whether we did clear it or there was no method. (push device cleared-devices))))) - (redisplay-loop (w) - (redisplay-window-all w) - (progn - (setf (window-tick *current-window*) (tick)) - (update-window-image *current-window*) - (maybe-recenter-window *current-window*) - (funcall (device-dumb-redisplay - (device-hunk-device (window-hunk *current-window*))) - *current-window*) - t))) + (redisplay-loop + redisplay-window-all + #'(lambda (window) + (setf (window-tick window) (tick)) + (update-window-image window) + (maybe-recenter-window window) + (funcall (device-dumb-redisplay + (device-hunk-device (window-hunk window))) + window) + t))) + ;;;; Internal redisplay entry points. @@ -157,34 +178,33 @@ doesn't call the device's after-redisplay method." (when *things-to-do-once* (dolist (thing *things-to-do-once*) (apply (car thing) (cdr thing))) - (setq *things-to-do-once* nil)) + (setf *things-to-do-once* nil)) (cond (*in-redisplay* t) (*screen-image-trashed* (when (eq (redisplay-all) t) - (setq *screen-image-trashed* nil) + (setf *screen-image-trashed* nil) t)) (t - (redisplay-loop (w) - (redisplay-window w) - (redisplay-window-recentering *current-window*))))) + (redisplay-loop redisplay-window redisplay-window-recentering)))) -;;; REDISPLAY-WINDOWS-FROM-MARK is called from the hemlock-output-stream -;;; methods to bring the screen up to date. It only redisplays windows which -;;; are displaying the buffer concerned, and doesn't deal with making the -;;; cursor track the point. *screen-image-trashed* is only used by terminal -;;; redisplay. This must call the device after-redisplay method since stream -;;; output may be done repeatedly without ever returning to the main Hemlock -;;; read loop and event servicing. +;;; REDISPLAY-WINDOWS-FROM-MARK -- Internal Interface. +;;; +;;; hemlock-output-stream methods call this to update the screen. It only +;;; redisplays windows which are displaying the buffer concerned and doesn't +;;; deal with making the cursor track the point. *screen-image-trashed* is +;;; only used by terminal redisplay. This must call the device after-redisplay +;;; method since stream output may occur without ever returning to the +;;; Hemlock input/event-handling loop. ;;; (defun redisplay-windows-from-mark (mark) (when *things-to-do-once* (dolist (thing *things-to-do-once*) (apply (car thing) (cdr thing))) - (setq *things-to-do-once* nil)) + (setf *things-to-do-once* nil)) (cond ((or *in-redisplay* (not *in-the-editor*)) t) ((listen-editor-input *real-editor-input*) :editor-input) (*screen-image-trashed* (when (eq (redisplay-all) t) - (setq *screen-image-trashed* nil) + (setf *screen-image-trashed* nil) t)) (t (catch 'redisplay-catcher @@ -205,7 +225,9 @@ (redisplay-window window) (frob window))))))))))) -;;; We return T if there are any changed lines, NIL otherwise. +;;; REDISPLAY-WINDOW -- Internal. +;;; +;;; Return t if there are any changed lines, nil otherwise. ;;; (defun redisplay-window (window) "Maybe updates the window's image and calls the device's smart redisplay @@ -236,16 +258,17 @@ ;;;; Support for redisplay entry points. -;;; REDISPLAY-WINDOW-RECENTERING tries to be clever about updating the window -;;; image unnecessarily, recenters the window if the window's buffer's point -;;; moved off the window, and does a smart redisplay. We call the redisplay -;;; method even if we didn't update the image or recenter because someone -;;; else may have modified the window's image and already have updated it; -;;; if nothing happened, then the smart method shouldn't do anything anyway. -;;; NOTE: the smart redisplay method may throw to 'hi::redisplay-catcher to -;;; abort redisplay. +;;; REDISPLAY-WINDOW-RECENTERING -- Internal. +;;; +;;; This tries to be clever about updating the window image unnecessarily, +;;; recenters the window if the window's buffer's point moved off the window, +;;; and does a smart redisplay. We call the redisplay method even if we didn't +;;; update the image or recenter because someone else may have modified the +;;; window's image and already have updated it; if nothing happened, then the +;;; smart method shouldn't do anything anyway. NOTE: the smart redisplay +;;; method may throw to 'hi::redisplay-catcher to abort redisplay. ;;; -;;; We return T if there are any changed lines, NIL otherwise. +;;; This return t if there are any changed lines, nil otherwise. ;;; (defun redisplay-window-recentering (window) (setup-for-recentering-redisplay window)