diff options
Diffstat (limited to 'tcllib/modules/page/util_quote.tcl')
| -rw-r--r-- | tcllib/modules/page/util_quote.tcl | 173 |
1 files changed, 173 insertions, 0 deletions
diff --git a/tcllib/modules/page/util_quote.tcl b/tcllib/modules/page/util_quote.tcl new file mode 100644 index 0000000..6c7b65e --- /dev/null +++ b/tcllib/modules/page/util_quote.tcl @@ -0,0 +1,173 @@ +# -*- tcl -*- +# +# Copyright (c) 2005 by Andreas Kupries <andreas_kupries@users.sourceforge.net> +# Parser Generator / (Un)quoting characters. + +# ### ### ### ######### ######### ######### +## Requisites + +namespace eval ::page::util::quote { + namespace export unquote \ + quote'tcl quote'tclstr quote'tclcom +} + +# ### ### ### ######### ######### ######### +## API + +proc ::page::util::quote::unquote {ch} { + # A character, as stored in the grammar tree + # by the frontend is transformed into a proper + # Tcl character (internal representation). + + switch -exact -- $ch { + "\\n" {return \n} + "\\t" {return \t} + "\\r" {return \r} + "\\[" {return \[} + "\\]" {return \]} + "\\'" {return '} + "\\\"" {return "\""} + "\\\\" {return \\} + } + + if {[regexp {^\\([0-2][0-7][0-7])$} $ch -> ocode]} { + return [format %c $ocode] + } elseif {[regexp {^\\([0-7][0-7]?)$} $ch -> ocode]} { + return [format %c 0$ocode] + } elseif {[regexp {^\\u([0-9a-fA-F][0-9a-fA-F]?[0-9a-fA-F]?[0-9a-fA-F]?)$} $ch -> hcode]} { + return [format %c 0x$hcode] + } + + return $ch +} + +proc ::page::util::quote::quote'tcl {ch} { + # Converts a Tcl character (internal representation) + # into a string which is accepted by the Tcl parser, + # will regenerate the character in question and is + # 7bit ASCII. 'quoted' is a boolean flag and set if + # the returned representation is a \-quoted form. + # Because they have to be treated specially when + # creating a list containing the reperesentation. + + # Special characters + + switch -exact -- $ch { + "\n" {return "\\n"} + "\r" {return "\\r"} + "\t" {return "\\t"} + "\\" - "\;" - + " " - "\"" - + "(" - ")" - + "\{" - "\}" - + "\[" - "\]" { + # Quote space and all the brackets as well, using octal, + # for easy impure list-ness. + + scan $ch %c chcode + return \\[format %o $chcode] + } + } + + scan $ch %c chcode + + # Control characters: Octal + if {[string is control -strict $ch]} { + return \\[format %o $chcode] + } + + # Beyond 7-bit ASCII: Unicode + + if {$chcode > 127} { + return \\u[format %04x $chcode] + } + + # Regular character: Is its own representation. + + return $ch +} + +proc ::page::util::quote::quote'tclstr {ch} { + # Converts a Tcl character (internal representation) + # into a string which is accepted by the Tcl parser and will + # generate a human readable representation of the character in + # question, one which when puts to a channel describes the + # character without using any unprintable characters. It may use + # \-quoting. High utf characters are quoted to avoid problem with + # the still prevalent ascii terminals. It is assumed that the + # string will be used in a ""-quoted environment. + + # Special characters + + switch -exact -- $ch { + " " {return "<blank>"} + "\n" {return "\\\\n"} + "\r" {return "\\\\r"} + "\t" {return "\\\\t"} + "\"" - "\\" - "\;" - + "(" - ")" - + "\{" - "\}" - + "\[" - "\]" { + return \\$ch + } + } + + scan $ch %c chcode + + # Control characters: Octal + if {[string is control -strict $ch]} { + return \\\\[format %o $chcode] + } + + # Beyond 7-bit ASCII: Unicode + + if {$chcode > 127} { + return \\\\u[format %04x $chcode] + } + + # Regular character: Is its own representation. + + return $ch +} + +proc ::page::util::quote::quote'tclcom {ch} { + # Converts a Tcl character (internal representation) + # into a string which is accepted by the Tcl parser when used + # within a Tcl comment. + + # Special characters + + switch -exact -- $ch { + " " {return "<blank>"} + "\n" {return "\\n"} + "\r" {return "\\r"} + "\t" {return "\\t"} + "\"" - + "\{" - "\}" - + "(" - ")" { + return \\$ch + } + } + + scan $ch %c chcode + + # Control characters: Octal + if {[string is control -strict $ch]} { + return \\[format %o $chcode] + } + + # Beyond 7-bit ASCII: Unicode + + if {$chcode > 127} { + return \\u[format %04x $chcode] + } + + # Regular character: Is its own representation. + + return $ch +} + +# ### ### ### ######### ######### ######### +## Ready + +package provide page::util::quote 0.1 |