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 /sml/trunk/src/smlnj-lib/HTML/html-attrs-fn.sml
ViewVC logotype

Annotation of /sml/trunk/src/smlnj-lib/HTML/html-attrs-fn.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2 - (view) (download)

1 : monnier 2 (* html-attrs-fn.sml
2 :     *
3 :     * COPYRIGHT (c) 1996 AT&T Research.
4 :     *
5 :     * This provides support for parsing element start tags.
6 :     *)
7 :    
8 :     functor HTMLAttrsFn (Err : HTML_ERROR) : HTML_ATTRS =
9 :     struct
10 :    
11 :     open HTMLAttrVals (* inherit types *)
12 :    
13 :     fun attrValToString (NAME s) = s
14 :     | attrValToString (STRING s) = s
15 :     | attrValToString IMPLICIT = ""
16 :    
17 :     datatype attr_ty
18 :     = AT_TEXT (* either a string or name value *)
19 :     | AT_NAMES of string list (* one of a list of names *)
20 :     | AT_NUMBER (* an integer attribute *)
21 :     | AT_IMPLICIT
22 :     | AT_INSTANCE (* if an attribute FOO has type AT_NAMES with *)
23 :     (* values BAR and BAZ, then BAR and BAZ are *)
24 :     (* legal attributes, being shorthand for *)
25 :     (* FOO=BAR and FOO=BAZ. We introduce an *)
26 :     (* (k, AT_INSTANCE) entry for BAR and BAZ, where *)
27 :     (* k is the slot that FOO has been assigned. *)
28 :    
29 :     type context = Err.context
30 :    
31 :     structure HTbl = HashTableFn (struct
32 :     type hash_key = string
33 :     val hashVal = HashString.hashString
34 :     val sameKey = (op = : (string * string) -> bool)
35 :     end)
36 :    
37 :     (* an attribute map (attr_map) is a map from attribute names to attribute
38 :     * value slots and types.
39 :     *)
40 :     abstype attr_map = AMap of {
41 :     numAttrs : int,
42 :     attrTbl : (int * attr_ty) HTbl.hash_table
43 :     }
44 :     and attr_vec = AVec of {
45 :     vec : attr_val option Array.array,
46 :     ctx : context
47 :     }
48 :     with
49 :     (* create an attr_map from the list of attribute names and types. *)
50 :     fun mkAttrs data = let
51 :     val n = length data
52 :     val tbl = HTbl.mkTable (n, Fail "Attrs")
53 :     fun ins ((name, ty), id) = (
54 :     HTbl.insert tbl (name, (id, ty));
55 :     case ty
56 :     of (AT_NAMES l) => let
57 :     fun ins' nm = if (nm <> name)
58 :     then HTbl.insert tbl (nm, (id, AT_INSTANCE))
59 :     else ()
60 :     in
61 :     List.app ins' l
62 :     end
63 :     | _ => ()
64 :     (* end case *);
65 :     id+1)
66 :     in
67 :     List.foldl ins 0 data;
68 :     AMap{numAttrs = n, attrTbl = tbl}
69 :     end
70 :     (* create an atttribute vector of attribute values using the attribute
71 :     * map to assign slots and typecheck the values.
72 :     *)
73 :     fun attrListToVec (ctx, AMap{numAttrs, attrTbl}, attrs) = let
74 :     val attrArray = Array.array (numAttrs, NONE)
75 :     fun update (_, NONE) = ()
76 :     | update (id, SOME v) = (case Array.sub(attrArray, id)
77 :     of NONE => Array.update(attrArray, id, SOME v)
78 :     | (SOME _) => (* ignore multiple attribute definition *) ()
79 :     (* end case *))
80 :     (* compare two names for case-insensitive equality, where the second
81 :     * name is known to be all uppercase.
82 :     *)
83 :     fun eqName name name' = let
84 :     fun cmpC (c1, c2) = Char.compare(Char.toUpper c1, c2)
85 :     in
86 :     (String.collate cmpC (name, name')) = EQUAL
87 :     end
88 :     fun ins (attrName, attrVal) = let
89 :     fun error () = (
90 :     Err.badAttrVal ctx (attrName, attrValToString attrVal);
91 :     NONE)
92 :     fun cvt (AT_IMPLICIT, IMPLICIT) = SOME IMPLICIT
93 :     | cvt (AT_INSTANCE, IMPLICIT) = SOME(NAME attrName)
94 :     | cvt (AT_TEXT, v) = SOME v
95 :     | cvt (AT_NUMBER, v) = SOME v
96 :     | cvt (AT_NAMES names, (NAME s | STRING s)) = (
97 :     case (List.find (eqName s) names)
98 :     of NONE => error()
99 :     | (SOME name) => SOME(NAME name)
100 :     (* end case *))
101 :     | cvt (AT_IMPLICIT, (NAME s | STRING s)) =
102 :     if (s = attrName)
103 :     then SOME IMPLICIT
104 :     else error()
105 :     | cvt _ = error()
106 :     in
107 :     case (HTbl.find attrTbl attrName)
108 :     of NONE => Err.unknownAttr ctx attrName
109 :     | (SOME(id, ty)) => update (id, cvt (ty, attrVal))
110 :     (* end case *)
111 :     end
112 :     in
113 :     List.app ins attrs;
114 :     AVec{vec = attrArray, ctx = ctx}
115 :     end
116 :     (* given an attribute map and attribute name, return a function that
117 :     * fetches a value from the attribute's slot in an attribute vector.
118 :     *)
119 :     fun bindFindAttr (AMap{attrTbl, ...}, attr) = let
120 :     val (id, _) = HTbl.lookup attrTbl attr
121 :     in
122 :     fn (AVec{vec, ...}) => Array.sub(vec, id)
123 :     end
124 :     (* return the context of the element that contains the attribute vector *)
125 :     fun getContext (AVec{ctx, ...}) = ctx
126 :     end (* abstype *)
127 :    
128 :     fun getFlag (attrMap, attr) = let
129 :     val getFn = bindFindAttr (attrMap, attr)
130 :     fun get attrVec = (case (getFn attrVec)
131 :     of NONE => false
132 :     | _ => true
133 :     (* end case *))
134 :     in
135 :     get
136 :     end
137 :     fun getCDATA (attrMap, attr) = let
138 :     val getFn = bindFindAttr (attrMap, attr)
139 :     fun get attrVec = (case (getFn attrVec)
140 :     of NONE => NONE
141 :     | (SOME((STRING s) | (NAME s))) => SOME s
142 :     | _ => (
143 :     Err.missingAttrVal (getContext attrVec) attr;
144 :     NONE)
145 :     (* end case *))
146 :     in
147 :     get
148 :     end
149 :     fun getNAMES fromString (attrMap, attr) = let
150 :     val getFn = bindFindAttr (attrMap, attr)
151 :     fun get attrVec = (case (getFn attrVec)
152 :     of NONE => NONE
153 :     | (SOME(NAME s)) => fromString s
154 :     | (SOME v) =>
155 :     (** This case should be impossible, since attrListToVec
156 :     ** ensures that AT_NAMES valued attributes are always NAME.
157 :     **)
158 :     raise Fail "getNAMES"
159 :     (* end case *))
160 :     in
161 :     get
162 :     end
163 :     fun getNUMBER (attrMap, attr) = let
164 :     val getFn = bindFindAttr (attrMap, attr)
165 :     fun get attrVec = (case (getFn attrVec)
166 :     of NONE => NONE
167 :     | (SOME((STRING s) | (NAME s))) => (case (Int.fromString s)
168 :     of NONE => (
169 :     Err.badAttrVal (getContext attrVec) (attr, s);
170 :     NONE)
171 :     | someN => someN
172 :     (* end case *))
173 :     (* end case *))
174 :     in
175 :     get
176 :     end
177 :     fun getChar (attrMap, attr) = let
178 :     val getFn = bindFindAttr (attrMap, attr)
179 :     fun get attrVec = (case (getFn attrVec)
180 :     of NONE => NONE
181 :     | (SOME((STRING s) | (NAME s))) =>
182 :     if (size s = 1) then SOME(String.sub(s, 0))
183 :     (** NOTE: we should probably accept &#xx; as a character value **)
184 :     else (
185 :     Err.badAttrVal (getContext attrVec) (attr, s);
186 :     NONE)
187 :     (* end case *))
188 :     in
189 :     get
190 :     end
191 :    
192 :     fun require (getFn, attrMap, attr, dflt) = let
193 :     val getFn = getFn (attrMap, attr)
194 :     fun get attrVec = (case getFn attrVec
195 :     of NONE => (Err.missingAttr (getContext attrVec) attr; dflt)
196 :     | (SOME v) => v
197 :     (* end case *))
198 :     in
199 :     get
200 :     end
201 :    
202 :     (**** Element ISINDEX ****)
203 :     local
204 :     val attrMap = mkAttrs [
205 :     ("PROMPT", AT_TEXT)
206 :     ]
207 :     val getPROMPT = getCDATA (attrMap, "PROMPT")
208 :     in
209 :     (* the ISINDEX element can occur in both the HEAD an BODY, so there are
210 :     * two datatype constructors for it. We just define the argument of the
211 :     * constructor here.
212 :     *)
213 :     fun mkISINDEX (ctx, attrs) = {
214 :     prompt = getPROMPT (attrListToVec(ctx, attrMap, attrs))
215 :     }
216 :     end (* local *)
217 :    
218 :     (**** Element BASE ****)
219 :     local
220 :     val attrMap = mkAttrs [
221 :     ("HREF", AT_TEXT)
222 :     ]
223 :     val getHREF = require (getCDATA, attrMap, "HREF", "")
224 :     in
225 :     fun mkBASE (ctx, attrs) = HTML.Head_BASE{
226 :     href = getHREF(attrListToVec(ctx, attrMap, attrs))
227 :     }
228 :     end (* local *)
229 :    
230 :     (**** Element META ****)
231 :     local
232 :     val attrMap = mkAttrs [
233 :     ("HTTP-EQUIV", AT_TEXT),
234 :     ("NAME", AT_TEXT),
235 :     ("CONTENT", AT_TEXT)
236 :     ]
237 :     val getHTTP_EQUIV = getCDATA (attrMap, "HTTP-EQUIV")
238 :     val getNAME = getCDATA (attrMap, "NAME")
239 :     val getCONTENT = require (getCDATA, attrMap, "CONTENT", "")
240 :     in
241 :     fun mkMETA (ctx, attrs) = let
242 :     val attrVec = attrListToVec(ctx, attrMap, attrs)
243 :     in
244 :     HTML.Head_META{
245 :     httpEquiv = getHTTP_EQUIV attrVec,
246 :     name = getNAME attrVec,
247 :     content = getCONTENT attrVec
248 :     }
249 :     end
250 :     end (* local *)
251 :    
252 :     (**** Element LINK ****)
253 :     local
254 :     val attrMap = mkAttrs [
255 :     ("HREF", AT_TEXT),
256 :     ("ID", AT_TEXT),
257 :     ("TITLE", AT_TEXT),
258 :     ("REL", AT_TEXT),
259 :     ("REV", AT_TEXT)
260 :     ]
261 :     val getHREF = getCDATA (attrMap, "HREF")
262 :     val getID = getCDATA (attrMap, "ID")
263 :     val getREL = getCDATA (attrMap, "REL")
264 :     val getREV = getCDATA (attrMap, "REV")
265 :     val getTITLE = getCDATA (attrMap, "TITLE")
266 :     in
267 :     fun mkLINK (ctx, attrs) = let
268 :     val attrVec = attrListToVec(ctx, attrMap, attrs)
269 :     in
270 :     HTML.Head_LINK{
271 :     href = getHREF attrVec,
272 :     id = getID attrVec,
273 :     rel = getREL attrVec,
274 :     rev = getREV attrVec,
275 :     title = getTITLE attrVec
276 :     }
277 :     end
278 :     end (* local *)
279 :    
280 :     (**** Elements H1, H2, H3, H4, H5, H6 and P ****)
281 :     local
282 :     val attrMap = mkAttrs [
283 :     ("ALIGN", AT_NAMES["LEFT", "CENTER", "RIGHT"])
284 :     ]
285 :     val getALIGN = getNAMES HTML.HAlign.fromString (attrMap, "ALIGN")
286 :     in
287 :     fun mkHn (n, ctx, attrs, text) = HTML.Hn{
288 :     n = n,
289 :     align = getALIGN(attrListToVec(ctx, attrMap, attrs)),
290 :     content = text
291 :     }
292 :     fun mkP (ctx, attrs, text) = HTML.P{
293 :     align = getALIGN(attrListToVec(ctx, attrMap, attrs)),
294 :     content = text
295 :     }
296 :     end (* local *)
297 :    
298 :     (**** Element UL ****)
299 :     local
300 :     val attrMap = mkAttrs [
301 :     ("COMPACT", AT_IMPLICIT),
302 :     ("TYPE", AT_NAMES["DISC", "SQUARE", "CIRCLE"])
303 :     ]
304 :     val getCOMPACT = getFlag(attrMap, "COMPACT")
305 :     val getTYPE = getNAMES HTML.ULStyle.fromString (attrMap, "TYPE")
306 :     in
307 :     fun mkUL (ctx, attrs, items) = let
308 :     val attrVec = attrListToVec(ctx, attrMap, attrs)
309 :     in
310 :     HTML.UL{
311 :     ty = getTYPE attrVec,
312 :     compact = getCOMPACT attrVec,
313 :     content = items
314 :     }
315 :     end
316 :     end (* local *)
317 :    
318 :     (**** Element OL ****)
319 :     local
320 :     val attrMap = mkAttrs [
321 :     ("COMPACT", AT_IMPLICIT),
322 :     ("START", AT_NUMBER),
323 :     ("TYPE", AT_TEXT)
324 :     ]
325 :     val getCOMPACT = getFlag(attrMap, "COMPACT")
326 :     val getSTART = getNUMBER(attrMap, "START")
327 :     val getTYPE = getCDATA(attrMap, "TYPE")
328 :     in
329 :     fun mkOL (ctx, attrs, items) = let
330 :     val attrVec = attrListToVec(ctx, attrMap, attrs)
331 :     in
332 :     HTML.OL{
333 :     compact = getCOMPACT attrVec,
334 :     start = getSTART attrVec,
335 :     ty = getTYPE attrVec,
336 :     content = items
337 :     }
338 :     end
339 :     end (* local *)
340 :    
341 :     (**** Elements DIR, MENU and DL ****)
342 :     local
343 :     val attrMap = mkAttrs [
344 :     ("COMPACT", AT_IMPLICIT)
345 :     ]
346 :     val getCOMPACT = getFlag(attrMap, "COMPACT")
347 :     in
348 :     fun mkDIR (ctx, attrs, items) = HTML.DIR{
349 :     compact = getCOMPACT (attrListToVec(ctx, attrMap, attrs)),
350 :     content = items
351 :     }
352 :     fun mkMENU (ctx, attrs, items) = HTML.MENU{
353 :     compact = getCOMPACT (attrListToVec(ctx, attrMap, attrs)),
354 :     content = items
355 :     }
356 :     fun mkDL (ctx, attrs, items) = HTML.DL{
357 :     compact = getCOMPACT (attrListToVec(ctx, attrMap, attrs)),
358 :     content = items
359 :     }
360 :     end (* local *)
361 :    
362 :     (**** Element LI ****)
363 :     local
364 :     val attrMap = mkAttrs [
365 :     ("TYPE", AT_TEXT),
366 :     ("VALUE", AT_NUMBER)
367 :     ]
368 :     val getTYPE = getCDATA(attrMap, "TYPE")
369 :     val getVALUE = getNUMBER(attrMap, "VALUE")
370 :     in
371 :     fun mkLI (ctx, attrs, text) = let
372 :     val attrVec = attrListToVec(ctx, attrMap, attrs)
373 :     in
374 :     HTML.LI{
375 :     ty = getTYPE attrVec,
376 :     value = getVALUE attrVec,
377 :     content = text
378 :     }
379 :     end
380 :     end (* local *)
381 :    
382 :     (**** Element PRE ****)
383 :     local
384 :     val attrMap = mkAttrs [
385 :     ("WIDTH", AT_NUMBER)
386 :     ]
387 :     val getWIDTH = getNUMBER(attrMap, "WIDTH")
388 :     in
389 :     fun mkPRE (ctx, attrs, text) = HTML.PRE{
390 :     width = getWIDTH (attrListToVec (ctx, attrMap, attrs)),
391 :     content = text
392 :     }
393 :     end (* local *)
394 :    
395 :     (**** Element DIV ****)
396 :     local
397 :     val attrMap = mkAttrs [
398 :     ("ALIGN", AT_NAMES["LEFT", "CENTER", "RIGHT"])
399 :     ]
400 :     val getALIGN = require (getNAMES HTML.HAlign.fromString,
401 :     attrMap, "ALIGN", HTML.HAlign.left)
402 :     in
403 :     fun mkDIV (ctx, attrs, content) = HTML.DIV{
404 :     align = getALIGN(attrListToVec(ctx, attrMap, attrs)),
405 :     content = content
406 :     }
407 :     end (* local *)
408 :    
409 :     (**** Element FORM ****)
410 :     local
411 :     val attrMap = mkAttrs [
412 :     ("ACTION", AT_TEXT),
413 :     ("METHOD", AT_NAMES["GET", "PUT"]),
414 :     ("ENCTYPE", AT_TEXT)
415 :     ]
416 :     val getACTION = getCDATA (attrMap, "ACTION")
417 :     val getMETHOD = require (getNAMES HTML.HttpMethod.fromString,
418 :     attrMap, "METHOD", HTML.HttpMethod.get)
419 :     val getENCTYPE = getCDATA (attrMap, "ENCTYPE")
420 :     in
421 :     fun mkFORM (ctx, attrs, contents) = let
422 :     val attrVec = attrListToVec(ctx, attrMap, attrs)
423 :     in
424 :     HTML.FORM{
425 :     action = getACTION attrVec,
426 :     method = getMETHOD attrVec,
427 :     enctype = getENCTYPE attrVec,
428 :     content = contents
429 :     }
430 :     end
431 :     end (* local *)
432 :    
433 :     (**** Element HR ****)
434 :     local
435 :     val attrMap = mkAttrs [
436 :     ("ALIGN", AT_NAMES["LEFT", "CENTER", "RIGHT"]),
437 :     ("NOSHADE", AT_IMPLICIT),
438 :     ("SIZE", AT_TEXT),
439 :     ("WIDTH", AT_TEXT)
440 :     ]
441 :     val getALIGN = getNAMES HTML.HAlign.fromString (attrMap, "ALIGN")
442 :     val getNOSHADE = getFlag (attrMap, "NOSHADE")
443 :     val getSIZE = getCDATA (attrMap, "SIZE")
444 :     val getWIDTH = getCDATA (attrMap, "WIDTH")
445 :     in
446 :     fun mkHR (ctx, attrs) = let
447 :     val attrVec = attrListToVec(ctx, attrMap, attrs)
448 :     in
449 :     HTML.HR{
450 :     align = getALIGN attrVec,
451 :     noshade = getNOSHADE attrVec,
452 :     size = getSIZE attrVec,
453 :     width = getWIDTH attrVec
454 :     }
455 :     end
456 :     end (* local *)
457 :    
458 :     (**** Element TABLE ****)
459 :     local
460 :     val attrMap = mkAttrs [
461 :     ("ALIGN", AT_NAMES["LEFT", "CENTER", "RIGHT"]),
462 :     ("BORDER", AT_TEXT),
463 :     ("CELLSPACING", AT_TEXT),
464 :     ("CELLPADDING", AT_TEXT),
465 :     ("WIDTH", AT_TEXT)
466 :     ]
467 :     val getALIGN = getNAMES HTML.HAlign.fromString (attrMap, "ALIGN")
468 :     val getBORDER = getCDATA (attrMap, "BORDER")
469 :     val getCELLSPACING = getCDATA (attrMap, "CELLSPACING")
470 :     val getCELLPADDING = getCDATA (attrMap, "CELLPADDING")
471 :     val getWIDTH = getCDATA (attrMap, "WIDTH")
472 :     in
473 :     fun mkTABLE (ctx, attrs, {caption, body}) = let
474 :     val attrVec = attrListToVec(ctx, attrMap, attrs)
475 :     in
476 :     HTML.TABLE{
477 :     align = getALIGN attrVec,
478 :     border = getBORDER attrVec,
479 :     cellspacing = getCELLSPACING attrVec,
480 :     cellpadding = getCELLPADDING attrVec,
481 :     width = getWIDTH attrVec,
482 :     caption = caption,
483 :     content = body
484 :     }
485 :     end
486 :     end (* local *)
487 :    
488 :     (**** Element CAPTION ****)
489 :     local
490 :     val attrMap = mkAttrs [
491 :     ("ALIGN", AT_NAMES["TOP", "BOTTOM"])
492 :     ]
493 :     val getALIGN = getNAMES HTML.CaptionAlign.fromString (attrMap, "ALIGN")
494 :     in
495 :     fun mkCAPTION (ctx, attrs, text) = HTML.CAPTION{
496 :     align = getALIGN(attrListToVec(ctx, attrMap, attrs)),
497 :     content = text
498 :     }
499 :     end (* local *)
500 :    
501 :     (**** Element TR ****)
502 :     local
503 :     val attrMap = mkAttrs [
504 :     ("ALIGN", AT_NAMES["LEFT", "CENTER", "RIGHT"]),
505 :     ("VALIGN", AT_NAMES["TOP", "MIDDLE", "BOTTOM", "BASELINE"])
506 :     ]
507 :     val getALIGN = getNAMES HTML.HAlign.fromString (attrMap, "ALIGN")
508 :     val getVALIGN = getNAMES HTML.CellVAlign.fromString (attrMap, "VALIGN")
509 :     in
510 :     fun mkTR (ctx, attrs, cells) = let
511 :     val attrVec = attrListToVec(ctx, attrMap, attrs)
512 :     in
513 :     HTML.TR{
514 :     align = getALIGN attrVec,
515 :     valign = getVALIGN attrVec,
516 :     content = cells
517 :     }
518 :     end
519 :     end (* local *)
520 :    
521 :     (**** Elements TH and TD ****)
522 :     local
523 :     val attrMap = mkAttrs [
524 :     ("ALIGN", AT_NAMES["LEFT", "CENTER", "RIGHT"]),
525 :     ("COLSPAN", AT_NUMBER),
526 :     ("HEIGHT", AT_TEXT),
527 :     ("NOWRAP", AT_IMPLICIT),
528 :     ("ROWSPAN", AT_NUMBER),
529 :     ("VALIGN", AT_NAMES["TOP", "MIDDLE", "BOTTOM", "BASELINE"]),
530 :     ("WIDTH", AT_TEXT)
531 :     ]
532 :     val getALIGN = getNAMES HTML.HAlign.fromString (attrMap, "ALIGN")
533 :     val getCOLSPAN = getNUMBER (attrMap, "COLSPAN")
534 :     val getHEIGHT = getCDATA (attrMap, "HEIGHT")
535 :     val getNOWRAP = getFlag (attrMap, "NOWRAP")
536 :     val getROWSPAN = getNUMBER (attrMap, "ROWSPAN")
537 :     val getVALIGN = getNAMES HTML.CellVAlign.fromString (attrMap, "VALIGN")
538 :     val getWIDTH = getCDATA (attrMap, "WIDTH")
539 :     fun mkCell (ctx, attrs, cells) = let
540 :     val attrVec = attrListToVec(ctx, attrMap, attrs)
541 :     in
542 :     { align = getALIGN attrVec,
543 :     colspan = getCOLSPAN attrVec,
544 :     height = getHEIGHT attrVec,
545 :     nowrap = getNOWRAP attrVec,
546 :     rowspan = getROWSPAN attrVec,
547 :     valign = getVALIGN attrVec,
548 :     width = getWIDTH attrVec,
549 :     content = cells
550 :     }
551 :     end
552 :     in
553 :     fun mkTH arg = HTML.TH(mkCell arg)
554 :     fun mkTD arg = HTML.TD(mkCell arg)
555 :     end (* local *)
556 :    
557 :     (**** Element A ****)
558 :     local
559 :     val attrMap = mkAttrs [
560 :     ("HREF", AT_TEXT),
561 :     ("NAME", AT_TEXT),
562 :     ("REL", AT_TEXT),
563 :     ("REV", AT_TEXT),
564 :     ("TITLE", AT_TEXT)
565 :     ]
566 :     val getHREF = getCDATA (attrMap, "HREF")
567 :     val getNAME = getCDATA (attrMap, "NAME")
568 :     val getREL = getCDATA (attrMap, "REL")
569 :     val getREV = getCDATA (attrMap, "REV")
570 :     val getTITLE = getCDATA (attrMap, "TITLE")
571 :     in
572 :     fun mkA (ctx, attrs, contents) = let
573 :     val attrVec = attrListToVec(ctx, attrMap, attrs)
574 :     in
575 :     HTML.A{
576 :     name = getNAME attrVec,
577 :     href = getHREF attrVec,
578 :     rel = getREL attrVec,
579 :     rev = getREV attrVec,
580 :     title = getTITLE attrVec,
581 :     content = contents
582 :     }
583 :     end
584 :     end (* local *)
585 :    
586 :     (**** Element IMG ****)
587 :     local
588 :     val attrMap = mkAttrs [
589 :     ("ALIGN", AT_NAMES["TOP", "MIDDLE", "BOTTOM", "LEFT", "RIGHT"]),
590 :     ("ALT", AT_TEXT),
591 :     ("BORDER", AT_TEXT),
592 :     ("HEIGHT", AT_TEXT),
593 :     ("HSPACE", AT_TEXT),
594 :     ("ISMAP", AT_IMPLICIT),
595 :     ("SRC", AT_TEXT),
596 :     ("USEMAP", AT_TEXT),
597 :     ("VSPACE", AT_TEXT),
598 :     ("WIDTH", AT_TEXT)
599 :     ]
600 :     val getALIGN = getNAMES HTML.IAlign.fromString (attrMap, "ALIGN")
601 :     val getALT = getCDATA (attrMap, "ALT")
602 :     val getBORDER = getCDATA (attrMap, "BORDER")
603 :     val getHEIGHT = getCDATA (attrMap, "HEIGHT")
604 :     val getHSPACE = getCDATA (attrMap, "HSPACE")
605 :     val getISMAP = getFlag (attrMap, "ISMAP")
606 :     val getSRC = require (getCDATA, attrMap, "SRC", "")
607 :     val getUSEMAP = getCDATA (attrMap, "USEMAP")
608 :     val getVSPACE = getCDATA (attrMap, "VSPACE")
609 :     val getWIDTH = getCDATA (attrMap, "WIDTH")
610 :     in
611 :     fun mkIMG (ctx, attrs) = let
612 :     val attrVec = attrListToVec(ctx, attrMap, attrs)
613 :     in
614 :     HTML.IMG{
615 :     src = getSRC attrVec,
616 :     alt = getALT attrVec,
617 :     align = getALIGN attrVec,
618 :     height = getHEIGHT attrVec,
619 :     width = getWIDTH attrVec,
620 :     border = getBORDER attrVec,
621 :     hspace = getHSPACE attrVec,
622 :     vspace = getVSPACE attrVec,
623 :     usemap = getUSEMAP attrVec,
624 :     ismap = getISMAP attrVec
625 :     }
626 :     end
627 :     end (* local *)
628 :    
629 :     (**** Element APPLET ****)
630 :     local
631 :     val attrMap = mkAttrs [
632 :     ("ALIGN", AT_NAMES["TOP", "MIDDLE", "BOTTOM", "LEFT", "RIGHT"]),
633 :     ("ALT", AT_TEXT),
634 :     ("CODE", AT_TEXT),
635 :     ("CODEBASE", AT_TEXT),
636 :     ("HEIGHT", AT_TEXT),
637 :     ("HSPACE", AT_TEXT),
638 :     ("NAME", AT_TEXT),
639 :     ("VSPACE", AT_TEXT),
640 :     ("WIDTH", AT_TEXT)
641 :     ]
642 :     val getALIGN = getNAMES HTML.IAlign.fromString (attrMap, "ALIGN")
643 :     val getALT = getCDATA (attrMap, "ALT")
644 :     val getCODE = require (getCDATA, attrMap, "CODE", "")
645 :     val getCODEBASE = getCDATA (attrMap, "CODEBASE")
646 :     val getHEIGHT = getCDATA (attrMap, "HEIGHT")
647 :     val getHSPACE = getCDATA (attrMap, "HSPACE")
648 :     val getNAME = getCDATA (attrMap, "NAME")
649 :     val getVSPACE = getCDATA (attrMap, "VSPACE")
650 :     val getWIDTH = getCDATA (attrMap, "WIDTH")
651 :     in
652 :     fun mkAPPLET (ctx, attrs, content) = let
653 :     val attrVec = attrListToVec(ctx, attrMap, attrs)
654 :     in
655 :     HTML.APPLET{
656 :     codebase = getCODEBASE attrVec,
657 :     code = getCODE attrVec,
658 :     name = getNAME attrVec,
659 :     alt = getALT attrVec,
660 :     align = getALIGN attrVec,
661 :     height = getHEIGHT attrVec,
662 :     width = getWIDTH attrVec,
663 :     hspace = getHSPACE attrVec,
664 :     vspace = getVSPACE attrVec,
665 :     content = content
666 :     }
667 :     end
668 :     end (* local *)
669 :    
670 :     (**** Element PARAM ****)
671 :     local
672 :     val attrMap = mkAttrs [
673 :     ("NAME", AT_TEXT),
674 :     ("VALUE", AT_TEXT)
675 :     ]
676 :     val getNAME = require (getCDATA, attrMap, "NAME", "")
677 :     val getVALUE = getCDATA (attrMap, "VALUE")
678 :     in
679 :     fun mkPARAM (ctx, attrs) = let
680 :     val attrVec = attrListToVec(ctx, attrMap, attrs)
681 :     in
682 :     HTML.PARAM{
683 :     name = getNAME attrVec,
684 :     value = getVALUE attrVec
685 :     }
686 :     end
687 :     end (* local *)
688 :    
689 :     (**** Element FONT ****)
690 :     local
691 :     val attrMap = mkAttrs [
692 :     ("COLOR", AT_TEXT),
693 :     ("SIZE", AT_TEXT)
694 :     ]
695 :     val getCOLOR = getCDATA (attrMap, "COLOR")
696 :     val getSIZE = getCDATA (attrMap, "SIZE")
697 :     in
698 :     fun mkFONT (ctx, attrs, content) = let
699 :     val attrVec = attrListToVec(ctx, attrMap, attrs)
700 :     in
701 :     HTML.FONT{
702 :     size = getSIZE attrVec,
703 :     color = getCOLOR attrVec,
704 :     content = content
705 :     }
706 :     end
707 :     end (* local *)
708 :    
709 :     (**** Element BASEFONT ****)
710 :     local
711 :     val attrMap = mkAttrs [
712 :     ("SIZE", AT_TEXT)
713 :     ]
714 :     val getSIZE = getCDATA (attrMap, "SIZE")
715 :     in
716 :     fun mkBASEFONT (ctx, attrs, content) = HTML.BASEFONT{
717 :     size = getSIZE(attrListToVec(ctx, attrMap, attrs)),
718 :     content = content
719 :     }
720 :     end (* local *)
721 :    
722 :     (**** Element BR ****)
723 :     local
724 :     val attrMap = mkAttrs [
725 :     ("CLEAR", AT_NAMES["LEFT", "RIGHT", "ALL", "NONE"])
726 :     ]
727 :     val getCLEAR = getNAMES HTML.TextFlowCtl.fromString (attrMap, "CLEAR")
728 :     in
729 :     fun mkBR (ctx, attrs) = HTML.BR{
730 :     clear = getCLEAR(attrListToVec(ctx, attrMap, attrs))
731 :     }
732 :     end (* local *)
733 :    
734 :     (**** Element MAP ****)
735 :     local
736 :     val attrMap = mkAttrs [
737 :     ("NAME", AT_TEXT)
738 :     ]
739 :     val getNAME = getCDATA (attrMap, "NAME")
740 :     in
741 :     fun mkMAP (ctx, attrs, content) = HTML.MAP{
742 :     name = getNAME (attrListToVec(ctx, attrMap, attrs)),
743 :     content = content
744 :     }
745 :     end (* local *)
746 :    
747 :     (**** Element INPUT ****)
748 :     local
749 :     val attrMap = mkAttrs [
750 :     ("ALIGN", AT_NAMES["TOP", "MIDDLE", "BOTTOM", "LEFT", "RIGHT"]),
751 :     ("CHECKED", AT_IMPLICIT),
752 :     ("MAXLENGTH", AT_NUMBER),
753 :     ("NAME", AT_TEXT),
754 :     ("SIZE", AT_TEXT),
755 :     ("SRC", AT_TEXT),
756 :     ("TYPE", AT_NAMES[
757 :     "TEXT", "PASSWORD", "CHECKBOX",
758 :     "RADIO", "SUBMIT", "RESET",
759 :     "FILE", "HIDDEN", "IMAGE"
760 :     ]),
761 :     ("VALUE", AT_TEXT)
762 :     ]
763 :     val getALIGN = getNAMES HTML.IAlign.fromString (attrMap, "ALIGN")
764 :     val getCHECKED = getFlag (attrMap, "CHECKED")
765 :     val getMAXLENGTH = getNUMBER (attrMap, "MAXLENGTH")
766 :     val getNAME = getCDATA (attrMap, "NAME")
767 :     val getSIZE = getCDATA (attrMap, "SIZE")
768 :     val getSRC = getCDATA (attrMap, "SRC")
769 :     val getTYPE = getNAMES HTML.InputType.fromString (attrMap, "TYPE")
770 :     val getVALUE = getCDATA (attrMap, "VALUE")
771 :     in
772 :     fun mkINPUT (ctx, attrs) = let
773 :     val attrVec = attrListToVec(ctx, attrMap, attrs)
774 :     in
775 :     HTML.INPUT{
776 :     ty = getTYPE attrVec,
777 :     name = getNAME attrVec,
778 :     value = getVALUE attrVec,
779 :     src = getSRC attrVec,
780 :     checked = getCHECKED attrVec,
781 :     size = getSIZE attrVec,
782 :     maxlength = getMAXLENGTH attrVec,
783 :     align = getALIGN attrVec
784 :     }
785 :     end
786 :     end (* local *)
787 :    
788 :     (**** Element SELECT ****)
789 :     local
790 :     val attrMap = mkAttrs [
791 :     ("NAME", AT_TEXT),
792 :     ("SIZE", AT_TEXT)
793 :     ]
794 :     val getNAME = require (getCDATA, attrMap, "NAME", "")
795 :     val getSIZE = getNUMBER (attrMap, "SIZE")
796 :     in
797 :     fun mkSELECT (ctx, attrs, contents) = let
798 :     val attrVec = attrListToVec(ctx, attrMap, attrs)
799 :     in
800 :     HTML.SELECT{
801 :     name = getNAME attrVec,
802 :     size = getSIZE attrVec,
803 :     content = contents
804 :     }
805 :     end
806 :     end (* local *)
807 :    
808 :     (**** Element TEXTAREA ****)
809 :     local
810 :     val attrMap = mkAttrs [
811 :     ("NAME", AT_TEXT),
812 :     ("ROWS", AT_NUMBER),
813 :     ("COLS", AT_NUMBER)
814 :     ]
815 :     val getNAME = require (getCDATA, attrMap, "NAME", "")
816 :     val getROWS = require (getNUMBER, attrMap, "ROWS", 0)
817 :     val getCOLS = require (getNUMBER, attrMap, "COLS", 0)
818 :     in
819 :     fun mkTEXTAREA (ctx, attrs, contents) = let
820 :     val attrVec = attrListToVec(ctx, attrMap, attrs)
821 :     in
822 :     HTML.TEXTAREA{
823 :     name = getNAME attrVec,
824 :     rows = getROWS attrVec,
825 :     cols = getCOLS attrVec,
826 :     content = contents
827 :     }
828 :     end
829 :     end (* local *)
830 :    
831 :     (**** Element AREA ****)
832 :     local
833 :     val attrMap = mkAttrs [
834 :     ("ALT", AT_TEXT),
835 :     ("COORDS", AT_TEXT),
836 :     ("HREF", AT_TEXT),
837 :     ("NOHREF", AT_IMPLICIT),
838 :     ("SHAPE", AT_NAMES["RECT", "CIRCLE", "POLY", "DEFAULT"])
839 :     ]
840 :     val getALT = require (getCDATA, attrMap, "ALT", "")
841 :     val getCOORDS = getCDATA (attrMap, "COORDS")
842 :     val getHREF = getCDATA (attrMap, "HREF")
843 :     val getNOHREF = getFlag (attrMap, "NOHREF")
844 :     val getSHAPE = getNAMES HTML.Shape.fromString (attrMap, "SHAPE")
845 :     in
846 :     fun mkAREA (ctx, attrs) = let
847 :     val attrVec = attrListToVec(ctx, attrMap, attrs)
848 :     in
849 :     HTML.AREA{
850 :     shape = getSHAPE attrVec,
851 :     coords = getCOORDS attrVec,
852 :     href = getHREF attrVec,
853 :     nohref = getNOHREF attrVec,
854 :     alt = getALT attrVec
855 :     }
856 :     end
857 :     end (* local *)
858 :    
859 :     (**** Element OPTION ****)
860 :     local
861 :     val attrMap = mkAttrs [
862 :     ("SELECTED", AT_IMPLICIT),
863 :     ("VALUE", AT_TEXT)
864 :     ]
865 :     val getSELECTED = getFlag (attrMap, "SELECTED")
866 :     val getVALUE = getCDATA (attrMap, "VALUE")
867 :     in
868 :     fun mkOPTION (ctx, attrs, contents) = let
869 :     val attrVec = attrListToVec(ctx, attrMap, attrs)
870 :     in
871 :     HTML.OPTION{
872 :     selected = getSELECTED attrVec,
873 :     value = getVALUE attrVec,
874 :     content = contents
875 :     }
876 :     end
877 :     end (* local *)
878 :    
879 :     end
880 :    

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