From 761f929de9de21914de955312243310ba914a9e7 Mon Sep 17 00:00:00 2001
From: slava <slava@factorcode.org>
Date: Wed, 4 Oct 2006 21:33:02 +0000
Subject: [PATCH] pane-stream class to fix a delegation issue

---
 TODO.FACTOR.txt                  |  3 +-
 library/ui/gadgets/panes.factor  | 65 ++++++++++++++++++--------------
 library/ui/tools/listener.factor |  6 ++-
 3 files changed, 42 insertions(+), 32 deletions(-)

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index b6840985b1..46ea11c026 100644
--- a/TODO.FACTOR.txt
+++ b/TODO.FACTOR.txt
@@ -3,7 +3,6 @@
 - list mouse gestures
 - search gadget should use list
 - maybe simplify list into displaying list a sequence of strings
-- control delegating to a pane is wrong
 - the mouse button overload sucks, use popup menus instead
 - nested presentation mouse over is not right
 - ui quick start doc
@@ -11,6 +10,8 @@
 - slider needs to be modelized
 - some way of intercepting all gestures
 - better help result ranking
+- track add/remove weirdness
+- minibuffer should show a title
 
 + ui:
 
diff --git a/library/ui/gadgets/panes.factor b/library/ui/gadgets/panes.factor
index 7aaf64faaa..41fb59c652 100644
--- a/library/ui/gadgets/panes.factor
+++ b/library/ui/gadgets/panes.factor
@@ -41,9 +41,41 @@ C: pane ( -- pane )
     [ pick pick pane-current stream-format ]
     [ dup stream-terpri ] interleave 2drop ;
 
+! Panes are streams.
+
+: scroll-pane ( pane -- )
+    dup pane-scrolls? [ scroll>bottom ] [ drop ] if ;
+
+TUPLE: pane-stream pane ;
+
+: do-pane-stream ( pane-stream quot -- )
+    >r pane-stream-pane r> over slip scroll-pane ; inline
+
+M: pane-stream stream-terpri
+    [
+        dup pane-current dup unparent prepare-print
+        over pane-output add-incremental
+        prepare-line
+    ] do-pane-stream ;
+
+M: pane-stream stream-write1
+    [ pane-current stream-write1 ] do-pane-stream ;
+
+M: pane-stream stream-write
+    [ swap "\n" split pane-write ] do-pane-stream ;
+
+M: pane-stream stream-format
+    [ rot "\n" split pane-format ] do-pane-stream ;
+
+M: pane-stream stream-close drop ;
+
+M: pane stream-flush drop ;
+
+M: pane-stream with-stream-style (with-stream-style) ;
+
 GENERIC: write-gadget ( gadget stream -- )
 
-M: pane write-gadget
+M: pane-stream write-gadget
     #! Print a gadget to the given pane.
     pane-current add-gadget ;
 
@@ -57,40 +89,15 @@ M: duplex-stream write-gadget
     #! Print a gadget to the current pane.
     stdio get print-gadget ;
 
-! Panes are streams.
-M: pane stream-flush drop ;
-
-: scroll-pane ( pane -- )
-    dup pane-scrolls? [ scroll>bottom ] [ drop ] if ;
-
-M: pane stream-terpri
-    dup pane-current dup unparent prepare-print
-    over pane-output add-incremental
-    dup prepare-line
-    scroll-pane ;
-
-M: pane stream-write1
-    [ pane-current stream-write1 ] keep scroll-pane ;
-
-M: pane stream-write
-    [ swap "\n" split pane-write ] keep scroll-pane ;
-
-M: pane stream-format
-    [ rot "\n" split pane-format ] keep scroll-pane ;
-
-M: pane stream-close drop ;
-
-M: pane with-stream-style
-    (with-stream-style) ;
-
 : ?terpri
-    dup pane-current gadget-children empty?
+    dup pane-stream-pane pane-current gadget-children empty?
     [ dup stream-terpri ] unless drop ;
 
 : with-pane ( pane quot -- )
     #! Clear the pane and run the quotation in a scope with
     #! stdio set to the pane.
-    over pane-clear over >r with-stream* r> ?terpri ; inline
+    over pane-clear >r <pane-stream> r>
+    over >r with-stream r> ?terpri ; inline
 
 : make-pane ( quot -- pane )
     #! Execute the quotation with output to an output-only pane.
diff --git a/library/ui/tools/listener.factor b/library/ui/tools/listener.factor
index 5a7213f33a..7121a1a674 100644
--- a/library/ui/tools/listener.factor
+++ b/library/ui/tools/listener.factor
@@ -15,11 +15,13 @@ TUPLE: listener-gadget input output stack minibuffer use ;
     >r datastack r> listener-gadget-stack set-model ;
 
 : listener-stream ( listener -- stream )
-    dup listener-gadget-input swap listener-gadget-output
+    dup listener-gadget-input
+    swap listener-gadget-output <pane-stream>
     <duplex-stream> ;
 
 : <listener-input> ( -- gadget )
-    gadget get listener-gadget-output <interactor> ;
+    gadget get listener-gadget-output
+    <pane-stream> <interactor> ;
 
 : <stack-display> ( -- gadget )
     gadget get listener-gadget-stack