[
[[ <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
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
[ 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
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
[ props>> write-props "/>" % ]
} cleave ;
+M: comment write-html
+ [ open>> % ]
+ [ payload>> % ]
+ [ close>> % ] tri ;
+
M: string write-html % ;
: html>string ( sequence -- string )
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
: 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 ;