From 692b648feb31883123cc70d21759e3d61351b62a Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Wed, 11 Mar 2009 03:17:30 -0500
Subject: [PATCH] Change tabular-output and smash-pane behavior to fix panes
 unit tests; re-organize panes code to make more words private

---
 basis/debugger/debugger.factor            |   2 +-
 basis/help/markup/markup.factor           |   5 +-
 basis/inspector/inspector.factor          |   4 +-
 basis/io/styles/styles.factor             |   2 +-
 basis/listener/listener.factor            |   2 +-
 basis/prettyprint/prettyprint.factor      |   2 +-
 basis/tools/memory/memory.factor          |   7 +-
 basis/tools/profiler/profiler.factor      |   4 +-
 basis/tools/threads/threads.factor        |   2 +-
 basis/tools/vocabs/browser/browser.factor |  13 ++-
 basis/ui/gadgets/panes/panes-tests.factor |  24 ++++-
 basis/ui/gadgets/panes/panes.factor       | 119 +++++++++++-----------
 basis/ui/tools/inspector/inspector.factor |   6 +-
 basis/ui/tools/listener/listener.factor   |   2 +-
 14 files changed, 110 insertions(+), 84 deletions(-)

diff --git a/basis/debugger/debugger.factor b/basis/debugger/debugger.factor
index 45bc5bf50a..627fd95384 100644
--- a/basis/debugger/debugger.factor
+++ b/basis/debugger/debugger.factor
@@ -220,7 +220,7 @@ M: assert error.
         5 line-limit set
         [ expect>> [ [ "Expect:" write ] with-cell pprint-cell ] with-row ]
         [ got>> [ [ "Got:" write ] with-cell pprint-cell ] with-row ] bi
-    ] tabular-output ;
+    ] tabular-output nl ;
 
 M: immutable summary drop "Sequence is immutable" ;
 
diff --git a/basis/help/markup/markup.factor b/basis/help/markup/markup.factor
index d4f664d6ff..188cdd1cf8 100644
--- a/basis/help/markup/markup.factor
+++ b/basis/help/markup/markup.factor
@@ -13,7 +13,6 @@ PREDICATE: simple-element < array
 SYMBOL: last-element
 SYMBOL: span
 SYMBOL: block
-SYMBOL: table
 
 : last-span? ( -- ? ) last-element get span eq? ;
 : last-block? ( -- ? ) last-element get block eq? ;
@@ -44,7 +43,7 @@ M: f print-element drop ;
     [ print-element ] with-default-style ;
 
 : ($block) ( quot -- )
-    last-element get { f table } member? [ nl ] unless
+    last-element get [ nl ] when
     span last-element set
     call
     block last-element set ; inline
@@ -218,7 +217,7 @@ ALIAS: $slot $snippet
         table-content-style get [
             swap [ last-element off call ] tabular-output
         ] with-style
