help.markup: new logic for preventing accidental double blank lines

$subsections emits a blank line after the final link so that subsequent span text is nicely spaced away from the group of links. Prior to this bug fix, if you were to put a $heading immediately after a $subsections element, there would be 2 blank lines between them. This fixes it so that there is only a single blank line between them.

I also added a bunch of unit tests for span, block, $heading and $nl layout interactions.

diff --git a/basis/help/markup/markup-tests.factor b/basis/help/markup/markup-tests.factor
index 93bed37a5580c197dccfe48b4cebee2c981cb364..2e986c60d21dabc51f76f65ffdc8765dfd9a16fe 100644 (file)
--- a/basis/help/markup/markup-tests.factor
+++ b/basis/help/markup/markup-tests.factor
@@ -26,3 +26,46 @@ TUPLE: blahblah quux ;
 [ "a string, a fixnum, or an integer" ]
 [ [ { $or string fixnum integer } print-element ] with-string-writer ] unit-test
 
+! Layout
+
+[ "span" ]
+[ [ { "span" } print-content ] with-string-writer ] unit-test
+
+[ "span1span2" ]
+[ [ { "span1" "span2" } print-content ] with-string-writer ] unit-test
+
+[ "span1\n\nspan2" ]
+[ [ { "span1" { $nl } "span2" } print-content ] with-string-writer ] unit-test
+
+[ "\nspan" ]
+[ [ { { $nl } "span" } print-content ] with-string-writer ] unit-test
+
+[ "2 2 +\nspan" ]
+[ [ { { $code "2 2 +" } "span" } print-content ] with-string-writer ] unit-test
+
+[ "2 2 +" ]
+[ [ { { $code "2 2 +" } } print-content ] with-string-writer ] unit-test
+
+[ "span\n2 2 +" ]
+[ [ { "span" { $code "2 2 +" } } print-content ] with-string-writer ] unit-test
+
+[ "\n2 2 +" ]
+[ [ { { $nl } { $code "2 2 +" } } print-content ] with-string-writer ] unit-test
+
+[ "span\n\n2 2 +" ]
+[ [ { "span" { $nl } { $code "2 2 +" } } print-content ] with-string-writer ] unit-test
+
+[ "Heading" ]
+[ [ { { $heading "Heading" } } print-content ] with-string-writer ] unit-test
+
+[ "Heading1\n\nHeading2" ]
+[ [ { { $heading "Heading1" } { $heading "Heading2" } } print-content ] with-string-writer ] unit-test
+
+[ "span\n\nHeading" ]
+[ [ { "span" { $heading "Heading" } } print-content ] with-string-writer ] unit-test
+
+[ "\nHeading" ]
+[ [ { { $nl } { $heading "Heading" } } print-content ] with-string-writer ] unit-test
+
+[ "span\n\nHeading" ]
+[ [ { "span" { $nl } { $heading "Heading" } } print-content ] with-string-writer ] unit-test

diff --git a/basis/help/markup/markup.factor b/basis/help/markup/markup.factor
index 678d55df612d13d5612f101daa1dd06c7bebfadd..d0cfb675a7f86a87a4f0cf534f529733f1911a7a 100644 (file)
--- a/basis/help/markup/markup.factor
+++ b/basis/help/markup/markup.factor
@@ -15,9 +15,16 @@ PREDICATE: simple-element < array
 SYMBOL: last-element
 SYMBOL: span
 SYMBOL: block
+SYMBOL: blank-line
 
 : last-span? ( -- ? ) last-element get span eq? ;
 : last-block? ( -- ? ) last-element get block eq? ;
+: last-blank-line? ( -- ? ) last-element get blank-line eq? ;
+
+: ?nl ( -- )
+    last-element get
+    last-blank-line? not
+    and [ nl ] when ;
 
 : ($span) ( quot -- )
     last-block? [ nl ] when
@@ -45,7 +52,7 @@ M: f print-element drop ;
     [ print-element ] with-default-style ;
 
 : ($block) ( quot -- )
-    last-element get [ nl ] when
+    ?nl
     span last-element set
     call
     block last-element set ; inline
@@ -71,11 +78,12 @@ ALIAS: $slot $snippet
     ] ($span) ;
 
 : $nl ( children -- )
-    nl last-block? [ nl ] unless drop ;
+    drop nl last-element get [ nl ] when
+    blank-line last-element set ;
 
 ! Some blocks
 : ($heading) ( children quot -- )
-    last-element get [ nl ] when ($block) ; inline
+    ?nl ($block) ; inline
 
 : $heading ( element -- )
     [ heading-style get print-element* ] ($heading) ;
@@ -212,7 +220,7 @@ PRIVATE>
     ] ($subsection) ;
 
 : $subsections ( children -- )
-    [ $subsection* ] each nl ;
+    [ $subsection* ] each nl nl blank-line last-element set ;
 
 : $subsection ( element -- )
     first $subsection* ;