[climacs-cvs] CVS climacs

thenriksen thenriksen at common-lisp.net
Mon Dec 8 18:39:16 UTC 2008


Update of /project/climacs/cvsroot/climacs
In directory cl-net:/tmp/cvs-serv8205

Modified Files:
	typeout.lisp 
Log Message:
Fix redisplay issue in typeout panes.


--- /project/climacs/cvsroot/climacs/typeout.lisp	2008/02/06 09:23:01	1.8
+++ /project/climacs/cvsroot/climacs/typeout.lisp	2008/12/08 18:39:15	1.9
@@ -70,7 +70,14 @@
   (if (and (not (dirty view))
            (eq (output-record-parent (output-history view))
                (stream-output-history pane)))
-      (replay (stream-output-history pane) pane region)
+      (unless (region-equal region +nowhere+)
+        (let ((region (if (region-equal region +everywhere+)
+                          (sheet-region pane)
+                          (bounding-rectangle region))))
+          (with-bounding-rectangle* (x1 y1 x2 y2) region
+            (with-output-recording-options (pane :record nil)
+              (draw-rectangle* pane x1 y1 x2 y2 :filled t :ink +background-ink+)))
+          (replay (stream-output-history pane) pane region)))
       (call-next-method)))
 
 (defmethod display-drei-view-contents ((pane pane) (view typeout-view))
@@ -138,12 +145,12 @@
 of the created typeout view. Returns NIL."
   (let* ((typeout-view (ensure-typeout-view climacs label erase))
          (pane-with-typeout-view (or (find typeout-view (windows climacs)
-                                 :key #'view)
-                                (let ((pane (split-window t)))
-                                  (setf (view pane) typeout-view)
-                                  pane))))
+                                      :key #'view)
+                                     (let ((pane (split-window t)))
+                                       (setf (view pane) typeout-view)
+                                       pane))))
     (let ((new-record (with-output-to-output-record (pane-with-typeout-view)
-                        (with-output-recording-options (pane-with-typeout-view :record t :draw t)
+                        (with-output-recording-options (pane-with-typeout-view :record t :draw nil)
                           (when (last-cursor-position typeout-view)
                             (setf (stream-cursor-position pane-with-typeout-view)
                                   (values-list (last-cursor-position typeout-view))))
@@ -161,8 +168,8 @@
 view. If `erase' is true, clear the contents of any existing
 typeout view with that name."
   `(invoke-with-typeout-view *esa-instance* ,label ,erase
-                        #'(lambda (,stream)
-                            , at body)))
+                             #'(lambda (,stream)
+                                 , at body)))
 
 ;;; An implementation of the Gray streams protocol that uses a Climacs
 ;;; typeout view to draw the output.





More information about the Climacs-cvs mailing list