-    ] ($block) table last-element set ; inline
+    ] ($block) ; inline
 
 : $list ( element -- )
     list-style get [
diff --git a/basis/inspector/inspector.factor b/basis/inspector/inspector.factor
index 05c4dc2a94..8cab5b5ad3 100644
--- a/basis/inspector/inspector.factor
+++ b/basis/inspector/inspector.factor
@@ -9,7 +9,7 @@ IN: inspector
 
 SYMBOL: +number-rows+
 
-: summary. ( obj -- ) [ summary ] keep write-object nl ;
+: print-summary ( obj -- ) [ summary ] keep write-object ;
 
 <PRIVATE
 
@@ -40,7 +40,7 @@ M: mirror fix-slot-names
 
 : (describe) ( obj assoc -- keys )
     t pprint-string-cells? [
-        [ summary. ] [
+        [ print-summary nl ] [
             dup hashtable? [ sort-unparsed-keys ] when
             [ fix-slot-names add-numbers simple-table. ] [ keys ] bi
         ] bi*
diff --git a/basis/io/styles/styles.factor b/basis/io/styles/styles.factor
index 8e93dc9450..55dc6ca9a4 100644
--- a/basis/io/styles/styles.factor
+++ b/basis/io/styles/styles.factor
@@ -97,7 +97,7 @@ M: plain-writer make-block-stream
     nip <ignore-close-stream> ;
 
 M: plain-writer stream-write-table
-    [ drop format-table [ print ] each ] with-output-stream* ;
+    [ drop format-table [ nl ] [ write ] interleave ] with-output-stream* ;
 
 M: plain-writer make-cell-stream 2drop <string-writer> ;
 
diff --git a/basis/listener/listener.factor b/basis/listener/listener.factor
index 2ee0832269..78a9c03d20 100644
--- a/basis/listener/listener.factor
+++ b/basis/listener/listener.factor
@@ -84,7 +84,7 @@ SYMBOL: max-stack-items
                     bi
                 ] with-row
             ] each
-        ] tabular-output
+        ] tabular-output nl
     ] unless-empty ;
     
 : trimmed-stack. ( seq -- )
diff --git a/basis/prettyprint/prettyprint.factor b/basis/prettyprint/prettyprint.factor
index 63d7bf217a..af56a4d2d0 100644
--- a/basis/prettyprint/prettyprint.factor
+++ b/basis/prettyprint/prettyprint.factor
@@ -165,7 +165,7 @@ SYMBOL: pprint-string-cells?
                 ] each
             ] with-row
         ] each
-    ] tabular-output ;
+    ] tabular-output nl ;
 
 GENERIC: see ( defspec -- )
 
diff --git a/basis/tools/memory/memory.factor b/basis/tools/memory/memory.factor
index 9b727b48de..3d9166aafa 100644
--- a/basis/tools/memory/memory.factor
+++ b/basis/tools/memory/memory.factor
@@ -63,11 +63,12 @@ PRIVATE>
         { "" "Total" "Used" "Free" } write-headings
         (data-room.)
     ] tabular-output
-    nl
+    nl nl
     "==== CODE HEAP" print
     standard-table-style [
         (code-room.)
-    ] tabular-output ;
+    ] tabular-output
+    nl ;
 
 : heap-stats ( -- counts sizes )
     [ ] instances H{ } clone H{ } clone
@@ -83,4 +84,4 @@ PRIVATE>
                 pick at pprint-cell
             ] with-row
         ] each 2drop
-    ] tabular-output ;
+    ] tabular-output nl ;
diff --git a/basis/tools/profiler/profiler.factor b/basis/tools/profiler/profiler.factor
index 19646e55c2..864a637096 100644
--- a/basis/tools/profiler/profiler.factor
+++ b/basis/tools/profiler/profiler.factor
@@ -46,9 +46,7 @@ IN: tools.profiler
     profiler-usage counters ;
 
 : counters. ( assoc -- )
-    standard-table-style [
-        sort-values simple-table.
-    ] tabular-output ;
+    sort-values simple-table. ;
 
 : profile. ( -- )
     "Call counts for all words:" print
diff --git a/basis/tools/threads/threads.factor b/basis/tools/threads/threads.factor
index fc4ba1f6b2..18dd8ce2b7 100644
--- a/basis/tools/threads/threads.factor
+++ b/basis/tools/threads/threads.factor
@@ -29,4 +29,4 @@ IN: tools.threads
         threads >alist sort-keys values [
             [ thread. ] with-row
         ] each
-    ] tabular-output ;
+    ] tabular-output nl ;
diff --git a/basis/tools/vocabs/browser/browser.factor b/basis/tools/vocabs/browser/browser.factor
index 7896cabd2e..70588d5f21 100644
--- a/basis/tools/vocabs/browser/browser.factor
+++ b/basis/tools/vocabs/browser/browser.factor
@@ -66,15 +66,18 @@ C: <vocab-author> vocab-author
 : describe-children ( vocab -- )
     vocab-name all-child-vocabs $vocab-roots ;
 
