Revert "prettyprint: remove { soft hard } line-break types (only ever used hard), cleanup."

This reverts commit cf0cec0ecd.
db4
John Benediktsson 2015-07-17 23:02:54 -07:00
parent fb688cc08b
commit 2984496e04
4 changed files with 38 additions and 22 deletions

View File

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

View File

@ -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 ;
: <line-break> ( -- section )
0 line-break new-section ;
: <line-break> ( 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
: <block> ( 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 ( -- ) <line-break> add-section ;
: add-line-break ( type -- ) [ <line-break> 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/ >
[ <fresh-line ] [ drop ] if ;
[ ]
[ type>> hard eq? ]
[ end>> pprinter get last-newline>> - margin get 2/ > ] tri
or [ <fresh-line ] [ drop ] if ;
: empty-block? ( block -- ? ) sections>> empty? ;
@ -225,13 +232,13 @@ M: text-section long-section short-section ;
: styled-text ( string style -- ) <text> add-section ;
: text ( string -- ) f styled-text ;
: text ( string -- ) H{ } styled-text ;
! Inset section
TUPLE: inset < block narrow? ;
: <inset> ( 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 ;
: <flow> ( -- 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 ;
: <colon> ( -- block )
colon new-block ;
H{ } colon new-block ;
M: colon long-section short-section ;

View File

@ -32,7 +32,7 @@ M: highlighted-word word-style
<PRIVATE
: colored-presentation-style ( obj color -- style )
2 <hashtable> [
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 ;

View File

@ -153,7 +153,7 @@ M: mixin-class see-class*
<block \ MIXIN: pprint-word
dup pprint-word <block
dup members [
add-line-break
hard add-line-break
\ INSTANCE: pprint-word pprint-word pprint-word
] with each block> block> ;