steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

prettyprint: keep the cleanup from the last commit without the removal of { soft hard }.

db4
John Benediktsson 2015-07-17 23:05:19 -07:00
parent 2984496e04
commit ac0828718f
2 changed files with 15 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
basis/prettyprint/sections/sections.factor
View File

@ -94,9 +94,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 -- ? )
@ -157,13 +159,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 ;
@ -232,13 +234,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? ;
@ -259,7 +261,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
@ -276,7 +278,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 ;

4
basis/prettyprint/stylesheet/stylesheet.factor
View File

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