Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /eXene/trunk/styles/parse-resource-specs.sml
ViewVC logotype

Annotation of /eXene/trunk/styles/parse-resource-specs.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2098 - (view) (download)

1 : monnier 2 (* parse-resource-specs.sml
2 :     *
3 :     * COPYRIGHT (c) 1994 by AT&T Bell Laboratories. See COPYRIGHT file for details.
4 :     *
5 :     * Support for parsing X11 format resource specifications.
6 :     *)
7 :    
8 :     structure ParseResourceSpecs : sig
9 :    
10 :     type comp_name = Quark.quark
11 :     type attr_name = Quark.quark
12 :    
13 :     datatype component = Wild | Name of comp_name
14 :     (* a component is either "?" or a component name *)
15 :    
16 :     datatype binding = TIGHT | LOOSE
17 :    
18 :     datatype resource_spec
19 :     = NoSpec (* comment or blank line *)
20 :     | Incl of string (* "#include" directive *)
21 :     | RsrcSpec of {
22 :     loose : bool, (* true, if the spec has a leading "*" *)
23 :     path : (component * binding) list,
24 :     attr : attr_name, (* the attribute name *)
25 :     value : string, (* the value *)
26 :     ext : bool (* true, if the value extends onto the *)
27 :     (* next line *)
28 :     }
29 :    
30 :     (* this exception is raised, if the specification is ill-formed. The
31 :     * integer argument is the character position of the error.
32 :     *)
33 :     exception BadSpec of int
34 :    
35 :     val parseRsrcSpec : string -> resource_spec
36 :     (* decompose a resource specification string into a list
37 :     * of (component, binding) pairs, an attribute name, and
38 :     * an attribute value.
39 :     *)
40 :    
41 :     val parseValueExt : string -> (string * bool)
42 :     (* Parse a value extension, returning the extension and a boolean flag
43 :     * that will be true if there is a further extension of the value.
44 :     *)
45 :    
46 :     val parseStyleName : string -> comp_name list
47 :     (* Check and decompose a style name, which has the format:
48 :     *
49 :     * <StyleName> ::= <ComponentName> ("." <ComponentName>)*
50 :     *)
51 :    
52 :     val checkCompName : string -> comp_name
53 :     (* Check a component name *)
54 :    
55 :     val checkAttrName : string -> attr_name
56 :     (* Check an attribute name *)
57 :    
58 :     end = struct
59 :    
60 :     structure SS = Substring
61 :    
62 :     val maxChar = 255
63 :    
64 :     datatype char_class
65 :     = Comment (* "!" *)
66 :     | Directive (* "#" *)
67 :     | TightBind (* "." *)
68 :     | LooseBind (* "*" *)
69 :     | WildComp (* "?" *)
70 :     | Space (* space or tab *)
71 :     | Colon (* ":" *)
72 :     | NameChar (* "A"-"Z", "a"-"z", "0"-"9", "-", "_" *)
73 :     | Eol (* newline *)
74 :     | Escape (* "\" *)
75 :     | NonPrt (* other non-printing characters *)
76 :     | Other (* other printing characters *)
77 :    
78 :     (* this table maps character ordinals to character classes *)
79 :     val ccMap = CharMap.mkCharMap {
80 :     default = NonPrt,
81 :     bindings = [
82 :     ("!", Comment),
83 :     ("#", Directive),
84 :     (".", TightBind),
85 :     ("*", LooseBind),
86 :     ("?", WildComp),
87 :     (" \t", Space),
88 :     (":", Colon),
89 :     ("ABCDEFGHIJKLMNOPQRSTUVWXYZ\
90 :     \abcdefghijklmnopqrstuvwxyz\
91 :     \0123456789-_", NameChar),
92 :     ("\n", Eol),
93 :     ("\\", Escape),
94 :     ("\"$%&'()+,/;<=>@[]^`{|}~", Other)
95 :     ]
96 :     }
97 :     val mapChr = CharMap.mapStrChr ccMap
98 :    
99 :     (* get the class of the i'th character of a string *)
100 :     fun getCC (s, i) =
101 :     if (i < size s) then mapChr(s, i) else Eol
102 :    
103 :     (* skip white space *)
104 :     fun skipWS (s, i) = if (getCC(s, i) = Space) then skipWS(s, i+1) else i
105 :    
106 :     type comp_name = Quark.quark
107 :     type attr_name = Quark.quark
108 :    
109 :     datatype component = Wild | Name of comp_name
110 :    
111 :     datatype binding = TIGHT | LOOSE
112 :    
113 :     datatype resource_spec
114 :     = NoSpec (* comment or blank line *)
115 :     | Incl of string (* "#include" directive *)
116 :     | RsrcSpec of {
117 :     loose : bool, (* true, if the spec has a leading "*" *)
118 :     path : (component * binding) list,
119 :     attr : attr_name, (* the attribute name *)
120 :     value : string, (* the value *)
121 :     ext : bool (* true, if the value extends onto the *)
122 :     (* next line *)
123 :     }
124 :    
125 :     (* this exception is raised, if the specification is ill-formed. The
126 :     * integer argument is the character position of the error.
127 :     *)
128 :     exception BadSpec of int
129 :    
130 :     (* scan a component *)
131 :     fun scanComp (s, i) = (case getCC(s, i)
132 :     of WildComp => (Wild, i+1)
133 :     | NameChar => let
134 :     fun scan j = (case getCC(s, j)
135 :     of NameChar => scan(j+1)
136 :     | _ => j-i
137 :     (* end case *))
138 :     val len = scan (i+1)
139 :     in
140 :     (Name(Quark.quark(substring(s, i, len))), i+len)
141 :     end
142 :     | _ => raise (BadSpec i)
143 :     (* end case *))
144 :    
145 :     (* Scan a binding, which is a sequence of one or more "." and "*" characters.
146 :     * If any character in the binding is "*", then it is a loose binding,
147 :     * otherwise it is a TIGHT binding.
148 :     *)
149 :     fun scanBinding (s, i) = let
150 :     fun scan (s, i, bind) = (case getCC(s, i)
151 :     of LooseBind => scan (s, i+1, LOOSE)
152 :     | TightBind => scan (s, i+1, bind)
153 :     | _ => (bind, i)
154 :     (* end case *))
155 :     in
156 :     case getCC(s, i)
157 :     of LooseBind => scan (s, i+1, LOOSE)
158 :     | TightBind => scan (s, i+1, TIGHT)
159 :     | _ => raise (BadSpec i)
160 :     (* end case *)
161 :     end
162 :    
163 :     (* Scan a value, returning it as a string with a boolean extension
164 :     * flag. This recognizes and converts escape sequences as follows:
165 :     *
166 :     * \<space> ==> a space character
167 :     * \<tab> ==> a tab character
168 :     * \\ ==> a backslash character
169 :     * \n ==> a newline character
170 :     * \<newline> ==> ignore the newline; if the newline is the last
171 :     * character in the string, then the extension flag
172 :     * is true.
173 :     * \ddd ==> convert octal digits to character code.
174 :     *)
175 :     fun scanValue (s, i) = let
176 :     fun getOctal ss = let
177 :     val scan = Int.scan StringCvt.OCT SS.getc
178 :     fun isOct c = (#"0" <= c) andalso (c < #"8")
179 :     val (oct, rest) = SS.splitAt (ss, 3)
180 :     in
181 :     if isOct(SS.sub(oct, 0))
182 :     then (case (scan oct)
183 :     of SOME(n, r) =>
184 :     if (SS.isEmpty r)
185 :     then (String.str(Char.chr n), rest)
186 :     else raise BadSpec i
187 :     | NONE => raise BadSpec i
188 :     (* end case *))
189 :     else raise BadSpec i
190 :     end
191 :     handle _ => raise BadSpec i
192 :     fun finish (prefix, chunks) = SS.concat(List.rev(prefix::chunks))
193 :     fun scan (ss, chunks) = let
194 :     val (prefix, rest) =
195 :     SS.splitl (fn (#"\\" | #"\n") => false | _ => true) ss
196 : mblume 1862 fun add (c, rest) = scan (rest, (SS.full c)::prefix::chunks)
197 : monnier 2 in
198 :     case (SS.getc rest)
199 :     of NONE => (finish(prefix, chunks), false)
200 :     | SOME(#"\n", rest) => (finish(prefix, chunks), false)
201 :     | SOME(_, rest) => (case (SS.getc rest)
202 :     of NONE => (finish(prefix, chunks), true)
203 :     | (SOME(#"\t", rest)) => add("\t", rest)
204 :     | (SOME(#" ", rest)) => add(" ", rest)
205 :     | (SOME(#"\\", rest)) => add("\\", rest)
206 :     | (SOME(#"\n", rest)) => (case (SS.getc rest)
207 :     of (SOME _) => scan(rest, prefix::chunks)
208 :     | NONE => (finish(prefix, chunks), true)
209 :     (* end case *))
210 :     | (SOME(#"n", rest)) => add("\n", rest)
211 :     | (SOME _) => add(getOctal rest)
212 :     (* end case *))
213 :     (* end case *)
214 :     end
215 :     in
216 : mblume 1862 scan (SS.triml i (SS.full s), [])
217 : monnier 2 end
218 :    
219 :     (* decompose a resource specification string into a list
220 :     * of (component, binding) pairs, an attribute name, and
221 :     * an attribute value.
222 :     *)
223 :     fun parseRsrcSpec ln = let
224 :     val start = skipWS(ln, 0)
225 :     fun getCompBind (i, path) = let
226 :     val (comp, i) = scanComp (ln, i)
227 : jhr 704 fun getRest i = (case comp
228 :     of (Name attr) => (rev path, attr, skipWS(ln, i+1))
229 :     | Wild => raise (BadSpec i)
230 :     (* end case *))
231 : monnier 2 in
232 :     case (getCC (ln, i))
233 : jhr 704 of Colon => getRest i
234 :     | Space => let
235 :     val i = skipWS(ln, i+1)
236 :     in
237 :     case getCC(ln, i)
238 :     of Colon => getRest i
239 :     | _ => raise (BadSpec i)
240 :     (* end case *)
241 :     end
242 : monnier 2 | _ => let
243 :     val (bind, i) = scanBinding (ln, i)
244 :     in
245 :     getCompBind (i, (comp, bind)::path)
246 :     end
247 :     (* end case *)
248 :     end
249 :     in
250 :     case getCC(ln, start)
251 :     of (Eol | Comment) => NoSpec
252 :     | Directive => NoSpec (* fix *)
253 :     | (WildComp | NameChar) => let
254 :     val (path, attrName, valStart) = getCompBind(start, [])
255 :     val (value, ext) = scanValue (ln, valStart)
256 :     in
257 :     RsrcSpec{
258 :     loose = false, path = path,
259 :     attr = attrName, value = value,
260 :     ext = ext
261 :     }
262 :     end
263 :     | LooseBind => let
264 :     val (path, attrName, valStart) = getCompBind(start+1, [])
265 :     val (value, ext) = scanValue (ln, valStart)
266 :     in
267 :     RsrcSpec{
268 :     loose = true, path = path,
269 :     attr = attrName, value = value,
270 :     ext = ext
271 :     }
272 :     end
273 :     | _ => raise (BadSpec start)
274 :     (* end case *)
275 :     end (* parseRsrcSpec *)
276 :    
277 :     (* Parse a value extension, returning the extension and a boolean flag
278 :     * that will be true if there is a further extension of the value.
279 :     *)
280 :     fun parseValueExt ln = scanValue (ln, 0)
281 :    
282 :     (* Check and decompose a style name, which has the format:
283 :     *
284 :     * <StyleName> ::= <ComponentName> ("." <ComponentName>)*
285 :     *)
286 :     fun parseStyleName s = let
287 :     val len = size s
288 :     fun scanCompName i = (case scanComp(s, i)
289 :     of (Name name, j) => (name, j)
290 :     | _ => raise (BadSpec i)
291 :     (* end case *))
292 :     fun scan (i, comps) = if (i < len)
293 :     then (case (mapChr(s, i))
294 :     of TightBind => let
295 :     val (name, i) = scanCompName(i+1)
296 :     in
297 :     scan(i, name::comps)
298 :     end
299 :     | _ => raise (BadSpec i)
300 :     (* end case *))
301 :     else rev comps
302 :     val (name, i) = scanCompName 0
303 :     in
304 :     scan (i, [name])
305 :     end
306 :    
307 :     (* Check a component name *)
308 :     fun checkCompName str = (case scanComp(str, 0)
309 :     of (Name name, _) => name
310 :     | _ => raise (BadSpec 0)
311 :     (* end case *))
312 :    
313 :     (* Check an attribute name *)
314 :     val checkAttrName = checkCompName
315 :    
316 :     end (* ParseResourceSpecs *)

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0