factor: escape more char:

locals-and-roots
Doug Coleman 2016-06-27 21:49:21 -07:00
parent 6903949936
commit b72db611f1
15 changed files with 47 additions and 47 deletions

View File

@ -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' )
{

View File

@ -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 = [^']

View File

@ -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 ;

View File

@ -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 ;

View File

@ -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 )

View File

@ -15,8 +15,8 @@ PRIVATE<
: printable? ( ch -- ? )
{
[ char: \s char: < between? ]
[ char: > char: ~ between? ]
[ char: \s char: \< between? ]
[ char: \> char: \~ between? ]
[ char: \t = ]
} 1|| ;

View File

@ -10,11 +10,11 @@ IN: html.entities
PRIVATE<
CONSTANT: html-escapes {
{ char: & "&amp;" }
{ char: < "&lt;" }
{ char: > "&gt;" }
{ char: \& "&amp;" }
{ char: \< "&lt;" }
{ char: \> "&gt;" }
{ char: \" "&quot;" }
{ char: ' "&#39;" }
{ char: \' "&#39;" }
} ;
: next-escape ( seq -- i elt )

View File

@ -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 ;

View File

@ -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 ;

View File

@ -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 ] }

View File

@ -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

View File

@ -6,17 +6,17 @@ IN: xml.entities
CONSTANT: entities-out
H{
{ char: < "&lt;" }
{ char: > "&gt;" }
{ char: & "&amp;" }
{ char: \< "&lt;" }
{ char: \> "&gt;" }
{ char: \& "&amp;" }
} ;
CONSTANT: quoted-entities-out
H{
{ char: & "&amp;" }
{ char: ' "&apos;" }
{ char: \& "&amp;" }
{ char: \' "&apos;" }
{ char: \" "&quot;" }
{ char: < "&lt;" }
{ char: \< "&lt;" }
} ;
: 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: \" }
} ;

View File

@ -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 ;

View File

@ -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 ;

View File

@ -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 }