+: files. ( seq -- )
+    snippet-style get [
+        code-style get [
+            [ nl ] [ [ string>> ] keep write-object ] interleave
+        ] with-nesting
+    ] with-style ;
+
 : describe-files ( vocab -- )
     vocab-files [ <pathname> ] map [
         "Files" $heading
         [
-            snippet-style get [
-                code-style get [
-                    stack.
-                ] with-nesting
-            ] with-style
+            files.
         ] ($block)
     ] unless-empty ;
 
diff --git a/basis/ui/gadgets/panes/panes-tests.factor b/basis/ui/gadgets/panes/panes-tests.factor
index 680b6fe57f..e486bffd38 100644
--- a/basis/ui/gadgets/panes/panes-tests.factor
+++ b/basis/ui/gadgets/panes/panes-tests.factor
@@ -19,7 +19,7 @@ IN: ui.gadgets.panes.tests
 
 : test-gadget-text ( quot -- ? )
     dup make-pane gadget-text dup print "======" print
-    swap with-string-writer dup print "\n" ?tail drop "\n" ?tail drop = ;
+    swap with-string-writer dup print = ;
 
 [ t ] [ [ "hello" write ] test-gadget-text ] unit-test
 [ t ] [ [ "hello" pprint ] test-gadget-text ] unit-test
@@ -87,6 +87,28 @@ IN: ui.gadgets.panes.tests
     ] test-gadget-text
 ] unit-test
 
+[ t ] [
+    [
+        last-element off
+        \ = >link title-style get [
+            $navigation-table
+        ] with-nesting
+        "Hello world" print-content
+    ] test-gadget-text
+] unit-test
+
+[ t ] [
+    [ { { "a\n" } } simple-table. ] test-gadget-text
+] unit-test
+
+[ t ] [
+    [ { { "a" } } simple-table. "x" write ] test-gadget-text
+] unit-test
+
+[ t ] [
+    [ H{ } [ { { "a" } } simple-table. ] with-nesting "x" write ] test-gadget-text
+] unit-test
+
 ARTICLE: "test-article-1" "This is a test article"
 "Hello world, how are you today." ;
 
diff --git a/basis/ui/gadgets/panes/panes.factor b/basis/ui/gadgets/panes/panes.factor
index c52c361b86..bf166f993a 100644
--- a/basis/ui/gadgets/panes/panes.factor
+++ b/basis/ui/gadgets/panes/panes.factor
@@ -17,6 +17,12 @@ TUPLE: pane < track
 output current input last-line prototype scrolls?
 selection-color caret mark selecting? ;
 
+TUPLE: pane-stream pane ;
+
+C: <pane-stream> pane-stream
+
+<PRIVATE
+
 : clear-selection ( pane -- pane )
     f >>caret f >>mark ; inline
 
@@ -49,12 +55,6 @@ M: pane gadget-selection? pane-caret&mark and ;
 M: pane gadget-selection ( pane -- string/f )
     selected-children gadget-text ;
 
-: pane-clear ( pane -- )
-    clear-selection
-    [ output>> clear-incremental ]
-    [ current>> clear-gadget ]
-    bi ;
-
 : init-prototype ( pane -- pane )
     <shelf> +baseline+ >>align >>prototype ; inline
 
@@ -70,17 +70,6 @@ M: pane gadget-selection ( pane -- string/f )
     [ >>last-line ] [ 1 track-add ] bi
     dup prepare-last-line ; inline
 
-: new-pane ( input class -- pane )
-    [ vertical ] dip new-track
-        swap >>input
-        pane-theme
-        init-prototype
-        init-output
-        init-current
-        init-last-line ; inline
-
-: <pane> ( -- pane ) f pane new-pane ;
-
 GENERIC: draw-selection ( loc obj -- )
 
 : if-fits ( rect quot -- )
