/[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.3 by ram, Wed Mar 13 23:22:04 1991 UTC revision 1.4 by ram, Fri Mar 15 13:37:56 1991 UTC
# Line 50  Line 50 
50  (defmacro redisplay-loop ((win-var) general-form current-window-form  (defmacro redisplay-loop ((win-var) general-form current-window-form
51                            &optional (afterp t))                            &optional (afterp t))
52    (let ((device (gensym)) (point (gensym)) (hunk (gensym)))    (let ((device (gensym)) (point (gensym)) (hunk (gensym)))
53      `(progn      `(catch 'redisplay-catcher
54           (when (listen-editor-input *real-editor-input*)
55             (throw 'redisplay-catcher nil))
56         ,current-window-form         ,current-window-form
57         (dolist (,win-var *window-list*)         (dolist (,win-var *window-list*)
58           (unless (eq ,win-var *current-window*) ,general-form))           (unless (eq ,win-var *current-window*)
59               (when (listen-editor-input *real-editor-input*)
60                 (throw 'redisplay-catcher nil))
61               ,general-form))
62         (let* ((,hunk (window-hunk *current-window*))         (let* ((,hunk (window-hunk *current-window*))
63                (,device (device-hunk-device ,hunk))                (,device (device-hunk-device ,hunk))
64                (,point (window-point *current-window*)))                (,point (window-point *current-window*)))
65           (move-mark ,point (buffer-point (window-buffer *current-window*)))           (move-mark ,point (buffer-point (window-buffer *current-window*)))
66           (multiple-value-bind (x y) (mark-to-cursorpos ,point *current-window*)           (multiple-value-bind (x y) (mark-to-cursorpos ,point *current-window*)
67             (unless x (error "??? Cursor not on the screen ???"))             (when x
68             (funcall (device-put-cursor ,device) ,hunk x y))               (funcall (device-put-cursor ,device) ,hunk x y)))
69           (when (device-force-output ,device)           (when (device-force-output ,device)
70             (funcall (device-force-output ,device)))             (funcall (device-force-output ,device)))
71           ,@(if afterp           ,@(if afterp
# Line 88  Line 93 
93           (setq *screen-image-trashed* nil)           (setq *screen-image-trashed* nil)
94           (redisplay-all))           (redisplay-all))
95          (t          (t
96           (catch 'redisplay-catcher           (redisplay-loop (w)
97             (redisplay-loop (w)             (redisplay-window w)
98               (redisplay-window w)             (redisplay-window-recentering *current-window*)))))
              (redisplay-window-recentering *current-window*))))))  
99    
100    
101  ;;; REDISPLAY-ALL  --  Public  ;;; REDISPLAY-ALL  --  Public
# Line 137  Line 141 
141           (setq *screen-image-trashed* nil)           (setq *screen-image-trashed* nil)
142           (redisplay-all))           (redisplay-all))
143          (t          (t
144           (catch 'redisplay-catcher           (redisplay-loop (w)
145             (redisplay-loop (w)             (redisplay-window w)
146               (redisplay-window w)             (redisplay-window-recentering *current-window*)
147               (redisplay-window-recentering *current-window*)             nil))))
              nil)))))  
148    
149  ;;; REDISPLAY-WINDOWS-FROM-MARK is called from the hemlock-output-stream  ;;; REDISPLAY-WINDOWS-FROM-MARK is called from the hemlock-output-stream
150  ;;; methods to bring the screen up to date.  It only redisplays windows which  ;;; methods to bring the screen up to date.  It only redisplays windows which

Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4

  ViewVC Help
Powered by ViewVC 1.1.5