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

This reverts commit cf0cec0ecdfdab5619d10e9d98c89254c519ed46.

diff --git a/basis/prettyprint/sections/sections-docs.factor b/basis/prettyprint/sections/sections-docs.factor
index 3d42dfa12785705104fb79a9b95742d8b31757eb..54384d9dda4021b29e3e1a6f0329994471ec81c4 100644 (file)
--- a/basis/prettyprint/sections/sections-docs.factor
+++ b/basis/prettyprint/sections/sections-docs.factor
@@ -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

diff --git a/basis/prettyprint/sections/sections.factor b/basis/prettyprint/sections/sections.factor
index 7ae9c661d32835eea989f673d6b5454f05e0b35b..80630e3c65f7280db24f9a8187346756000979ae 100644 (file)
--- a/basis/prettyprint/sections/sections.factor
+++ b/basis/prettyprint/sections/sections.factor
@@ -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 ;
 

diff --git a/basis/prettyprint/stylesheet/stylesheet.factor b/basis/prettyprint/stylesheet/stylesheet.factor
index dd56e34723d465fd45c9b27f96d1eded1d805fdf..f19c34db2aaf89f1ce6779b40f97a854c415e3ff 100644 (file)
--- a/basis/prettyprint/stylesheet/stylesheet.factor
+++ b/basis/prettyprint/stylesheet/stylesheet.factor
@@ -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 ;

diff --git a/basis/see/see.factor b/basis/see/see.factor
index bfbd5fb6cb5447d595f9d1cd825402466f8694cc..e543ca46bb8d1fa19b84872e7b078cc1ad6dcc34 100644 (file)
--- a/basis/see/see.factor
+++ b/basis/see/see.factor
@@ -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> ;