steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

modern: Disable <foo> matching.

modern-harvey2
Doug Coleman 2018-03-18 18:27:49 -05:00
parent df20fb9ddb
commit 5d66a88b0d
1 changed files with 11 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
extra/modern/modern.factor
View File

@ -280,16 +280,19 @@ ERROR: colon-word-must-be-all-uppercase-or-lowercase n string word ;
[ ] [ ]
} cond ; } cond ;
: read-acute ( n string slice -- n' string acute ) : read-acute-html ( n string slice -- n' string acute )
{ {
! <FOO <FOO:
{ [ dup section-open? ] [ { [ dup section-open? ] [
[ [
matching-section-delimiter 1array lex-until matching-section-delimiter 1array lex-until
] keep swap unclip-last 3array ] keep swap unclip-last 3array
] } ] }
! <foo/>
{ [ dup html-self-close? ] [ { [ dup html-self-close? ] [
! do nothing special ! do nothing special
] } ] }
! <foo>
{ [ dup html-full-open? ] [ { [ dup html-full-open? ] [
dup [ dup [
rest-slice rest-slice
@ -297,6 +300,7 @@ ERROR: colon-word-must-be-all-uppercase-or-lowercase n string word ;
"</" ">" surround 1array lex-until unclip-last "</" ">" surround 1array lex-until unclip-last
] dip -rot 3array ] dip -rot 3array
] } ] }
! <foo
{ [ dup html-half-open? ] [ { [ dup html-half-open? ] [
! n seq slice ! n seq slice
[ { ">" "/>" } lex-until ] dip [ { ">" "/>" } lex-until ] dip
@ -309,13 +313,16 @@ ERROR: colon-word-must-be-all-uppercase-or-lowercase n string word ;
swap unclip-last 3array swap unclip-last 3array
] if ] if
] } ] }
! </foo>
{ [ dup html-close? ] [ { [ dup html-close? ] [
! Do nothing ! Do nothing
] } ] }
[ [ slice-til-whitespace drop ] dip span-slices ] [ [ slice-til-whitespace drop ] dip span-slices ]
} cond ; } cond ;
: read-acute ( n string slice -- n' string acute )
[ matching-section-delimiter 1array lex-until ] keep swap unclip-last 3array ;
! Words like append! and suffix! are allowed for now. ! Words like append! and suffix! are allowed for now.
: read-exclamation ( n string slice -- n' string obj ) : read-exclamation ( n string slice -- n' string obj )
dup { [ "!" sequence= ] [ "#!" sequence= ] } 1|| dup { [ "!" sequence= ] [ "#!" sequence= ] } 1||
@ -424,7 +431,8 @@ DEFER: lex-factor-top*
! if we are in a FOO: and we hit a <BAR or <BAR: ! if we are in a FOO: and we hit a <BAR or <BAR:
! then end the FOO: ! then end the FOO:
[ slice-til-whitespace drop ] dip span-slices [ slice-til-whitespace drop ] dip span-slices
read-acute ! read-acute-html
dup section-open? [ read-acute ] when
] } ] }
{ char: \s [ read-token-or-whitespace-top ] } { char: \s [ read-token-or-whitespace-top ] }