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" } }
|
{ $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 } "." } ;
|
{ $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?
|
HELP: section-fits?
|
||||||
{ $values { "section" section } { "?" boolean } }
|
{ $values { "section" section } { "?" boolean } }
|
||||||
{ $contract "Tests if a section fits in the space that remains on the current line." } ;
|
{ $contract "Tests if a section fits in the space that remains on the current line." } ;
|
||||||
|
@ -110,8 +102,7 @@ HELP: pprint-section
|
||||||
$prettyprinting-note ;
|
$prettyprinting-note ;
|
||||||
|
|
||||||
HELP: line-break
|
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, breaks introduce unconditional newlines." }
|
||||||
{ $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 ;
|
$prettyprinting-note ;
|
||||||
|
|
||||||
HELP: block
|
HELP: block
|
||||||
|
|
|
@ -63,12 +63,6 @@ M: maybe vocabulary-name
|
||||||
margin get
|
margin get
|
||||||
[ drop t ] [ [ pprinter get indent>> + ] dip <= ] if-zero ;
|
[ drop t ] [ [ pprinter get indent>> + ] dip <= ] if-zero ;
|
||||||
|
|
||||||
! break only if position margin 2 / >
|
|
||||||
SYMBOL: soft
|
|
||||||
|
|
||||||
! always breaks
|
|
||||||
SYMBOL: hard
|
|
||||||
|
|
||||||
! Section protocol
|
! Section protocol
|
||||||
GENERIC: section-fits? ( section -- ? )
|
GENERIC: section-fits? ( section -- ? )
|
||||||
|
|
||||||
|
@ -92,9 +86,11 @@ style overhang ;
|
||||||
|
|
||||||
: new-section ( length class -- section )
|
: new-section ( length class -- section )
|
||||||
new
|
new
|
||||||
position get >>start
|
position [
|
||||||
swap position [ + ] change
|
[ >>start ] keep
|
||||||
position get >>end
|
swapd +
|
||||||
|
[ >>end ] keep
|
||||||
|
] change
|
||||||
0 >>overhang ; inline
|
0 >>overhang ; inline
|
||||||
|
|
||||||
M: section section-fits? ( section -- ? )
|
M: section section-fits? ( section -- ? )
|
||||||
|
@ -144,9 +140,8 @@ M: object short-section? section-fits? ;
|
||||||
! Break section
|
! Break section
|
||||||
TUPLE: line-break < section type ;
|
TUPLE: line-break < section type ;
|
||||||
|
|
||||||
: <line-break> ( type -- section )
|
: <line-break> ( -- section )
|
||||||
0 line-break new-section
|
0 line-break new-section ;
|
||||||
swap >>type ;
|
|
||||||
|
|
||||||
M: line-break short-section drop ;
|
M: line-break short-section drop ;
|
||||||
|
|
||||||
|
@ -155,13 +150,13 @@ M: line-break long-section drop ;
|
||||||
! Block sections
|
! Block sections
|
||||||
TUPLE: block < section sections ;
|
TUPLE: block < section sections ;
|
||||||
|
|
||||||
: new-block ( style class -- block )
|
: new-block ( class -- block )
|
||||||
0 swap new-section
|
0 swap new-section
|
||||||
V{ } clone >>sections
|
V{ } clone >>sections ; inline
|
||||||
swap >>style ; inline
|
|
||||||
|
|
||||||
: <block> ( style -- block )
|
: <block> ( style -- block )
|
||||||
block new-block ;
|
block new-block
|
||||||
|
swap >>style ;
|
||||||
|
|
||||||
: pprinter-block ( -- block ) pprinter-stack get last ;
|
: pprinter-block ( -- block ) pprinter-stack get last ;
|
||||||
|
|
||||||
|
@ -184,7 +179,7 @@ TUPLE: block < section sections ;
|
||||||
[ short-section? ]
|
[ short-section? ]
|
||||||
} 1&& [ bl ] when ;
|
} 1&& [ bl ] when ;
|
||||||
|
|
||||||
: add-line-break ( type -- ) [ <line-break> add-section ] when* ;
|
: add-line-break ( -- ) <line-break> add-section ;
|
||||||
|
|
||||||
M: block section-fits? ( section -- ? )
|
M: block section-fits? ( section -- ? )
|
||||||
line-limit? [ drop t ] [ call-next-method ] if ;
|
line-limit? [ drop t ] [ call-next-method ] if ;
|
||||||
|
@ -200,10 +195,8 @@ M: block short-section ( block -- )
|
||||||
[ advance ] pprint-sections ;
|
[ advance ] pprint-sections ;
|
||||||
|
|
||||||
: do-break ( break -- )
|
: do-break ( break -- )
|
||||||
[ ]
|
dup end>> pprinter get last-newline>> - margin get 2/ >
|
||||||
[ type>> hard eq? ]
|
[ <fresh-line ] [ drop ] if ;
|
||||||
[ end>> pprinter get last-newline>> - margin get 2/ > ] tri
|
|
||||||
or [ <fresh-line ] [ drop ] if ;
|
|
||||||
|
|
||||||
: empty-block? ( block -- ? ) sections>> empty? ;
|
: empty-block? ( block -- ? ) sections>> empty? ;
|
||||||
|
|
||||||
|
@ -230,13 +223,13 @@ M: text-section long-section short-section ;
|
||||||
|
|
||||||
: styled-text ( string style -- ) <text> add-section ;
|
: styled-text ( string style -- ) <text> add-section ;
|
||||||
|
|
||||||
: text ( string -- ) H{ } styled-text ;
|
: text ( string -- ) f styled-text ;
|
||||||
|
|
||||||
! Inset section
|
! Inset section
|
||||||
TUPLE: inset < block narrow? ;
|
TUPLE: inset < block narrow? ;
|
||||||
|
|
||||||
: <inset> ( narrow? -- block )
|
: <inset> ( narrow? -- block )
|
||||||
H{ } inset new-block
|
inset new-block
|
||||||
2 >>overhang
|
2 >>overhang
|
||||||
swap >>narrow? ;
|
swap >>narrow? ;
|
||||||
|
|
||||||
|
@ -257,7 +250,7 @@ M: inset newline-after? drop t ;
|
||||||
TUPLE: flow < block ;
|
TUPLE: flow < block ;
|
||||||
|
|
||||||
: <flow> ( -- block )
|
: <flow> ( -- block )
|
||||||
H{ } flow new-block ;
|
flow new-block ;
|
||||||
|
|
||||||
M: flow short-section? ( section -- ? )
|
M: flow short-section? ( section -- ? )
|
||||||
#! If we can make room for this entire block by inserting
|
#! If we can make room for this entire block by inserting
|
||||||
|
@ -274,7 +267,7 @@ M: flow short-section? ( section -- ? )
|
||||||
TUPLE: colon < block ;
|
TUPLE: colon < block ;
|
||||||
|
|
||||||
: <colon> ( -- block )
|
: <colon> ( -- block )
|
||||||
H{ } colon new-block ;
|
colon new-block ;
|
||||||
|
|
||||||
M: colon long-section short-section ;
|
M: colon long-section short-section ;
|
||||||
|
|
||||||
|
|
|
@ -32,7 +32,7 @@ M: highlighted-word word-style
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
||||||
: colored-presentation-style ( obj color -- style )
|
: colored-presentation-style ( obj color -- style )
|
||||||
H{ } clone [
|
2 <hashtable> [
|
||||||
[ presented foreground ] dip
|
[ presented foreground ] dip
|
||||||
[ set-at ] curry bi-curry@ bi*
|
[ set-at ] curry bi-curry@ bi*
|
||||||
] keep ;
|
] keep ;
|
||||||
|
@ -53,4 +53,4 @@ H{
|
||||||
} stack-effect-style set-global
|
} stack-effect-style set-global
|
||||||
|
|
||||||
: effect-style ( effect -- style )
|
: 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
|
<block \ MIXIN: pprint-word
|
||||||
dup pprint-word <block
|
dup pprint-word <block
|
||||||
dup members [
|
dup members [
|
||||||
hard add-line-break
|
add-line-break
|
||||||
\ INSTANCE: pprint-word pprint-word pprint-word
|
\ INSTANCE: pprint-word pprint-word pprint-word
|
||||||
] with each block> block> ;
|
] with each block> block> ;
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue