factor: escape more char:
parent
6903949936
commit
b72db611f1
|
@ -128,7 +128,7 @@ M: array collapse-decorators
|
|||
dup [ length 2 - ] keep [ char: \: = ] find-last-from [ 1 + tail ] [ drop ] if ;
|
||||
|
||||
: scoped-less-than-name ( string -- string' )
|
||||
dup [ length 2 - ] keep [ char: < = ] find-last-from [ 1 + tail ] [ drop ] if ;
|
||||
dup [ length 2 - ] keep [ char: \< = ] find-last-from [ 1 + tail ] [ drop ] if ;
|
||||
|
||||
: trim-top-level ( string -- string' )
|
||||
{
|
||||
|
|
|
@ -63,7 +63,7 @@ Exponent = "e" => [[ char: e ]] (OptionalMinus DecimalIntegerLiteral)?
|
|||
|
||||
CharacterLiteral = "$" Character:c => [[ c ]]
|
||||
|
||||
StringLiteral = "'" (StringLiteralCharacter | "''" => [[ char: ' ]])*:s "'"
|
||||
StringLiteral = "'" (StringLiteralCharacter | "''" => [[ char: \' ]])*:s "'"
|
||||
=> [[ s >string ]]
|
||||
StringLiteralCharacter = [^']
|
||||
|
||||
|
|
|
@ -11,7 +11,7 @@ M: real smalltalk>string number>string ;
|
|||
M: string smalltalk>string
|
||||
[
|
||||
"'" %
|
||||
[ dup char: ' = [ dup , , ] [ , ] if ] each
|
||||
[ dup char: \' = [ dup , , ] [ , ] if ] each
|
||||
"'" %
|
||||
] "" make ;
|
||||
|
||||
|
|
|
@ -382,7 +382,7 @@ M: x11-ui-backend beep ( -- )
|
|||
|
||||
PRIVATE<
|
||||
: escape-' ( string -- string' )
|
||||
[ dup char: ' = [ drop "'\\''" ] [ 1string ] if ] { } map-as concat ;
|
||||
[ dup char: \' = [ drop "'\\''" ] [ 1string ] if ] { } map-as concat ;
|
||||
|
||||
: xmessage ( string -- )
|
||||
escape-' "/usr/bin/env xmessage '" "'" surround system drop ;
|
||||
|
|
|
@ -116,7 +116,7 @@ C: <ebnf> ebnf ;
|
|||
[ "\"\\" member? ] satisfy 2seq ,
|
||||
[ char: \" = not ] satisfy ,
|
||||
] choice* repeat1 "\"" "\"" surrounded-by ,
|
||||
[ char: ' = not ] satisfy repeat1 "'" "'" surrounded-by ,
|
||||
[ char: \' = not ] satisfy repeat1 "'" "'" surrounded-by ,
|
||||
] choice* [ "" flatten-as unescape-string ] action ;
|
||||
|
||||
: non-terminal-parser ( -- parser )
|
||||
|
|
|
@ -15,8 +15,8 @@ PRIVATE<
|
|||
|
||||
: printable? ( ch -- ? )
|
||||
{
|
||||
[ char: \s char: < between? ]
|
||||
[ char: > char: ~ between? ]
|
||||
[ char: \s char: \< between? ]
|
||||
[ char: \> char: \~ between? ]
|
||||
[ char: \t = ]
|
||||
} 1|| ;
|
||||
|
||||
|
|
|
@ -10,11 +10,11 @@ IN: html.entities
|
|||
PRIVATE<
|
||||
|
||||
CONSTANT: html-escapes {
|
||||
{ char: & "&" }
|
||||
{ char: < "<" }
|
||||
{ char: > ">" }
|
||||
{ char: \& "&" }
|
||||
{ char: \< "<" }
|
||||
{ char: \> ">" }
|
||||
{ char: \" """ }
|
||||
{ char: ' "'" }
|
||||
{ char: \' "'" }
|
||||
} ;
|
||||
|
||||
: next-escape ( seq -- i elt )
|
||||
|
|
|
@ -40,18 +40,18 @@ SYMBOL: tagstack
|
|||
$[ [ current _ = ] take-until ] [ advance drop ] bi ;
|
||||
|
||||
: read-single-quote ( sequence-parser -- string )
|
||||
char: ' (read-quote) ;
|
||||
char: \' (read-quote) ;
|
||||
|
||||
: read-double-quote ( sequence-parser -- string )
|
||||
char: \" (read-quote) ;
|
||||
|
||||
: read-quote ( sequence-parser -- string )
|
||||
dup get+increment char: ' =
|
||||
dup get+increment char: \' =
|
||||
[ read-single-quote ] [ read-double-quote ] if ;
|
||||
|
||||
: read-key ( sequence-parser -- string )
|
||||
skip-whitespace
|
||||
[ current { [ char: = = ] [ blank? ] } 1|| ] take-until ;
|
||||
[ current { [ char: \= = ] [ blank? ] } 1|| ] take-until ;
|
||||
|
||||
: read-token ( sequence-parser -- string )
|
||||
[ current blank? ] take-until ;
|
||||
|
@ -70,17 +70,17 @@ SYMBOL: tagstack
|
|||
[ advance drop ] bi ;
|
||||
|
||||
: read-bang ( sequence-parser -- )
|
||||
advance dup { [ current char: - = ] [ peek-next char: - = ] } 1&&
|
||||
advance dup { [ current char: \- = ] [ peek-next char: \- = ] } 1&&
|
||||
[ advance advance read-comment ] [ read-dtd ] if ;
|
||||
|
||||
: read-tag ( sequence-parser -- string )
|
||||
[
|
||||
[ current "><" member? ] take-until
|
||||
[ char: / = ] trim-tail
|
||||
] [ dup current char: < = [ advance ] unless drop ] bi ;
|
||||
[ char: \/ = ] trim-tail
|
||||
] [ dup current char: \< = [ advance ] unless drop ] bi ;
|
||||
|
||||
: read-until-< ( sequence-parser -- string )
|
||||
[ current char: < = ] take-until ;
|
||||
[ current char: \< = ] take-until ;
|
||||
|
||||
: parse-text ( sequence-parser -- )
|
||||
read-until-< [ text new-tag push-tag ] unless-empty ;
|
||||
|
|
|
@ -11,7 +11,7 @@ IN: html.parser.utils
|
|||
: double-quote ( str -- newstr ) "\"" dup surround ;
|
||||
|
||||
: quote ( str -- newstr )
|
||||
char: ' over member?
|
||||
char: \' over member?
|
||||
[ double-quote ] [ single-quote ] if ;
|
||||
|
||||
: ?quote ( str -- newstr ) dup quoted? [ quote ] unless ;
|
||||
|
|
|
@ -52,7 +52,7 @@ IN: xml.autoencoding
|
|||
! What if first letter of processing instruction is non-ASCII?
|
||||
get-next {
|
||||
{ 0 [ next next start-utf16le ] }
|
||||
{ char: ? [ go-utf8 instruct dup instruct-encoding ] }
|
||||
{ char: \? [ go-utf8 instruct dup instruct-encoding ] }
|
||||
{ char: \! [ go-utf8 direct ] }
|
||||
[ check start<name ]
|
||||
} case ;
|
||||
|
@ -75,7 +75,7 @@ IN: xml.autoencoding
|
|||
|
||||
: start-document ( -- tag )
|
||||
get-char {
|
||||
{ char: < [ start< ] }
|
||||
{ char: \< [ start< ] }
|
||||
{ 0 [ start-utf16be ] }
|
||||
{ 0xEF [ skip-utf8-bom ] }
|
||||
{ 0xFF [ skip-utf16le-bom ] }
|
||||
|
|
|
@ -23,7 +23,7 @@ UNION: dtd-acceptable
|
|||
: take-entity-def ( var -- entity-name entity-def )
|
||||
[
|
||||
take-word pass-blank get-char {
|
||||
{ char: ' [ parse-quote ] }
|
||||
{ char: \' [ parse-quote ] }
|
||||
{ char: \" [ parse-quote ] }
|
||||
[ drop take-external-id close ]
|
||||
} case
|
||||
|
|
|
@ -6,17 +6,17 @@ IN: xml.entities
|
|||
|
||||
CONSTANT: entities-out
|
||||
H{
|
||||
{ char: < "<" }
|
||||
{ char: > ">" }
|
||||
{ char: & "&" }
|
||||
{ char: \< "<" }
|
||||
{ char: \> ">" }
|
||||
{ char: \& "&" }
|
||||
} ;
|
||||
|
||||
CONSTANT: quoted-entities-out
|
||||
H{
|
||||
{ char: & "&" }
|
||||
{ char: ' "'" }
|
||||
{ char: \& "&" }
|
||||
{ char: \' "'" }
|
||||
{ char: \" """ }
|
||||
{ char: < "<" }
|
||||
{ char: \< "<" }
|
||||
} ;
|
||||
|
||||
: escape-string-by ( str table -- escaped )
|
||||
|
@ -31,10 +31,10 @@ CONSTANT: quoted-entities-out
|
|||
|
||||
CONSTANT: entities
|
||||
H{
|
||||
{ "lt" char: < }
|
||||
{ "gt" char: > }
|
||||
{ "amp" char: & }
|
||||
{ "apos" char: ' }
|
||||
{ "lt" char: \< }
|
||||
{ "gt" char: \> }
|
||||
{ "amp" char: \& }
|
||||
{ "apos" char: \' }
|
||||
{ "quot" char: \" }
|
||||
} ;
|
||||
|
||||
|
|
|
@ -48,7 +48,7 @@ PRIVATE>
|
|||
PRIVATE<
|
||||
|
||||
: write-quoted ( string -- )
|
||||
char: " write1 write char: " write1 ;
|
||||
char: \" write1 write char: \" write1 ;
|
||||
|
||||
: print-attrs ( assoc -- )
|
||||
[
|
||||
|
@ -70,7 +70,7 @@ M: string write-xml
|
|||
] when write ;
|
||||
|
||||
: write-tag ( tag -- )
|
||||
?indent char: < write1
|
||||
?indent char: \< write1
|
||||
dup print-name attrs>> print-attrs ;
|
||||
|
||||
: write-start-tag ( tag -- )
|
||||
|
@ -84,7 +84,7 @@ M: contained-tag write-xml
|
|||
[ write-xml ] each unindent ;
|
||||
|
||||
: write-end-tag ( tag -- )
|
||||
?indent "</" write print-name char: > write1 ;
|
||||
?indent "</" write print-name char: \> write1 ;
|
||||
|
||||
M: open-tag write-xml
|
||||
xml-pprint? get [
|
||||
|
@ -148,7 +148,7 @@ M: doctype-decl write-xml
|
|||
">" write ;
|
||||
|
||||
M: directive write-xml
|
||||
"<!" write text>> write char: > write1 nl ;
|
||||
"<!" write text>> write char: \> write1 nl ;
|
||||
|
||||
M: instruction write-xml
|
||||
"<?" write text>> write "?>" write ;
|
||||
|
|
|
@ -16,18 +16,18 @@ IN: help.html
|
|||
dup ascii? [
|
||||
dup H{
|
||||
{ char: \" "__quo__" }
|
||||
{ char: * "__star__" }
|
||||
{ char: \* "__star__" }
|
||||
{ char: \: "__colon__" }
|
||||
{ char: < "__lt__" }
|
||||
{ char: > "__gt__" }
|
||||
{ char: ? "__que__" }
|
||||
{ char: \< "__lt__" }
|
||||
{ char: \> "__gt__" }
|
||||
{ char: \? "__que__" }
|
||||
{ char: \\ "__back__" }
|
||||
{ char: | "__pipe__" }
|
||||
{ char: / "__slash__" }
|
||||
{ char: , "__comma__" }
|
||||
{ char: @ "__at__" }
|
||||
{ char: # "__hash__" }
|
||||
{ char: % "__percent__" }
|
||||
{ char: \| "__pipe__" }
|
||||
{ char: \/ "__slash__" }
|
||||
{ char: \, "__comma__" }
|
||||
{ char: \@ "__at__" }
|
||||
{ char: \# "__hash__" }
|
||||
{ char: \% "__percent__" }
|
||||
} at [ % ] [ , ] ?if
|
||||
] [ number>string "__" "__" surround % ] if ;
|
||||
|
||||
|
|
|
@ -108,7 +108,7 @@ PRIVATE<
|
|||
|
||||
: lookup-type ( string -- object/string ? )
|
||||
"/f" ?tail swap
|
||||
"new" ?head drop [ { [ char: ' = ] [ digit? ] } 1|| ] trim-tail
|
||||
"new" ?head drop [ { [ char: \' = ] [ digit? ] } 1|| ] trim-tail
|
||||
H{
|
||||
{ "object" object }
|
||||
{ "obj" object }
|
||||
|
|
Loading…
Reference in New Issue