Revert "prettyprint: remove { soft hard } line-break types (only ever used hard), cleanup."
This reverts commit cf0cec0ecd.
			
			
				db4
			
			
		
							parent
							
								
									fb688cc08b
								
							
						
					
					
						commit
						2984496e04
					
				| 
						 | 
				
			
			@ -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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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 ;
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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 ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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> ;
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue