1# -*- tcl -*- 2# 3# Copyright (c) 2005 by Andreas Kupries <andreas_kupries@users.sourceforge.net> 4# Parser Generator / (Un)quoting characters. 5 6# ### ### ### ######### ######### ######### 7## Requisites 8 9namespace eval ::page::util::quote { 10 namespace export unquote \ 11 quote'tcl quote'tclstr quote'tclcom 12} 13 14# ### ### ### ######### ######### ######### 15## API 16 17proc ::page::util::quote::unquote {ch} { 18 # A character, as stored in the grammar tree 19 # by the frontend is transformed into a proper 20 # Tcl character (internal representation). 21 22 switch -exact -- $ch { 23 "\\n" {return \n} 24 "\\t" {return \t} 25 "\\r" {return \r} 26 "\\[" {return \[} 27 "\\]" {return \]} 28 "\\'" {return '} 29 "\\\"" {return "\""} 30 "\\\\" {return \\} 31 } 32 33 if {[regexp {^\\([0-2][0-7][0-7])$} $ch -> ocode]} { 34 return [format %c $ocode] 35 } elseif {[regexp {^\\([0-7][0-7]?)$} $ch -> ocode]} { 36 return [format %c 0$ocode] 37 } elseif {[regexp {^\\u([0-9a-fA-F][0-9a-fA-F]?[0-9a-fA-F]?[0-9a-fA-F]?)$} $ch -> hcode]} { 38 return [format %c 0x$hcode] 39 } 40 41 return $ch 42} 43 44proc ::page::util::quote::quote'tcl {ch} { 45 # Converts a Tcl character (internal representation) 46 # into a string which is accepted by the Tcl parser, 47 # will regenerate the character in question and is 48 # 7bit ASCII. 'quoted' is a boolean flag and set if 49 # the returned representation is a \-quoted form. 50 # Because they have to be treated specially when 51 # creating a list containing the reperesentation. 52 53 # Special characters 54 55 switch -exact -- $ch { 56 "\n" {return "\\n"} 57 "\r" {return "\\r"} 58 "\t" {return "\\t"} 59 "\\" - "\;" - 60 " " - "\"" - 61 "(" - ")" - 62 "\{" - "\}" - 63 "\[" - "\]" { 64 # Quote space and all the brackets as well, using octal, 65 # for easy impure list-ness. 66 67 scan $ch %c chcode 68 return \\[format %o $chcode] 69 } 70 } 71 72 scan $ch %c chcode 73 74 # Control characters: Octal 75 if {[string is control -strict $ch]} { 76 return \\[format %o $chcode] 77 } 78 79 # Beyond 7-bit ASCII: Unicode 80 81 if {$chcode > 127} { 82 return \\u[format %04x $chcode] 83 } 84 85 # Regular character: Is its own representation. 86 87 return $ch 88} 89 90proc ::page::util::quote::quote'tclstr {ch} { 91 # Converts a Tcl character (internal representation) 92 # into a string which is accepted by the Tcl parser and will 93 # generate a human readable representation of the character in 94 # question, one which when puts to a channel describes the 95 # character without using any unprintable characters. It may use 96 # \-quoting. High utf characters are quoted to avoid problem with 97 # the still prevalent ascii terminals. It is assumed that the 98 # string will be used in a ""-quoted environment. 99 100 # Special characters 101 102 switch -exact -- $ch { 103 " " {return "<blank>"} 104 "\n" {return "\\\\n"} 105 "\r" {return "\\\\r"} 106 "\t" {return "\\\\t"} 107 "\"" - "\\" - "\;" - 108 "(" - ")" - 109 "\{" - "\}" - 110 "\[" - "\]" { 111 return \\$ch 112 } 113 } 114 115 scan $ch %c chcode 116 117 # Control characters: Octal 118 if {[string is control -strict $ch]} { 119 return \\\\[format %o $chcode] 120 } 121 122 # Beyond 7-bit ASCII: Unicode 123 124 if {$chcode > 127} { 125 return \\\\u[format %04x $chcode] 126 } 127 128 # Regular character: Is its own representation. 129 130 return $ch 131} 132 133proc ::page::util::quote::quote'tclcom {ch} { 134 # Converts a Tcl character (internal representation) 135 # into a string which is accepted by the Tcl parser when used 136 # within a Tcl comment. 137 138 # Special characters 139 140 switch -exact -- $ch { 141 " " {return "<blank>"} 142 "\n" {return "\\n"} 143 "\r" {return "\\r"} 144 "\t" {return "\\t"} 145 "\"" - 146 "\{" - "\}" - 147 "(" - ")" { 148 return \\$ch 149 } 150 } 151 152 scan $ch %c chcode 153 154 # Control characters: Octal 155 if {[string is control -strict $ch]} { 156 return \\[format %o $chcode] 157 } 158 159 # Beyond 7-bit ASCII: Unicode 160 161 if {$chcode > 127} { 162 return \\u[format %04x $chcode] 163 } 164 165 # Regular character: Is its own representation. 166 167 return $ch 168} 169 170# ### ### ### ######### ######### ######### 171## Ready 172 173package provide page::util::quote 0.1 174