@@ -112,10 +101,6 @@ M: pane draw-gadget*
 : scroll-pane ( pane -- )
     dup scrolls?>> [ scroll>bottom ] [ drop ] if ;
 
-TUPLE: pane-stream pane ;
-
-C: <pane-stream> pane-stream
-
 : smash-line ( current -- gadget )
     dup children>> {
         { [ dup empty? ] [ 2drop "" <label> ] }
@@ -123,14 +108,18 @@ C: <pane-stream> pane-stream
         [ drop ]
     } cond ;
 
-: smash-pane ( pane -- gadget ) output>> smash-line ;
-
 : pane-nl ( pane -- )
     [
         [ current>> [ unparent ] [ smash-line ] bi ] [ output>> ] bi
         add-incremental
     ] [ next-line ] bi ;
 
+: ?pane-nl ( pane -- )
+    [ dup current>> children>> empty? [ pane-nl ] [ drop ] if ]
+    [ pane-nl ] bi ;
+
+: smash-pane ( pane -- gadget ) [ pane-nl ] [ output>> smash-line ] bi ;
+
 : pane-write ( seq pane -- )
     [ pane-nl ] [ current>> stream-write ]
     bi-curry interleave ;
@@ -139,6 +128,41 @@ C: <pane-stream> pane-stream
     [ nip pane-nl ] [ current>> stream-format ]
     bi-curry bi-curry interleave ;
 
+: do-pane-stream ( pane-stream quot -- )
+    [ pane>> ] dip keep scroll-pane ; inline
+
+M: pane-stream stream-nl
+    [ pane-nl ] do-pane-stream ;
+
+M: pane-stream stream-write1
+    [ current>> stream-write1 ] do-pane-stream ;
+
+M: pane-stream stream-write
+    [ [ string-lines ] dip pane-write ] do-pane-stream ;
+
+M: pane-stream stream-format
+    [ [ string-lines ] 2dip pane-format ] do-pane-stream ;
+
+M: pane-stream dispose drop ;
+
+M: pane-stream stream-flush drop ;
+
+M: pane-stream make-span-stream
+    swap <style-stream> <ignore-close-stream> ;
+
+PRIVATE>
+
+: new-pane ( input class -- pane )
+    [ vertical ] dip new-track
+        swap >>input
+        pane-theme
+        init-prototype
+        init-output
+        init-current
+        init-last-line ; inline
+
+: <pane> ( -- pane ) f pane new-pane ;
+
 GENERIC: write-gadget ( gadget stream -- )
 
 M: pane-stream write-gadget ( gadget pane-stream -- )
@@ -153,17 +177,18 @@ M: style-stream write-gadget
 : gadget. ( gadget -- )
     output-stream get print-gadget ;
 
-: ?nl ( stream -- )
-    dup pane>> current>> children>> empty?
-    [ dup stream-nl ] unless drop ;
+: pane-clear ( pane -- )
+    clear-selection
+    [ output>> clear-incremental ]
+    [ current>> clear-gadget ]
+    bi ;
 
 : with-pane ( pane quot -- )
-    over scroll>top
-    over pane-clear [ <pane-stream> ] dip
-    over [ with-output-stream* ] dip ?nl ; inline
+    [ [ scroll>top ] [ pane-clear ] [ <pane-stream> ] tri ] dip
+    with-output-stream* ; inline
 
 : make-pane ( quot -- gadget )
-    <pane> [ swap with-pane ] keep smash-pane ; inline
+    [ <pane> ] dip [ with-pane ] [ drop smash-pane ] 2bi ; inline
 
 TUPLE: pane-control < pane quot ;
 
@@ -176,29 +201,8 @@ M: pane-control model-changed ( model pane-control -- )
         swap >>quot
         swap >>model ;
 
