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

@@ -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" ;
 

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 [

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*

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> ;
 

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 -- )

basis/prettyprint/prettyprint.factor

@@ -165,7 +165,7 @@ SYMBOL: pprint-string-cells?
                 ] each
             ] with-row
         ] each
-    ] tabular-output ;
+    ] tabular-output nl ;
 
 GENERIC: see ( defspec -- )
 

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 ;

basis/tools/profiler/profiler.factor

@@ -46,9 +46,7 @@ IN: tools.profiler
     profiler-usage counters ;
 
 : counters. ( assoc -- )
-    standard-table-style [
+    sort-values simple-table. ;
-        sort-values simple-table.
-    ] tabular-output ;
 
 : profile. ( -- )
     "Call counts for all words:" print

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 ;

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 [
+            files.
-                code-style get [
-                    stack.
-                ] with-nesting
-            ] with-style
         ] ($block)
     ] unless-empty ;
 

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." ;
 

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,43 +128,6 @@ C: <pane-stream> pane-stream
     [ nip pane-nl ] [ current>> stream-format ]
     bi-curry bi-curry interleave ;
 
-GENERIC: write-gadget ( gadget stream -- )
-
-M: pane-stream write-gadget ( gadget pane-stream -- )
-    pane>> current>> swap add-gadget drop ;
-
-M: style-stream write-gadget
-    stream>> write-gadget ;
-
-: print-gadget ( gadget stream -- )
-    [ write-gadget ] [ nip stream-nl ] 2bi ;
-
-: gadget. ( gadget -- )
-    output-stream get print-gadget ;
-
-: ?nl ( stream -- )
-    dup pane>> current>> children>> empty?
-    [ dup stream-nl ] unless drop ;
-
-: with-pane ( pane quot -- )
-    over scroll>top
-    over pane-clear [ <pane-stream> ] dip
-    over [ with-output-stream* ] dip ?nl ; inline
-
-: make-pane ( quot -- gadget )
-    <pane> [ swap with-pane ] keep smash-pane ; inline
-
-TUPLE: pane-control < pane quot ;
-
-M: pane-control model-changed ( model pane-control -- )
-    [ value>> ] [ dup quot>> ] bi*
-    '[ _ call( value -- ) ] with-pane ;
-
-: <pane-control> ( model quot -- pane )
-    f pane-control new-pane
-        swap >>quot
-        swap >>model ;
-
 : do-pane-stream ( pane-stream quot -- )
     [ pane>> ] dip keep scroll-pane ; inline
 
@@ -198,7 +150,59 @@ 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 -- )
+    pane>> current>> swap add-gadget drop ;
+
+M: style-stream write-gadget
+    stream>> write-gadget ;
+
+: print-gadget ( gadget stream -- )
+    [ write-gadget ] [ nip stream-nl ] 2bi ;
+
+: gadget. ( gadget -- )
+    output-stream get print-gadget ;
+
+: pane-clear ( pane -- )
+    clear-selection
+    [ output>> clear-incremental ]
+    [ current>> clear-gadget ]
+    bi ;
+
+: with-pane ( pane quot -- )
+    [ [ scroll>top ] [ pane-clear ] [ <pane-stream> ] tri ] dip
+    with-output-stream* ; inline
+
+: make-pane ( quot -- gadget )
+    [ <pane> ] dip [ with-pane ] [ drop smash-pane ] 2bi ; inline
+
+TUPLE: pane-control < pane quot ;
+
+M: pane-control model-changed ( model pane-control -- )
+    [ value>> ] [ dup quot>> ] bi*
+    '[ _ call( value -- ) ] with-pane ;
+
+: <pane-control> ( model quot -- pane )
+    f pane-control new-pane
+        swap >>quot
+        swap >>model ;
+
 ! 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
+    [ [ style>> ] [ pane>> smash-pane ] bi style-pane ] [ parent>> ] bi ;
-    dup style>>
-    over pane>> smash-pane style-pane
-    swap parent>> ;
 
 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 ] }

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

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>