[Gd-chatter] r11528 - trunk/fundev/sources/deuce

[andreas at gwydiondylan.org]

Author: andreas
Date: Fri Dec  7 02:21:48 2007
New Revision: 11528

Modified:
   trunk/fundev/sources/deuce/module.dylan
   trunk/fundev/sources/deuce/streams.dylan
Log:
job: minor

Hack of <interval-stream> that auto-repaints the window.


Modified: trunk/fundev/sources/deuce/module.dylan
==============================================================================
--- trunk/fundev/sources/deuce/module.dylan	(original)
+++ trunk/fundev/sources/deuce/module.dylan	Fri Dec  7 02:21:48 2007
@@ -246,7 +246,8 @@
 	 add-node!, remove-node!,
 	 do-save-all-files;
 
-  create <interval-stream>;
+  create <interval-stream>, 
+         <repainting-interval-stream>;
 
   create <kill-history>,
          do-history-elements,

Modified: trunk/fundev/sources/deuce/streams.dylan
==============================================================================
--- trunk/fundev/sources/deuce/streams.dylan	(original)
+++ trunk/fundev/sources/deuce/streams.dylan	Fri Dec  7 02:21:48 2007
@@ -21,9 +21,16 @@
   sealed slot %current-position :: <basic-bp>;
 end class <interval-stream>;
 
+define sealed class <repainting-interval-stream> (<interval-stream>)
+  sealed constant slot %window :: <window>, required-init-keyword: window:;
+end;
+
 define sealed domain make (singleton(<interval-stream>));
 define sealed domain initialize (<interval-stream>);
 
+define sealed domain make (singleton(<repainting-interval-stream>));
+define sealed domain initialize (<repainting-interval-stream>);
+
 define sealed method make
     (class == <interval-stream>, #rest initargs,
      #key buffer, interval, direction, #all-keys)
@@ -44,6 +51,26 @@
   end
 end method make;
 
+define sealed method make
+    (class == <repainting-interval-stream>, #rest initargs,
+     #key buffer, interval, direction, window, #all-keys)
+ => (stream :: <interval-stream>)
+  ignore(direction);
+  let (start-bp, end-bp)
+    = values(interval-start-bp(buffer | interval), interval-end-bp(buffer | interval));
+  let buffer
+    = buffer
+      | select (interval by instance?)
+          <buffer>  => interval;
+          otherwise => bp-buffer(start-bp);
+        end;
+  with-keywords-removed (initargs = initargs, #[interval:])
+    apply(next-method, class,
+	  start-bp: start-bp, end-bp: end-bp,
+	  buffer: buffer, window: window, initargs)
+  end
+end method make;
+
 define sealed method initialize
     (stream :: <interval-stream>, #key interval, direction) => ()
   ignore(interval);
@@ -231,6 +258,14 @@
   insert-moving!(bp, char)
 end method write-element;
 
+define sealed method write-element
+    (stream :: <repainting-interval-stream>, char :: <object>) => ()
+  next-method();
+  // ---*** The centering argument is a hack, and doesn't belong here
+  queue-redisplay(stream.%window, $display-text, centering: 1);
+  redisplay-window(stream.%window);
+end;
+
 define sealed method write
     (stream :: <interval-stream>, string :: <byte-string>,
      #key start: _start :: <integer> = 0, end: _end :: <integer> = size(string)) => ()
@@ -239,6 +274,15 @@
   insert-moving!(bp, string, start: _start, end: _end)
 end method write;
 
+define sealed method write
+    (stream :: <repainting-interval-stream>, string :: <byte-string>,
+     #key start: _start :: <integer> = 0, end: _end :: <integer> = size(string)) => ()
+  next-method();
+  // ---*** The centering argument is a hack, and doesn't belong here
+  queue-redisplay(stream.%window, $display-text, centering: 1);
+  redisplay-window(stream.%window);
+end;
+
 
 /// Positionable stream protocol