]> gitweb.factorcode.org Git - factor.git/commitdiff
modern.html: Add comment support. peek-from -> peek1-from
authorDoug Coleman <doug.coleman@gmail.com>
Sun, 11 Apr 2021 23:34:38 +0000 (18:34 -0500)
committerDoug Coleman <doug.coleman@gmail.com>
Sun, 11 Apr 2021 23:34:55 +0000 (18:34 -0500)
extra/modern/html/html-tests.factor
extra/modern/html/html.factor
extra/modern/modern.factor
extra/modern/slices/slices.factor

index 1df6fbb52bcf0af77c833a31c5540554473fd7fb..0399c6bda6960ffcfeadeaa7b8567217173f3db9 100644 (file)
@@ -29,4 +29,7 @@ IN: modern.html.tests
 
 [
     [[ <html><head>omg<body></body></html>]] string>html html>string
-] [ unmatched-open-tags-error? ] must-fail-with
\ No newline at end of file
+] [ unmatched-open-tags-error? ] must-fail-with
+
+{ [[ <!-- omg omg -->]] }
+[ [[ <!-- omg omg -->]] string>html html>string ] unit-test
\ No newline at end of file
index f55a3ca7b8968133e910a1e882a9746845e4876c..59e7514dc0d339c3bd70cdd937215c21be17d1fc 100644 (file)
@@ -14,6 +14,13 @@ TUPLE: doctype open close values ;
         swap >string >>close
         swap >string >>open ;
 
+TUPLE: comment open payload close ;
+: <comment> ( open payload close -- comment )
+    comment new
+        swap >>close
+        swap >>payload
+        swap >>open ;
+
 TUPLE: close-tag name ;
 : <close-tag> ( name -- tag )
     close-tag new
@@ -99,10 +106,16 @@ C: <dquote> dquote
     [ 5 npick push ] when*
     [ ] [ read-props ] if* ;
 
-: read-doctype ( n string opening -- n string doctype )
-    "!" expect-and-span "DOCTYPE" expect-and-span
-    [ V{ } clone -rot read-props ] dip
-    swap 5 nrot <doctype> ;
+: read-doctype ( n string opening -- n string doctype/comment )
+    "!" expect-and-span
+    2over 2 peek-from "--" sequence= [
+        "--" expect-and-span >string
+        [ "-->" slice-til-string [ >string ] bi@ ] dip -rot <comment>
+    ] [
+        "DOCTYPE" expect-and-span
+        [ V{ } clone -rot read-props ] dip
+        swap 5 nrot <doctype>
+    ] if ;
 
 : read-open-tag ( n string opening -- n' string tag )
     [ take-tag-name ] dip drop ! B span-slices
@@ -145,7 +158,7 @@ ERROR: unmatched-closing-tag-error stack tag ;
     skip-whitespace "<" slice-til-either {
         { CHAR: < [
             1 split-slice-back [ >string f like [ reach push ] when* ] dip
-            [ 2dup peek-from ] dip
+            [ 2dup peek1-from ] dip
             swap {
                 { CHAR: / [
                     read-close-tag reach over name>> find-last-open-tag unclip
@@ -195,6 +208,11 @@ M: self-close-tag write-html
         [ props>> write-props "/>" % ]
     } cleave ;
 
+M: comment write-html
+    [ open>> % ]
+    [ payload>> % ]
+    [ close>> % ] tri ;
+
 M: string write-html % ;
 
 : html>string ( sequence -- string )
index 41b28a57b55fc255e53c15dadab7593a6971f850..4c86e8cf6ccfc45d6109f508a0f7074f6cbd3152 100644 (file)
@@ -450,7 +450,7 @@ ERROR: compound-syntax-disallowed n seq obj ;
     dup length 1 > [ compound-syntax-disallowed ] when ;
 
 : check-compound-loop ( n/f string -- n/f string ? )
-    [ ] [ peek-from ] [ previous-from ] 2tri
+    [ ] [ peek1-from ] [ previous-from ] 2tri
     [ blank? ] bi@ or not ! no blanks between tokens
     pick and ; ! and a valid index
 
index 0f6bac43f2000491bb142324d19eec7c9a966a5e..3ed638c816b84869ee44d1699035948222410e77 100644 (file)
@@ -30,9 +30,12 @@ ERROR: unexpected-end n string ;
 : nth-check-eof ( n string -- nth )
     2dup ?nth [ 2nip ] [ unexpected-end ] if* ;
 
-: peek-from ( n/f string -- ch )
+: peek1-from ( n/f string -- ch )
     over [ ?nth ] [ 2drop f ] if ;
 
+: peek-from ( n/f string m -- string )
+    over [ [ swap tail-slice ] dip head-slice ] [ 3drop f ] if ;
+
 : previous-from ( n/f string -- ch )
     over [ [ 1 - ] dip ?nth ] [ 2drop f ] if ;