-: do-pane-stream ( pane-stream quot -- )
-    [ pane>> ] dip keep scroll-pane ; inline
-
-M: pane-stream stream-nl
-    [ pane-nl ] do-pane-stream ;
-
-M: pane-stream stream-write1
-    [ current>> stream-write1 ] do-pane-stream ;
-
-M: pane-stream stream-write
-    [ [ string-lines ] dip pane-write ] do-pane-stream ;
-
-M: pane-stream stream-format
-    [ [ string-lines ] 2dip pane-format ] do-pane-stream ;
-
-M: pane-stream dispose drop ;
-
-M: pane-stream stream-flush drop ;
-
-M: pane-stream make-span-stream
-    swap <style-stream> <ignore-close-stream> ;
-
 ! Character styles
+<PRIVATE
 
 MEMO: specified-font ( assoc -- font )
     #! We memoize here to avoid creating lots of duplicate font objects.
@@ -279,10 +283,7 @@ TUPLE: nested-pane-stream < pane-stream style parent ;
     inline
 
 : unnest-pane-stream ( stream -- child parent )
-    dup ?nl
-    dup style>>
-    over pane>> smash-pane style-pane
-    swap parent>> ;
+    [ [ style>> ] [ pane>> smash-pane ] bi style-pane ] [ parent>> ] bi ;
 
 TUPLE: pane-block-stream < nested-pane-stream ;
 
@@ -309,7 +310,7 @@ M: pane-stream make-block-stream
 
 TUPLE: pane-cell-stream < nested-pane-stream ;
 
-M: pane-cell-stream dispose ?nl ;
+M: pane-cell-stream dispose drop ;
 
 M: pane-stream make-cell-stream
     pane-cell-stream new-nested-pane-stream ;
@@ -318,7 +319,7 @@ M: pane-stream stream-write-table
     [
         swap [ [ pane>> smash-pane ] map ] map
         styled-grid
-    ] dip print-gadget ;
+    ] dip write-gadget ;
 
 ! Stream utilities
 M: pack dispose drop ;
@@ -433,6 +434,8 @@ M: f sloppy-pick-up*
 
 : pane-menu ( pane -- ) { com-copy } show-commands-menu ;
 
+PRIVATE>
+
 pane H{
     { T{ button-down } [ begin-selection ] }
     { T{ button-down f { S+ } 1 } [ select-to-caret ] }
diff --git a/basis/ui/tools/inspector/inspector.factor b/basis/ui/tools/inspector/inspector.factor
index 17ffc9ee18..35fa5e3c17 100644
--- a/basis/ui/tools/inspector/inspector.factor
+++ b/basis/ui/tools/inspector/inspector.factor
@@ -33,19 +33,19 @@ M: inspector-renderer column-titles
             [
                 [
                     [ "Class:" write ] with-cell
-                    [ class . ] with-cell
+                    [ class pprint ] with-cell
                 ] with-row
             ]
             [
                 [
                     [ "Object:" write ] with-cell
-                    [ short. ] with-cell
+                    [ pprint-short ] with-cell
                 ] with-row
             ]
             [
                 [
                     [ "Summary:" write ] with-cell
-                    [ summary. ] with-cell
+                    [ print-summary ] with-cell
                 ] with-row
             ] tri
         ] tabular-output
diff --git a/basis/ui/tools/listener/listener.factor b/basis/ui/tools/listener/listener.factor
index ebf2db79bf..4429f058f1 100644
--- a/basis/ui/tools/listener/listener.factor
+++ b/basis/ui/tools/listener/listener.factor
@@ -175,7 +175,7 @@ TUPLE: listener-gadget < tool input output scroller ;
     [ listener-gadget? ] find-parent ;
 
 : listener-streams ( listener -- input output )
-    [ input>> ] [ output>> ] bi <pane-stream> ;
+    [ input>> ] [ output>> <pane-stream> ] bi ;
 
 : init-listener ( listener -- listener )
     <interactor>
-- 
2.34.1