From 947793673a6578a623ff61d7285b408bc39dee00 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Fri, 3 Aug 2018 11:31:07 -0400
Subject: [PATCH] modern: Save whitespace...seems to just work?

---
 extra/modern/modern.factor        | 10 ++++++++--
 extra/modern/slices/slices.factor | 15 +++++++++++++++
 2 files changed, 23 insertions(+), 2 deletions(-)

diff --git a/extra/modern/modern.factor b/extra/modern/modern.factor
index f79b169651..a0741158b6 100644
--- a/extra/modern/modern.factor
+++ b/extra/modern/modern.factor
@@ -358,10 +358,16 @@ DEFER: lex-factor-top*
 ! Advance the index and read again!
 
 : read-token-or-whitespace-top ( n string slice -- n' string slice/f )
-    dup length 0 = [ [ 1 + ] 2dip drop lex-factor-top ] when ;
+    dup length 0 = [
+        ! [ 1 + ] 2dip drop lex-factor-top
+        merge-slice-til-non-whitespace
+    ] when ;
 
 : read-token-or-whitespace-nested ( n string slice -- n' string slice/f )
-    dup length 0 = [ [ 1 + ] 2dip drop lex-factor-nested ] when ;
+    dup length 0 = [
+        ! [ 1 + ] 2dip drop lex-factor-nested
+        merge-slice-til-non-whitespace
+    ] when ;
 
 : lex-factor-fallthrough ( n/f string slice/f ch/f -- n'/f string literal )
     {
diff --git a/extra/modern/slices/slices.factor b/extra/modern/slices/slices.factor
index 7ea107119f..7891760000 100644
--- a/extra/modern/slices/slices.factor
+++ b/extra/modern/slices/slices.factor
@@ -82,6 +82,16 @@ ERROR: unexpected-end n string ;
         f string f f
     ] if ; inline
 
+:: slice-til-non-whitespace ( n string -- n' string slice/f ch/f )
+    n [
+        n string [ "\s\r\n" member? not ] find-from :> ( n' ch )
+        n' string
+        n n' string ?<slice>
+        ch
+    ] [
+        f string f f
+    ] if ; inline
+
 :: (slice-until) ( n string quot -- n' string slice/f ch/f )
     n string quot find-from :> ( n' ch )
     n' string
@@ -135,6 +145,11 @@ ERROR: unexpected-end n string ;
         [ slice-til-whitespace drop ] dip merge-slices
     ] when ;
 
+: merge-slice-til-non-whitespace ( n string slice --  n' string slice' )
+    pick [
+        [ slice-til-non-whitespace drop ] dip merge-slices
+    ] when ;
+
 : merge-slice-til-eol ( n string slice --  n' string slice' )
     [ slice-til-eol drop ] dip merge-slices ;