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/cookbook/cookbook.factor b/basis/help/cookbook/cookbook.factor index b2b65c3913..d6693cd94f 100644 --- a/basis/help/cookbook/cookbook.factor +++ b/basis/help/cookbook/cookbook.factor @@ -1,6 +1,6 @@ USING: help.markup help.syntax io kernel math namespaces parser prettyprint sequences vocabs.loader namespaces stack-checker -help command-line multiline ; +help command-line multiline see ; IN: help.cookbook ARTICLE: "cookbook-syntax" "Basic syntax cookbook" diff --git a/basis/help/definitions/definitions.factor b/basis/help/definitions/definitions.factor index 3e4066d8b7..91ee1c9c79 100644 --- a/basis/help/definitions/definitions.factor +++ b/basis/help/definitions/definitions.factor @@ -1,8 +1,8 @@ -! Copyright (C) 2007, 2008 Slava Pestov. +! Copyright (C) 2007, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors definitions help help.topics help.syntax prettyprint.backend prettyprint.custom prettyprint words kernel -effects ; +effects see ; IN: help.definitions ! Definition protocol implementation diff --git a/basis/help/handbook/handbook.factor b/basis/help/handbook/handbook.factor index 331fafbbd1..f20732c7ee 100644 --- a/basis/help/handbook/handbook.factor +++ b/basis/help/handbook/handbook.factor @@ -194,6 +194,7 @@ ARTICLE: "io" "Input and output" ARTICLE: "tools" "Developer tools" { $subsection "tools.vocabs" } "Exploratory tools:" +{ $subsection "see" } { $subsection "editor" } { $subsection "listener" } { $subsection "tools.crossref" } diff --git a/basis/help/help-docs.factor b/basis/help/help-docs.factor index 8384799dbd..733199fc60 100644 --- a/basis/help/help-docs.factor +++ b/basis/help/help-docs.factor @@ -1,6 +1,6 @@ USING: help.markup help.crossref help.stylesheet help.topics help.syntax definitions io prettyprint summary arrays math -sequences vocabs strings ; +sequences vocabs strings see ; IN: help ARTICLE: "printing-elements" "Printing markup elements" diff --git a/basis/help/markup/markup.factor b/basis/help/markup/markup.factor index d4f664d6ff..ea64def751 100644 --- a/basis/help/markup/markup.factor +++ b/basis/help/markup/markup.factor @@ -4,7 +4,7 @@ USING: accessors arrays definitions generic io kernel assocs hashtables namespaces make parser prettyprint sequences strings io.styles vectors words math sorting splitting classes slots fry sets vocabs help.stylesheet help.topics vocabs.loader quotations -combinators call ; +combinators call see ; IN: help.markup PREDICATE: simple-element < array @@ -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 [ @@ -301,7 +300,7 @@ M: f ($instance) ] with-style ] ($block) ; inline -: $see ( element -- ) first [ see ] ($see) ; +: $see ( element -- ) first [ see* ] ($see) ; : $synopsis ( element -- ) first [ synopsis write ] ($see) ; @@ -346,6 +345,8 @@ M: f ($instance) drop "Throws an error if the I/O operation fails." $errors ; +FROM: prettyprint.private => with-pprint ; + : $prettyprinting-note ( children -- ) drop { "This word should only be called from inside the " 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 ; ; 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 ; 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/locals/definitions/definitions.factor b/basis/locals/definitions/definitions.factor index 99f9d0bd22..a4299d0684 100644 --- a/basis/locals/definitions/definitions.factor +++ b/basis/locals/definitions/definitions.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2007, 2008 Slava Pestov, Eduardo Cavazos. ! See http://factorcode.org/license.txt for BSD license. USING: accessors definitions effects generic kernel locals -macros memoize prettyprint prettyprint.backend words ; +macros memoize prettyprint prettyprint.backend see words ; IN: locals.definitions PREDICATE: lambda-word < word "lambda" word-prop >boolean ; diff --git a/basis/locals/locals-docs.factor b/basis/locals/locals-docs.factor index 0998d84530..18dabed4b0 100644 --- a/basis/locals/locals-docs.factor +++ b/basis/locals/locals-docs.factor @@ -1,5 +1,5 @@ USING: help.syntax help.markup kernel macros prettyprint -memoize combinators arrays generalizations ; +memoize combinators arrays generalizations see ; IN: locals HELP: [| diff --git a/basis/prettyprint/prettyprint-docs.factor b/basis/prettyprint/prettyprint-docs.factor index 1e372d7cc0..2be725c0f6 100644 --- a/basis/prettyprint/prettyprint-docs.factor +++ b/basis/prettyprint/prettyprint-docs.factor @@ -1,6 +1,7 @@ USING: prettyprint.backend prettyprint.config prettyprint.custom prettyprint.sections prettyprint.private help.markup help.syntax -io kernel words definitions quotations strings generic classes ; +io kernel words definitions quotations strings generic classes +prettyprint.private ; IN: prettyprint ARTICLE: "prettyprint-numbers" "Prettyprinting numbers" @@ -149,10 +150,6 @@ $nl { $subsection unparse-use } "Utility for tabular output:" { $subsection pprint-cell } -"Printing a definition (see " { $link "definitions" } "):" -{ $subsection see } -"Printing the methods defined on a generic word or class (see " { $link "objects" } "):" -{ $subsection see-methods } "More prettyprinter usage:" { $subsection "prettyprint-numbers" } { $subsection "prettyprint-stacks" } @@ -160,7 +157,7 @@ $nl { $subsection "prettyprint-variables" } { $subsection "prettyprint-extension" } { $subsection "prettyprint-limitations" } -{ $see-also "number-strings" } ; +{ $see-also "number-strings" "see" } ; ABOUT: "prettyprint" @@ -232,51 +229,4 @@ HELP: .s HELP: in. { $values { "vocab" "a vocabulary specifier" } } { $description "Prettyprints a " { $snippet "IN:" } " declaration." } -$prettyprinting-note ; - -HELP: synopsis -{ $values { "defspec" "a definition specifier" } { "str" string } } -{ $contract "Prettyprints the prologue of a definition." } ; - -HELP: synopsis* -{ $values { "defspec" "a definition specifier" } } -{ $contract "Adds sections to the current block corresponding to a the prologue of a definition, in source code-like form." } -{ $notes "This word should only be called from inside the " { $link with-pprint } " combinator. Client code should call " { $link synopsis } " instead." } ; - -HELP: comment. -{ $values { "string" "a string" } } -{ $description "Prettyprints some text with the comment style." } -$prettyprinting-note ; - -HELP: see -{ $values { "defspec" "a definition specifier" } } -{ $contract "Prettyprints a definition." } ; - -HELP: see-methods -{ $values { "word" "a " { $link generic } " or a " { $link class } } } -{ $contract "Prettyprints the methods defined on a generic word or class." } ; - -HELP: definer -{ $values { "defspec" "a definition specifier" } { "start" word } { "end" "a word or " { $link f } } } -{ $contract "Outputs the parsing words which delimit the definition." } -{ $examples - { $example "USING: definitions prettyprint ;" - "IN: scratchpad" - ": foo ; \\ foo definer . ." - ";\nPOSTPONE: :" - } - { $example "USING: definitions prettyprint ;" - "IN: scratchpad" - "SYMBOL: foo \\ foo definer . ." - "f\nPOSTPONE: SYMBOL:" - } -} -{ $notes "This word is used in the implementation of " { $link see } "." } ; - -HELP: definition -{ $values { "defspec" "a definition specifier" } { "seq" "a sequence" } } -{ $contract "Outputs the body of a definition." } -{ $examples - { $example "USING: definitions math prettyprint ;" "\\ sq definition ." "[ dup * ]" } -} -{ $notes "This word is used in the implementation of " { $link see } "." } ; +$prettyprinting-note ; \ No newline at end of file diff --git a/basis/prettyprint/prettyprint-tests.factor b/basis/prettyprint/prettyprint-tests.factor index b1239086d7..aaaf6b80d1 100644 --- a/basis/prettyprint/prettyprint-tests.factor +++ b/basis/prettyprint/prettyprint-tests.factor @@ -3,7 +3,7 @@ kernel math namespaces parser prettyprint prettyprint.config prettyprint.sections sequences tools.test vectors words effects splitting generic.standard prettyprint.private continuations generic compiler.units tools.walker eval -accessors make vocabs.parser ; +accessors make vocabs.parser see ; IN: prettyprint.tests [ "4" ] [ 4 unparse ] unit-test diff --git a/basis/prettyprint/prettyprint.factor b/basis/prettyprint/prettyprint.factor index 63d7bf217a..7ef15b9a2f 100644 --- a/basis/prettyprint/prettyprint.factor +++ b/basis/prettyprint/prettyprint.factor @@ -1,16 +1,14 @@ -! Copyright (C) 2003, 2008 Slava Pestov. +! Copyright (C) 2003, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: arrays generic generic.standard assocs io kernel math -namespaces make sequences strings io.styles io.streams.string -vectors words words.symbol prettyprint.backend prettyprint.custom -prettyprint.sections prettyprint.config sorting splitting -grouping math.parser vocabs definitions effects classes.builtin -classes.tuple io.pathnames classes continuations hashtables -classes.mixin classes.union classes.intersection -classes.predicate classes.singleton combinators quotations sets -accessors colors parser summary vocabs.parser ; +USING: accessors assocs colors combinators grouping io +io.streams.string io.styles kernel make math math.parser namespaces +parser prettyprint.backend prettyprint.config prettyprint.custom +prettyprint.sections quotations sequences sorting strings vocabs +vocabs.parser words ; IN: prettyprint + + : with-use ( obj quot -- ) make-pprint use/in. do-pprint ; inline @@ -165,214 +165,4 @@ SYMBOL: pprint-string-cells? ] each ] with-row ] each - ] tabular-output ; - -GENERIC: see ( defspec -- ) - -: comment. ( string -- ) - [ H{ { font-style italic } } styled-text ] when* ; - -: seeing-word ( word -- ) - vocabulary>> pprinter-in set ; - -: definer. ( defspec -- ) - definer drop pprint-word ; - -: stack-effect. ( word -- ) - [ [ parsing-word? ] [ symbol? ] bi or not ] [ stack-effect ] bi and - [ effect>string comment. ] when* ; - -: word-synopsis ( word -- ) - { - [ seeing-word ] - [ definer. ] - [ pprint-word ] - [ stack-effect. ] - } cleave ; - -M: word synopsis* word-synopsis ; - -M: simple-generic synopsis* word-synopsis ; - -M: standard-generic synopsis* - { - [ definer. ] - [ seeing-word ] - [ pprint-word ] - [ dispatch# pprint* ] - [ stack-effect. ] - } cleave ; - -M: hook-generic synopsis* - { - [ definer. ] - [ seeing-word ] - [ pprint-word ] - [ "combination" word-prop var>> pprint* ] - [ stack-effect. ] - } cleave ; - -M: method-spec synopsis* - first2 method synopsis* ; - -M: method-body synopsis* - [ definer. ] - [ "method-class" word-prop pprint-word ] - [ "method-generic" word-prop pprint-word ] tri ; - -M: mixin-instance synopsis* - [ definer. ] - [ class>> pprint-word ] - [ mixin>> pprint-word ] tri ; - -M: pathname synopsis* pprint* ; - -: synopsis ( defspec -- str ) - [ - 0 margin set - 1 line-limit set - [ synopsis* ] with-in - ] with-string-writer ; - -M: word summary synopsis ; - -GENERIC: declarations. ( obj -- ) - -M: object declarations. drop ; - -: declaration. ( word prop -- ) - [ nip ] [ name>> word-prop ] 2bi - [ pprint-word ] [ drop ] if ; - -M: word declarations. - { - POSTPONE: parsing - POSTPONE: delimiter - POSTPONE: inline - POSTPONE: recursive - POSTPONE: foldable - POSTPONE: flushable - } [ declaration. ] with each ; - -: pprint-; ( -- ) \ ; pprint-word ; - -M: object see - [ - 12 nesting-limit set - 100 length-limit set - - dup definer nip [ pprint-word ] when* declarations. - block> - ] with-use nl ; - -M: method-spec see - first2 method see ; - -GENERIC: see-class* ( word -- ) - -M: union-class see-class* - ; - -M: intersection-class see-class* - ; - -M: mixin-class see-class* - block> ; - -M: predicate-class see-class* - block> ; - -M: singleton-class see-class* ( class -- ) - \ SINGLETON: pprint-word pprint-word ; - -GENERIC: pprint-slot-name ( object -- ) - -M: string pprint-slot-name text ; - -M: array pprint-slot-name - - \ } pprint-word block> ; - -: unparse-slot ( slot-spec -- array ) - [ - dup name>> , - dup class>> object eq? [ - dup class>> , - initial: , - dup initial>> , - ] unless - dup read-only>> [ - read-only , - ] when - drop - ] { } make ; - -: pprint-slot ( slot-spec -- ) - unparse-slot - dup length 1 = [ first ] when - pprint-slot-name ; - -M: tuple-class see-class* - - pprint-; block> ; - -M: word see-class* drop ; - -M: builtin-class see-class* - drop "! Built-in class" comment. ; - -: see-class ( class -- ) - dup class? [ - [ - dup seeing-word dup see-class* - ] with-use nl - ] when drop ; - -M: word see - [ see-class ] - [ [ class? ] [ symbol? not ] bi and [ nl ] when ] - [ - dup [ class? ] [ symbol? ] bi and - [ drop ] [ call-next-method ] if - ] tri ; - -: see-all ( seq -- ) - natural-sort [ nl ] [ see ] interleave ; - -: (see-implementors) ( class -- seq ) - dup implementors [ method ] with map natural-sort ; - -: (see-methods) ( generic -- seq ) - "methods" word-prop values natural-sort ; - -: methods ( word -- seq ) - [ - dup class? [ dup (see-implementors) % ] when - dup generic? [ dup (see-methods) % ] when - drop - ] { } make prune ; - -: see-methods ( word -- ) - methods see-all ; + ] tabular-output nl ; \ No newline at end of file diff --git a/basis/prettyprint/sections/sections-docs.factor b/basis/prettyprint/sections/sections-docs.factor index 4f1c073a2d..ce7430d040 100644 --- a/basis/prettyprint/sections/sections-docs.factor +++ b/basis/prettyprint/sections/sections-docs.factor @@ -199,7 +199,7 @@ HELP: string comment. ] when* ; + +> pprinter-in set ; + +: word-synopsis ( word -- ) + { + [ seeing-word ] + [ definer. ] + [ pprint-word ] + [ stack-effect. ] + } cleave ; + +M: word synopsis* word-synopsis ; + +M: simple-generic synopsis* word-synopsis ; + +M: standard-generic synopsis* + { + [ definer. ] + [ seeing-word ] + [ pprint-word ] + [ dispatch# pprint* ] + [ stack-effect. ] + } cleave ; + +M: hook-generic synopsis* + { + [ definer. ] + [ seeing-word ] + [ pprint-word ] + [ "combination" word-prop var>> pprint* ] + [ stack-effect. ] + } cleave ; + +M: method-spec synopsis* + first2 method synopsis* ; + +M: method-body synopsis* + [ definer. ] + [ "method-class" word-prop pprint-word ] + [ "method-generic" word-prop pprint-word ] tri ; + +M: mixin-instance synopsis* + [ definer. ] + [ class>> pprint-word ] + [ mixin>> pprint-word ] tri ; + +M: pathname synopsis* pprint* ; + +M: word summary synopsis ; + +GENERIC: declarations. ( obj -- ) + +M: object declarations. drop ; + +: declaration. ( word prop -- ) + [ nip ] [ name>> word-prop ] 2bi + [ pprint-word ] [ drop ] if ; + +M: word declarations. + { + POSTPONE: parsing + POSTPONE: delimiter + POSTPONE: inline + POSTPONE: recursive + POSTPONE: foldable + POSTPONE: flushable + } [ declaration. ] with each ; + +: pprint-; ( -- ) \ ; pprint-word ; + +M: object see* + [ + 12 nesting-limit set + 100 length-limit set + + dup definer nip [ pprint-word ] when* declarations. + block> + ] with-use ; + +M: method-spec see* + first2 method see* ; + +GENERIC: see-class* ( word -- ) + +M: union-class see-class* + ; + +M: intersection-class see-class* + ; + +M: mixin-class see-class* + block> ; + +M: predicate-class see-class* + block> ; + +M: singleton-class see-class* ( class -- ) + \ SINGLETON: pprint-word pprint-word ; + +GENERIC: pprint-slot-name ( object -- ) + +M: string pprint-slot-name text ; + +M: array pprint-slot-name + + \ } pprint-word block> ; + +: unparse-slot ( slot-spec -- array ) + [ + dup name>> , + dup class>> object eq? [ + dup class>> , + initial: , + dup initial>> , + ] unless + dup read-only>> [ + read-only , + ] when + drop + ] { } make ; + +: pprint-slot ( slot-spec -- ) + unparse-slot + dup length 1 = [ first ] when + pprint-slot-name ; + +M: tuple-class see-class* + + pprint-; block> ; + +M: word see-class* drop ; + +M: builtin-class see-class* + drop "! Built-in class" comment. ; + +: see-class ( class -- ) + dup class? [ + [ + [ seeing-word ] [ see-class* ] bi + ] with-use + ] [ drop ] if ; + +M: word see* + [ see-class ] + [ [ class? ] [ symbol? not ] bi and [ nl nl ] when ] + [ + dup [ class? ] [ symbol? ] bi and + [ drop ] [ call-next-method ] if + ] tri ; + +: seeing-implementors ( class -- seq ) + dup implementors [ method ] with map natural-sort ; + +: seeing-methods ( generic -- seq ) + "methods" word-prop values natural-sort ; + +PRIVATE> + +: see-all ( seq -- ) + natural-sort [ nl nl ] [ see* ] interleave ; + +: methods ( word -- seq ) + [ + dup class? [ dup seeing-implementors % ] when + dup generic? [ dup seeing-methods % ] when + drop + ] { } make prune ; + +: see-methods ( word -- ) + methods see-all nl ; \ No newline at end of file diff --git a/basis/see/summary.txt b/basis/see/summary.txt new file mode 100644 index 0000000000..a6274bcfe2 --- /dev/null +++ b/basis/see/summary.txt @@ -0,0 +1 @@ +Printing loaded definitions as source code diff --git a/basis/stack-checker/backend/backend.factor b/basis/stack-checker/backend/backend.factor index 78f357b1cb..9e867f4fbb 100755 --- a/basis/stack-checker/backend/backend.factor +++ b/basis/stack-checker/backend/backend.factor @@ -155,7 +155,7 @@ M: object apply-object push-literal ; "cannot-infer" word-prop rethrow ; : maybe-cannot-infer ( word quot -- ) - [ [ "cannot-infer" set-word-prop ] keep throw ] recover ; inline + [ [ "cannot-infer" set-word-prop ] keep rethrow ] recover ; inline : infer-word ( word -- effect ) [ diff --git a/basis/tools/crossref/crossref-docs.factor b/basis/tools/crossref/crossref-docs.factor index 820c957cbc..f49ac7ea76 100644 --- a/basis/tools/crossref/crossref-docs.factor +++ b/basis/tools/crossref/crossref-docs.factor @@ -3,7 +3,7 @@ IN: tools.crossref ARTICLE: "tools.crossref" "Cross-referencing tools" { $subsection usage. } -{ $see-also "definitions" "words" see see-methods } ; +{ $see-also "definitions" "words" "see" } ; ABOUT: "tools.crossref" diff --git a/basis/tools/crossref/crossref.factor b/basis/tools/crossref/crossref.factor index 494e022243..36ccaadc98 100644 --- a/basis/tools/crossref/crossref.factor +++ b/basis/tools/crossref/crossref.factor @@ -1,11 +1,11 @@ -! Copyright (C) 2005, 2008 Slava Pestov. +! Copyright (C) 2005, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: assocs definitions io io.styles kernel prettyprint -sorting ; +sorting see ; IN: tools.crossref : synopsis-alist ( definitions -- alist ) - [ dup synopsis swap ] { } map>assoc ; + [ [ synopsis ] keep ] { } map>assoc ; : definitions. ( alist -- ) [ write-object nl ] assoc-each ; 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 : 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 [ ] 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-docs.factor b/basis/ui/gadgets/panes/panes-docs.factor index afb2307b1e..cb747bf84d 100644 --- a/basis/ui/gadgets/panes/panes-docs.factor +++ b/basis/ui/gadgets/panes/panes-docs.factor @@ -26,10 +26,6 @@ HELP: gadget. { $description "Writes a gadget followed by a newline to " { $link output-stream } "." } { $notes "Not all streams support this operation." } ; -HELP: ?nl -{ $values { "stream" pane-stream } } -{ $description "Inserts a line break in the pane unless the current line is empty." } ; - HELP: with-pane { $values { "pane" pane } { "quot" quotation } } { $description "Clears the pane and calls the quotation in a new scope where " { $link output-stream } " is rebound to a " { $link pane-stream } " writing to the pane." } ; 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 + +>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 ) +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 ) 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 - : smash-line ( current -- gadget ) dup children>> { { [ dup empty? ] [ 2drop ""