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