1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
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.2
|
