prettyprint: remove { soft hard } line-break types (only ever used hard), cleanup.
parent
d2ab2e6dd1
commit
cf0cec0ecd
|
@ -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
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
|
|
|
@ -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! ;
|
||||
|
|
|
@ -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> ;
|
||||
|
||||
|
|
Loading…
Reference in New Issue