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

db4
John Benediktsson 2015-07-17 16:05:10 -07:00
parent d2ab2e6dd1
commit cf0cec0ecd
4 changed files with 22 additions and 38 deletions

View File

@ -19,14 +19,6 @@ 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." } ;
@ -110,8 +102,7 @@ HELP: pprint-section
$prettyprinting-note ;
HELP: line-break
{ $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 } "." }
{ $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." }
$prettyprinting-note ;
HELP: block

View File

@ -63,12 +63,6 @@ M: maybe vocabulary-name
margin get
[ drop t ] [ [ pprinter get indent>> + ] dip <= ] if-zero ;
! break only if position margin 2 / >
SYMBOL: soft
! always breaks
SYMBOL: hard
! Section protocol
GENERIC: section-fits? ( section -- ? )
@ -92,9 +86,11 @@ style overhang ;
: new-section ( length class -- section )
new
position get >>start
swap position [ + ] change
position get >>end
position [
[ >>start ] keep
swapd +
[ >>end ] keep
] change
0 >>overhang ; inline
M: section section-fits? ( section -- ? )
@ -144,9 +140,8 @@ M: object short-section? section-fits? ;
! Break section
TUPLE: line-break < section type ;
: <line-break> ( type -- section )
0 line-break new-section
swap >>type ;
: <line-break> ( -- section )
0 line-break new-section ;
M: line-break short-section drop ;
@ -155,13 +150,13 @@ M: line-break long-section drop ;
! Block sections
TUPLE: block < section sections ;
: new-block ( style class -- block )
: new-block ( class -- block )
0 swap new-section
V{ } clone >>sections
swap >>style ; inline
V{ } clone >>sections ; inline
: <block> ( style -- block )
block new-block ;
block new-block
swap >>style ;
: pprinter-block ( -- block ) pprinter-stack get last ;
@ -184,7 +179,7 @@ TUPLE: block < section sections ;
[ short-section? ]
} 1&& [ bl ] when ;
: add-line-break ( type -- ) [ <line-break> add-section ] when* ;
: add-line-break ( -- ) <line-break> add-section ;
M: block section-fits? ( section -- ? )
line-limit? [ drop t ] [ call-next-method ] if ;
@ -200,10 +195,8 @@ M: block short-section ( block -- )
[ advance ] pprint-sections ;
: do-break ( break -- )
[ ]
[ type>> hard eq? ]
[ end>> pprinter get last-newline>> - margin get 2/ > ] tri
or [ <fresh-line ] [ drop ] if ;
dup end>> pprinter get last-newline>> - margin get 2/ >
[ <fresh-line ] [ drop ] if ;
: empty-block? ( block -- ? ) sections>> empty? ;
@ -230,13 +223,13 @@ M: text-section long-section short-section ;
: styled-text ( string style -- ) <text> add-section ;
: text ( string -- ) H{ } styled-text ;
: text ( string -- ) f styled-text ;
! Inset section
TUPLE: inset < block narrow? ;
: <inset> ( narrow? -- block )
H{ } inset new-block
inset new-block
2 >>overhang
swap >>narrow? ;
@ -257,7 +250,7 @@ M: inset newline-after? drop t ;
TUPLE: flow < block ;
: <flow> ( -- block )
H{ } flow new-block ;
flow new-block ;
M: flow short-section? ( section -- ? )
#! If we can make room for this entire block by inserting
@ -274,7 +267,7 @@ M: flow short-section? ( section -- ? )
TUPLE: colon < block ;
: <colon> ( -- block )
H{ } colon new-block ;
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 )
H{ } clone [
2 <hashtable> [
[ 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 [
hard add-line-break
add-line-break
\ INSTANCE: pprint-word pprint-word pprint-word
] with each block> block> ;