diff --git a/basis/prettyprint/sections/sections-docs.factor b/basis/prettyprint/sections/sections-docs.factor index 3d42dfa127..54384d9dda 100644 --- a/basis/prettyprint/sections/sections-docs.factor +++ b/basis/prettyprint/sections/sections-docs.factor @@ -19,6 +19,14 @@ HELP: fresh-line { $values { "n" "the current column position" } } { $description "Advances the prettyprinter by one line unless the current line is empty. If the line limit is exceeded, escapes the prettyprinter by restoring a continuation captured in " { $link do-pprint } "." } ; +HELP: soft +{ $description "Possible input parameter to " { $link line-break } "." } ; + +HELP: hard +{ $description "Possible input parameter to " { $link line-break } "." } ; + +{ soft hard } related-words + HELP: section-fits? { $values { "section" section } { "?" boolean } } { $contract "Tests if a section fits in the space that remains on the current line." } ; @@ -102,7 +110,8 @@ HELP: pprint-section $prettyprinting-note ; HELP: line-break -{ $description "Adds a section introducing a line break to the current block. If the block is output as a " { $link short-section } ", all breaks are ignored. Otherwise, breaks introduce unconditional newlines." } +{ $values { "type" { $link soft } " or " { $link hard } } } +{ $description "Adds a section introducing a line break to the current block. If the block is output as a " { $link short-section } ", all breaks are ignored. Otherwise, hard breaks introduce unconditional newlines, and soft breaks introduce a newline if the position is more than half of the " { $link margin } "." } $prettyprinting-note ; HELP: block diff --git a/basis/prettyprint/sections/sections.factor b/basis/prettyprint/sections/sections.factor index 7ae9c661d3..80630e3c65 100644 --- a/basis/prettyprint/sections/sections.factor +++ b/basis/prettyprint/sections/sections.factor @@ -65,6 +65,12 @@ M: maybe vocabulary-name [ pprinter get indent>> + ] dip <= ] if-zero ; +! break only if position margin 2 / > +SYMBOL: soft + +! always breaks +SYMBOL: hard + ! Section protocol GENERIC: section-fits? ( section -- ? ) @@ -88,11 +94,9 @@ style overhang ; : new-section ( length class -- section ) new - position [ - [ >>start ] keep - swapd + - [ >>end ] keep - ] change + position get >>start + swap position [ + ] change + position get >>end 0 >>overhang ; inline M: section section-fits? ( section -- ? ) @@ -142,8 +146,9 @@ M: object short-section? section-fits? ; ! Break section TUPLE: line-break < section type ; -: ( -- section ) - 0 line-break new-section ; +: ( type -- section ) + 0 line-break new-section + swap >>type ; M: line-break short-section drop ; @@ -152,13 +157,13 @@ M: line-break long-section drop ; ! Block sections TUPLE: block < section sections ; -: new-block ( class -- block ) +: new-block ( style class -- block ) 0 swap new-section - V{ } clone >>sections ; inline + V{ } clone >>sections + swap >>style ; inline : ( style -- block ) - block new-block - swap >>style ; + block new-block ; : pprinter-block ( -- block ) pprinter-stack get last ; @@ -181,7 +186,7 @@ TUPLE: block < section sections ; [ short-section? ] } 1&& [ bl ] when ; -: add-line-break ( -- ) add-section ; +: add-line-break ( type -- ) [ add-section ] when* ; M: block section-fits? ( section -- ? ) line-limit? [ drop t ] [ call-next-method ] if ; @@ -197,8 +202,10 @@ M: block short-section ( block -- ) [ advance ] pprint-sections ; : do-break ( break -- ) - dup end>> pprinter get last-newline>> - margin get 2/ > - [ > hard eq? ] + [ end>> pprinter get last-newline>> - margin get 2/ > ] tri + or [ > empty? ; @@ -225,13 +232,13 @@ M: text-section long-section short-section ; : styled-text ( string style -- ) add-section ; -: text ( string -- ) f styled-text ; +: text ( string -- ) H{ } styled-text ; ! Inset section TUPLE: inset < block narrow? ; : ( narrow? -- block ) - inset new-block + H{ } inset new-block 2 >>overhang swap >>narrow? ; @@ -252,7 +259,7 @@ M: inset newline-after? drop t ; TUPLE: flow < block ; : ( -- block ) - flow new-block ; + H{ } flow new-block ; M: flow short-section? ( section -- ? ) #! If we can make room for this entire block by inserting @@ -269,7 +276,7 @@ M: flow short-section? ( section -- ? ) TUPLE: colon < block ; : ( -- block ) - colon new-block ; + H{ } colon new-block ; M: colon long-section short-section ; diff --git a/basis/prettyprint/stylesheet/stylesheet.factor b/basis/prettyprint/stylesheet/stylesheet.factor index dd56e34723..f19c34db2a 100644 --- a/basis/prettyprint/stylesheet/stylesheet.factor +++ b/basis/prettyprint/stylesheet/stylesheet.factor @@ -32,7 +32,7 @@ M: highlighted-word word-style [ + H{ } clone [ [ presented foreground ] dip [ set-at ] curry bi-curry@ bi* ] keep ; @@ -53,4 +53,4 @@ H{ } stack-effect-style set-global : effect-style ( effect -- style ) - presented associate stack-effect-style get assoc-union! ; + presented associate stack-effect-style get assoc-union ; diff --git a/basis/see/see.factor b/basis/see/see.factor index bfbd5fb6cb..e543ca46bb 100644 --- a/basis/see/see.factor +++ b/basis/see/see.factor @@ -153,7 +153,7 @@ M: mixin-class see-class* block> ;