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 /smlnj-lib/branches/rt-transition/HTML/html-attrs-fn.sml
ViewVC logotype

Annotation of /smlnj-lib/branches/rt-transition/HTML/html-attrs-fn.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2980 - (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 : mblume 1334 | SOME IMPLICIT => raise Fail "getNUMBER: IMPLICIT unexpected"
174 : monnier 2 (* end case *))
175 :     in
176 :     get
177 :     end
178 :     fun getChar (attrMap, attr) = let
179 :     val getFn = bindFindAttr (attrMap, attr)
180 :     fun get attrVec = (case (getFn attrVec)
181 :     of NONE => NONE
182 :     | (SOME((STRING s) | (NAME s))) =>
183 :     if (size s = 1) then SOME(String.sub(s, 0))
184 :     (** NOTE: we should probably accept &#xx; as a character value **)
185 :     else (
186 :     Err.badAttrVal (getContext attrVec) (attr, s);
187 :     NONE)
188 : mblume 1334 | SOME IMPLICIT => raise Fail "getChar: IMPLICIT unexpected"
189 : monnier 2 (* end case *))
190 :     in
191 :     get
192 :     end
193 :    
194 :     fun require (getFn, attrMap, attr, dflt) = let
195 :     val getFn = getFn (attrMap, attr)
196 :     fun get attrVec = (case getFn attrVec
197 :     of NONE => (Err.missingAttr (getContext attrVec) attr; dflt)
198 :     | (SOME v) => v
199 :     (* end case *))
200 :     in
201 :     get
202 :     end
203 :    
204 :     (**** Element ISINDEX ****)
205 :     local
206 :     val attrMap = mkAttrs [
207 :     ("PROMPT", AT_TEXT)
208 :     ]
209 :     val getPROMPT = getCDATA (attrMap, "PROMPT")
210 :     in
211 :     (* the ISINDEX element can occur in both the HEAD an BODY, so there are
212 :     * two datatype constructors for it. We just define the argument of the
213 :     * constructor here.
214 :     *)
215 :     fun mkISINDEX (ctx, attrs) = {
216 :     prompt = getPROMPT (attrListToVec(ctx, attrMap, attrs))
217 :     }
218 :     end (* local *)
219 :    
220 :     (**** Element BASE ****)
221 :     local
222 :     val attrMap = mkAttrs [
223 :     ("HREF", AT_TEXT)
224 :     ]
225 :     val getHREF = require (getCDATA, attrMap, "HREF", "")
226 :     in
227 :     fun mkBASE (ctx, attrs) = HTML.Head_BASE{
228 :     href = getHREF(attrListToVec(ctx, attrMap, attrs))
229 :     }
230 :     end (* local *)
231 :    
232 :     (**** Element META ****)
233 :     local
234 :     val attrMap = mkAttrs [
235 :     ("HTTP-EQUIV", AT_TEXT),
236 :     ("NAME", AT_TEXT),
237 :     ("CONTENT", AT_TEXT)
238 :     ]
239 :     val getHTTP_EQUIV = getCDATA (attrMap, "HTTP-EQUIV")
240 :     val getNAME = getCDATA (attrMap, "NAME")
241 :     val getCONTENT = require (getCDATA, attrMap, "CONTENT", "")
242 :     in
243 :     fun mkMETA (ctx, attrs) = let
244 :     val attrVec = attrListToVec(ctx, attrMap, attrs)
245 :     in
246 :     HTML.Head_META{
247 :     httpEquiv = getHTTP_EQUIV attrVec,
248 :     name = getNAME attrVec,
249 :     content = getCONTENT attrVec
250 :     }
251 :     end
252 :     end (* local *)
253 :    
254 :     (**** Element LINK ****)
255 :     local
256 :     val attrMap = mkAttrs [
257 :     ("HREF", AT_TEXT),
258 :     ("ID", AT_TEXT),
259 :     ("TITLE", AT_TEXT),
260 :     ("REL", AT_TEXT),
261 :     ("REV", AT_TEXT)
262 :     ]
263 :     val getHREF = getCDATA (attrMap, "HREF")
264 :     val getID = getCDATA (attrMap, "ID")
265 :     val getREL = getCDATA (attrMap, "REL")
266 :     val getREV = getCDATA (attrMap, "REV")
267 :     val getTITLE = getCDATA (attrMap, "TITLE")
268 :     in
269 :     fun mkLINK (ctx, attrs) = let
270 :     val attrVec = attrListToVec(ctx, attrMap, attrs)
271 :     in
272 :     HTML.Head_LINK{
273 :     href = getHREF attrVec,
274 :     id = getID attrVec,
275 :     rel = getREL attrVec,
276 :     rev = getREV attrVec,
277 :     title = getTITLE attrVec
278 :     }
279 :     end
280 :     end (* local *)
281 :    
282 : monnier 8 (**** Element BODY ****)
283 :     local
284 :     val attrMap = mkAttrs [
285 :     ("BACKGROUND", AT_TEXT),
286 :     ("BGCOLOR", AT_TEXT),
287 :     ("TEXT", AT_TEXT),
288 :     ("LINK", AT_TEXT),
289 :     ("VLINK", AT_TEXT),
290 :     ("ALINK", AT_TEXT)
291 :     ]
292 :     val getBACKGROUND = getCDATA (attrMap, "BACKGROUND")
293 :     val getBGCOLOR = getCDATA (attrMap, "BGCOLOR")
294 :     val getTEXT = getCDATA (attrMap, "TEXT")
295 :     val getLINK = getCDATA (attrMap, "LINK")
296 :     val getVLINK = getCDATA (attrMap, "VLINK")
297 :     val getALINK = getCDATA (attrMap, "ALINK")
298 :     in
299 :     fun mkBODY (ctx, attrs, blk) = let
300 :     val attrVec = attrListToVec(ctx, attrMap, attrs)
301 :     in
302 :     HTML.BODY{
303 :     background = getBACKGROUND attrVec,
304 :     bgcolor = getBGCOLOR attrVec,
305 :     text = getTEXT attrVec,
306 :     link = getLINK attrVec,
307 :     vlink = getVLINK attrVec,
308 :     alink = getALINK attrVec,
309 :     content = blk
310 :     }
311 :     end
312 :     end (* local *)
313 :    
314 : monnier 2 (**** Elements H1, H2, H3, H4, H5, H6 and P ****)
315 :     local
316 :     val attrMap = mkAttrs [
317 :     ("ALIGN", AT_NAMES["LEFT", "CENTER", "RIGHT"])
318 :     ]
319 :     val getALIGN = getNAMES HTML.HAlign.fromString (attrMap, "ALIGN")
320 :     in
321 :     fun mkHn (n, ctx, attrs, text) = HTML.Hn{
322 :     n = n,
323 :     align = getALIGN(attrListToVec(ctx, attrMap, attrs)),
324 :     content = text
325 :     }
326 :     fun mkP (ctx, attrs, text) = HTML.P{
327 :     align = getALIGN(attrListToVec(ctx, attrMap, attrs)),
328 :     content = text
329 :     }
330 :     end (* local *)
331 :    
332 :     (**** Element UL ****)
333 :     local
334 :     val attrMap = mkAttrs [
335 :     ("COMPACT", AT_IMPLICIT),
336 :     ("TYPE", AT_NAMES["DISC", "SQUARE", "CIRCLE"])
337 :     ]
338 :     val getCOMPACT = getFlag(attrMap, "COMPACT")
339 :     val getTYPE = getNAMES HTML.ULStyle.fromString (attrMap, "TYPE")
340 :     in
341 :     fun mkUL (ctx, attrs, items) = let
342 :     val attrVec = attrListToVec(ctx, attrMap, attrs)
343 :     in
344 :     HTML.UL{
345 :     ty = getTYPE attrVec,
346 :     compact = getCOMPACT attrVec,
347 :     content = items
348 :     }
349 :     end
350 :     end (* local *)
351 :    
352 :     (**** Element OL ****)
353 :     local
354 :     val attrMap = mkAttrs [
355 :     ("COMPACT", AT_IMPLICIT),
356 :     ("START", AT_NUMBER),
357 :     ("TYPE", AT_TEXT)
358 :     ]
359 :     val getCOMPACT = getFlag(attrMap, "COMPACT")
360 :     val getSTART = getNUMBER(attrMap, "START")
361 :     val getTYPE = getCDATA(attrMap, "TYPE")
362 :     in
363 :     fun mkOL (ctx, attrs, items) = let
364 :     val attrVec = attrListToVec(ctx, attrMap, attrs)
365 :     in
366 :     HTML.OL{
367 :     compact = getCOMPACT attrVec,
368 :     start = getSTART attrVec,
369 :     ty = getTYPE attrVec,
370 :     content = items
371 :     }
372 :     end
373 :     end (* local *)
374 :    
375 :     (**** Elements DIR, MENU and DL ****)
376 :     local
377 :     val attrMap = mkAttrs [
378 :     ("COMPACT", AT_IMPLICIT)
379 :     ]
380 :     val getCOMPACT = getFlag(attrMap, "COMPACT")
381 :     in
382 :     fun mkDIR (ctx, attrs, items) = HTML.DIR{
383 :     compact = getCOMPACT (attrListToVec(ctx, attrMap, attrs)),
384 :     content = items
385 :     }
386 :     fun mkMENU (ctx, attrs, items) = HTML.MENU{
387 :     compact = getCOMPACT (attrListToVec(ctx, attrMap, attrs)),
388 :     content = items
389 :     }
390 :     fun mkDL (ctx, attrs, items) = HTML.DL{
391 :     compact = getCOMPACT (attrListToVec(ctx, attrMap, attrs)),
392 :     content = items
393 :     }
394 :     end (* local *)
395 :    
396 :     (**** Element LI ****)
397 :     local
398 :     val attrMap = mkAttrs [
399 :     ("TYPE", AT_TEXT),
400 :     ("VALUE", AT_NUMBER)
401 :     ]
402 :     val getTYPE = getCDATA(attrMap, "TYPE")
403 :     val getVALUE = getNUMBER(attrMap, "VALUE")
404 :     in
405 :     fun mkLI (ctx, attrs, text) = let
406 :     val attrVec = attrListToVec(ctx, attrMap, attrs)
407 :     in
408 :     HTML.LI{
409 :     ty = getTYPE attrVec,
410 :     value = getVALUE attrVec,
411 :     content = text
412 :     }
413 :     end
414 :     end (* local *)
415 :    
416 :     (**** Element PRE ****)
417 :     local
418 :     val attrMap = mkAttrs [
419 :     ("WIDTH", AT_NUMBER)
420 :     ]
421 :     val getWIDTH = getNUMBER(attrMap, "WIDTH")
422 :     in
423 :     fun mkPRE (ctx, attrs, text) = HTML.PRE{
424 :     width = getWIDTH (attrListToVec (ctx, attrMap, attrs)),
425 :     content = text
426 :     }
427 :     end (* local *)
428 :    
429 :     (**** Element DIV ****)
430 :     local
431 :     val attrMap = mkAttrs [
432 :     ("ALIGN", AT_NAMES["LEFT", "CENTER", "RIGHT"])
433 :     ]
434 :     val getALIGN = require (getNAMES HTML.HAlign.fromString,
435 :     attrMap, "ALIGN", HTML.HAlign.left)
436 :     in
437 :     fun mkDIV (ctx, attrs, content) = HTML.DIV{
438 :     align = getALIGN(attrListToVec(ctx, attrMap, attrs)),
439 :     content = content
440 :     }
441 :     end (* local *)
442 :    
443 :     (**** Element FORM ****)
444 :     local
445 :     val attrMap = mkAttrs [
446 :     ("ACTION", AT_TEXT),
447 :     ("METHOD", AT_NAMES["GET", "PUT"]),
448 :     ("ENCTYPE", AT_TEXT)
449 :     ]
450 :     val getACTION = getCDATA (attrMap, "ACTION")
451 :     val getMETHOD = require (getNAMES HTML.HttpMethod.fromString,
452 :     attrMap, "METHOD", HTML.HttpMethod.get)
453 :     val getENCTYPE = getCDATA (attrMap, "ENCTYPE")
454 :     in
455 :     fun mkFORM (ctx, attrs, contents) = let
456 :     val attrVec = attrListToVec(ctx, attrMap, attrs)
457 :     in
458 :     HTML.FORM{
459 :     action = getACTION attrVec,
460 :     method = getMETHOD attrVec,
461 :     enctype = getENCTYPE attrVec,
462 :     content = contents
463 :     }
464 :     end
465 :     end (* local *)
466 :    
467 :     (**** Element HR ****)
468 :     local
469 :     val attrMap = mkAttrs [
470 :     ("ALIGN", AT_NAMES["LEFT", "CENTER", "RIGHT"]),
471 :     ("NOSHADE", AT_IMPLICIT),
472 :     ("SIZE", AT_TEXT),
473 :     ("WIDTH", AT_TEXT)
474 :     ]
475 :     val getALIGN = getNAMES HTML.HAlign.fromString (attrMap, "ALIGN")
476 :     val getNOSHADE = getFlag (attrMap, "NOSHADE")
477 :     val getSIZE = getCDATA (attrMap, "SIZE")
478 :     val getWIDTH = getCDATA (attrMap, "WIDTH")
479 :     in
480 :     fun mkHR (ctx, attrs) = let
481 :     val attrVec = attrListToVec(ctx, attrMap, attrs)
482 :     in
483 :     HTML.HR{
484 :     align = getALIGN attrVec,
485 :     noshade = getNOSHADE attrVec,
486 :     size = getSIZE attrVec,
487 :     width = getWIDTH attrVec
488 :     }
489 :     end
490 :     end (* local *)
491 :    
492 :     (**** Element TABLE ****)
493 :     local
494 :     val attrMap = mkAttrs [
495 :     ("ALIGN", AT_NAMES["LEFT", "CENTER", "RIGHT"]),
496 :     ("BORDER", AT_TEXT),
497 :     ("CELLSPACING", AT_TEXT),
498 :     ("CELLPADDING", AT_TEXT),
499 :     ("WIDTH", AT_TEXT)
500 :     ]
501 :     val getALIGN = getNAMES HTML.HAlign.fromString (attrMap, "ALIGN")
502 :     val getBORDER = getCDATA (attrMap, "BORDER")
503 :     val getCELLSPACING = getCDATA (attrMap, "CELLSPACING")
504 :     val getCELLPADDING = getCDATA (attrMap, "CELLPADDING")
505 :     val getWIDTH = getCDATA (attrMap, "WIDTH")
506 :     in
507 :     fun mkTABLE (ctx, attrs, {caption, body}) = let
508 :     val attrVec = attrListToVec(ctx, attrMap, attrs)
509 :     in
510 :     HTML.TABLE{
511 :     align = getALIGN attrVec,
512 :     border = getBORDER attrVec,
513 :     cellspacing = getCELLSPACING attrVec,
514 :     cellpadding = getCELLPADDING attrVec,
515 :     width = getWIDTH attrVec,
516 :     caption = caption,
517 :     content = body
518 :     }
519 :     end
520 :     end (* local *)
521 :    
522 :     (**** Element CAPTION ****)
523 :     local
524 :     val attrMap = mkAttrs [
525 :     ("ALIGN", AT_NAMES["TOP", "BOTTOM"])
526 :     ]
527 :     val getALIGN = getNAMES HTML.CaptionAlign.fromString (attrMap, "ALIGN")
528 :     in
529 :     fun mkCAPTION (ctx, attrs, text) = HTML.CAPTION{
530 :     align = getALIGN(attrListToVec(ctx, attrMap, attrs)),
531 :     content = text
532 :     }
533 :     end (* local *)
534 :    
535 :     (**** Element TR ****)
536 :     local
537 :     val attrMap = mkAttrs [
538 :     ("ALIGN", AT_NAMES["LEFT", "CENTER", "RIGHT"]),
539 :     ("VALIGN", AT_NAMES["TOP", "MIDDLE", "BOTTOM", "BASELINE"])
540 :     ]
541 :     val getALIGN = getNAMES HTML.HAlign.fromString (attrMap, "ALIGN")
542 :     val getVALIGN = getNAMES HTML.CellVAlign.fromString (attrMap, "VALIGN")
543 :     in
544 :     fun mkTR (ctx, attrs, cells) = let
545 :     val attrVec = attrListToVec(ctx, attrMap, attrs)
546 :     in
547 :     HTML.TR{
548 :     align = getALIGN attrVec,
549 :     valign = getVALIGN attrVec,
550 :     content = cells
551 :     }
552 :     end
553 :     end (* local *)
554 :    
555 :     (**** Elements TH and TD ****)
556 :     local
557 :     val attrMap = mkAttrs [
558 :     ("ALIGN", AT_NAMES["LEFT", "CENTER", "RIGHT"]),
559 :     ("COLSPAN", AT_NUMBER),
560 :     ("HEIGHT", AT_TEXT),
561 :     ("NOWRAP", AT_IMPLICIT),
562 :     ("ROWSPAN", AT_NUMBER),
563 :     ("VALIGN", AT_NAMES["TOP", "MIDDLE", "BOTTOM", "BASELINE"]),
564 :     ("WIDTH", AT_TEXT)
565 :     ]
566 :     val getALIGN = getNAMES HTML.HAlign.fromString (attrMap, "ALIGN")
567 :     val getCOLSPAN = getNUMBER (attrMap, "COLSPAN")
568 :     val getHEIGHT = getCDATA (attrMap, "HEIGHT")
569 :     val getNOWRAP = getFlag (attrMap, "NOWRAP")
570 :     val getROWSPAN = getNUMBER (attrMap, "ROWSPAN")
571 :     val getVALIGN = getNAMES HTML.CellVAlign.fromString (attrMap, "VALIGN")
572 :     val getWIDTH = getCDATA (attrMap, "WIDTH")
573 :     fun mkCell (ctx, attrs, cells) = let
574 :     val attrVec = attrListToVec(ctx, attrMap, attrs)
575 :     in
576 :     { align = getALIGN attrVec,
577 :     colspan = getCOLSPAN attrVec,
578 :     height = getHEIGHT attrVec,
579 :     nowrap = getNOWRAP attrVec,
580 :     rowspan = getROWSPAN attrVec,
581 :     valign = getVALIGN attrVec,
582 :     width = getWIDTH attrVec,
583 :     content = cells
584 :     }
585 :     end
586 :     in
587 :     fun mkTH arg = HTML.TH(mkCell arg)
588 :     fun mkTD arg = HTML.TD(mkCell arg)
589 :     end (* local *)
590 :    
591 :     (**** Element A ****)
592 :     local
593 :     val attrMap = mkAttrs [
594 :     ("HREF", AT_TEXT),
595 :     ("NAME", AT_TEXT),
596 :     ("REL", AT_TEXT),
597 :     ("REV", AT_TEXT),
598 :     ("TITLE", AT_TEXT)
599 :     ]
600 :     val getHREF = getCDATA (attrMap, "HREF")
601 :     val getNAME = getCDATA (attrMap, "NAME")
602 :     val getREL = getCDATA (attrMap, "REL")
603 :     val getREV = getCDATA (attrMap, "REV")
604 :     val getTITLE = getCDATA (attrMap, "TITLE")
605 :     in
606 :     fun mkA (ctx, attrs, contents) = let
607 :     val attrVec = attrListToVec(ctx, attrMap, attrs)
608 :     in
609 :     HTML.A{
610 :     name = getNAME attrVec,
611 :     href = getHREF attrVec,
612 :     rel = getREL attrVec,
613 :     rev = getREV attrVec,
614 :     title = getTITLE attrVec,
615 :     content = contents
616 :     }
617 :     end
618 :     end (* local *)
619 :    
620 :     (**** Element IMG ****)
621 :     local
622 :     val attrMap = mkAttrs [
623 :     ("ALIGN", AT_NAMES["TOP", "MIDDLE", "BOTTOM", "LEFT", "RIGHT"]),
624 :     ("ALT", AT_TEXT),
625 :     ("BORDER", AT_TEXT),
626 :     ("HEIGHT", AT_TEXT),
627 :     ("HSPACE", AT_TEXT),
628 :     ("ISMAP", AT_IMPLICIT),
629 :     ("SRC", AT_TEXT),
630 :     ("USEMAP", AT_TEXT),
631 :     ("VSPACE", AT_TEXT),
632 :     ("WIDTH", AT_TEXT)
633 :     ]
634 :     val getALIGN = getNAMES HTML.IAlign.fromString (attrMap, "ALIGN")
635 :     val getALT = getCDATA (attrMap, "ALT")
636 :     val getBORDER = getCDATA (attrMap, "BORDER")
637 :     val getHEIGHT = getCDATA (attrMap, "HEIGHT")
638 :     val getHSPACE = getCDATA (attrMap, "HSPACE")
639 :     val getISMAP = getFlag (attrMap, "ISMAP")
640 :     val getSRC = require (getCDATA, attrMap, "SRC", "")
641 :     val getUSEMAP = getCDATA (attrMap, "USEMAP")
642 :     val getVSPACE = getCDATA (attrMap, "VSPACE")
643 :     val getWIDTH = getCDATA (attrMap, "WIDTH")
644 :     in
645 :     fun mkIMG (ctx, attrs) = let
646 :     val attrVec = attrListToVec(ctx, attrMap, attrs)
647 :     in
648 :     HTML.IMG{
649 :     src = getSRC attrVec,
650 :     alt = getALT attrVec,
651 :     align = getALIGN attrVec,
652 :     height = getHEIGHT attrVec,
653 :     width = getWIDTH attrVec,
654 :     border = getBORDER attrVec,
655 :     hspace = getHSPACE attrVec,
656 :     vspace = getVSPACE attrVec,
657 :     usemap = getUSEMAP attrVec,
658 :     ismap = getISMAP attrVec
659 :     }
660 :     end
661 :     end (* local *)
662 :    
663 :     (**** Element APPLET ****)
664 :     local
665 :     val attrMap = mkAttrs [
666 :     ("ALIGN", AT_NAMES["TOP", "MIDDLE", "BOTTOM", "LEFT", "RIGHT"]),
667 :     ("ALT", AT_TEXT),
668 :     ("CODE", AT_TEXT),
669 :     ("CODEBASE", AT_TEXT),
670 :     ("HEIGHT", AT_TEXT),
671 :     ("HSPACE", AT_TEXT),
672 :     ("NAME", AT_TEXT),
673 :     ("VSPACE", AT_TEXT),
674 :     ("WIDTH", AT_TEXT)
675 :     ]
676 :     val getALIGN = getNAMES HTML.IAlign.fromString (attrMap, "ALIGN")
677 :     val getALT = getCDATA (attrMap, "ALT")
678 :     val getCODE = require (getCDATA, attrMap, "CODE", "")
679 :     val getCODEBASE = getCDATA (attrMap, "CODEBASE")
680 :     val getHEIGHT = getCDATA (attrMap, "HEIGHT")
681 :     val getHSPACE = getCDATA (attrMap, "HSPACE")
682 :     val getNAME = getCDATA (attrMap, "NAME")
683 :     val getVSPACE = getCDATA (attrMap, "VSPACE")
684 :     val getWIDTH = getCDATA (attrMap, "WIDTH")
685 :     in
686 :     fun mkAPPLET (ctx, attrs, content) = let
687 :     val attrVec = attrListToVec(ctx, attrMap, attrs)
688 :     in
689 :     HTML.APPLET{
690 :     codebase = getCODEBASE attrVec,
691 :     code = getCODE attrVec,
692 :     name = getNAME attrVec,
693 :     alt = getALT attrVec,
694 :     align = getALIGN attrVec,
695 :     height = getHEIGHT attrVec,
696 :     width = getWIDTH attrVec,
697 :     hspace = getHSPACE attrVec,
698 :     vspace = getVSPACE attrVec,
699 :     content = content
700 :     }
701 :     end
702 :     end (* local *)
703 :    
704 :     (**** Element PARAM ****)
705 :     local
706 :     val attrMap = mkAttrs [
707 :     ("NAME", AT_TEXT),
708 :     ("VALUE", AT_TEXT)
709 :     ]
710 :     val getNAME = require (getCDATA, attrMap, "NAME", "")
711 :     val getVALUE = getCDATA (attrMap, "VALUE")
712 :     in
713 :     fun mkPARAM (ctx, attrs) = let
714 :     val attrVec = attrListToVec(ctx, attrMap, attrs)
715 :     in
716 :     HTML.PARAM{
717 :     name = getNAME attrVec,
718 :     value = getVALUE attrVec
719 :     }
720 :     end
721 :     end (* local *)
722 :    
723 :     (**** Element FONT ****)
724 :     local
725 :     val attrMap = mkAttrs [
726 :     ("COLOR", AT_TEXT),
727 :     ("SIZE", AT_TEXT)
728 :     ]
729 :     val getCOLOR = getCDATA (attrMap, "COLOR")
730 :     val getSIZE = getCDATA (attrMap, "SIZE")
731 :     in
732 :     fun mkFONT (ctx, attrs, content) = let
733 :     val attrVec = attrListToVec(ctx, attrMap, attrs)
734 :     in
735 :     HTML.FONT{
736 :     size = getSIZE attrVec,
737 :     color = getCOLOR attrVec,
738 :     content = content
739 :     }
740 :     end
741 :     end (* local *)
742 :    
743 :     (**** Element BASEFONT ****)
744 :     local
745 :     val attrMap = mkAttrs [
746 :     ("SIZE", AT_TEXT)
747 :     ]
748 :     val getSIZE = getCDATA (attrMap, "SIZE")
749 :     in
750 :     fun mkBASEFONT (ctx, attrs, content) = HTML.BASEFONT{
751 :     size = getSIZE(attrListToVec(ctx, attrMap, attrs)),
752 :     content = content
753 :     }
754 :     end (* local *)
755 :    
756 :     (**** Element BR ****)
757 :     local
758 :     val attrMap = mkAttrs [
759 :     ("CLEAR", AT_NAMES["LEFT", "RIGHT", "ALL", "NONE"])
760 :     ]
761 :     val getCLEAR = getNAMES HTML.TextFlowCtl.fromString (attrMap, "CLEAR")
762 :     in
763 :     fun mkBR (ctx, attrs) = HTML.BR{
764 :     clear = getCLEAR(attrListToVec(ctx, attrMap, attrs))
765 :     }
766 :     end (* local *)
767 :    
768 :     (**** Element MAP ****)
769 :     local
770 :     val attrMap = mkAttrs [
771 :     ("NAME", AT_TEXT)
772 :     ]
773 :     val getNAME = getCDATA (attrMap, "NAME")
774 :     in
775 :     fun mkMAP (ctx, attrs, content) = HTML.MAP{
776 :     name = getNAME (attrListToVec(ctx, attrMap, attrs)),
777 :     content = content
778 :     }
779 :     end (* local *)
780 :    
781 :     (**** Element INPUT ****)
782 :     local
783 :     val attrMap = mkAttrs [
784 :     ("ALIGN", AT_NAMES["TOP", "MIDDLE", "BOTTOM", "LEFT", "RIGHT"]),
785 :     ("CHECKED", AT_IMPLICIT),
786 :     ("MAXLENGTH", AT_NUMBER),
787 :     ("NAME", AT_TEXT),
788 :     ("SIZE", AT_TEXT),
789 :     ("SRC", AT_TEXT),
790 :     ("TYPE", AT_NAMES[
791 :     "TEXT", "PASSWORD", "CHECKBOX",
792 :     "RADIO", "SUBMIT", "RESET",
793 :     "FILE", "HIDDEN", "IMAGE"
794 :     ]),
795 :     ("VALUE", AT_TEXT)
796 :     ]
797 :     val getALIGN = getNAMES HTML.IAlign.fromString (attrMap, "ALIGN")
798 :     val getCHECKED = getFlag (attrMap, "CHECKED")
799 :     val getMAXLENGTH = getNUMBER (attrMap, "MAXLENGTH")
800 :     val getNAME = getCDATA (attrMap, "NAME")
801 :     val getSIZE = getCDATA (attrMap, "SIZE")
802 :     val getSRC = getCDATA (attrMap, "SRC")
803 :     val getTYPE = getNAMES HTML.InputType.fromString (attrMap, "TYPE")
804 :     val getVALUE = getCDATA (attrMap, "VALUE")
805 :     in
806 :     fun mkINPUT (ctx, attrs) = let
807 :     val attrVec = attrListToVec(ctx, attrMap, attrs)
808 :     in
809 :     HTML.INPUT{
810 :     ty = getTYPE attrVec,
811 :     name = getNAME attrVec,
812 :     value = getVALUE attrVec,
813 :     src = getSRC attrVec,
814 :     checked = getCHECKED attrVec,
815 :     size = getSIZE attrVec,
816 :     maxlength = getMAXLENGTH attrVec,
817 :     align = getALIGN attrVec
818 :     }
819 :     end
820 :     end (* local *)
821 :    
822 :     (**** Element SELECT ****)
823 :     local
824 :     val attrMap = mkAttrs [
825 :     ("NAME", AT_TEXT),
826 :     ("SIZE", AT_TEXT)
827 :     ]
828 :     val getNAME = require (getCDATA, attrMap, "NAME", "")
829 :     val getSIZE = getNUMBER (attrMap, "SIZE")
830 :     in
831 :     fun mkSELECT (ctx, attrs, contents) = let
832 :     val attrVec = attrListToVec(ctx, attrMap, attrs)
833 :     in
834 :     HTML.SELECT{
835 :     name = getNAME attrVec,
836 :     size = getSIZE attrVec,
837 :     content = contents
838 :     }
839 :     end
840 :     end (* local *)
841 :    
842 :     (**** Element TEXTAREA ****)
843 :     local
844 :     val attrMap = mkAttrs [
845 :     ("NAME", AT_TEXT),
846 :     ("ROWS", AT_NUMBER),
847 :     ("COLS", AT_NUMBER)
848 :     ]
849 :     val getNAME = require (getCDATA, attrMap, "NAME", "")
850 :     val getROWS = require (getNUMBER, attrMap, "ROWS", 0)
851 :     val getCOLS = require (getNUMBER, attrMap, "COLS", 0)
852 :     in
853 :     fun mkTEXTAREA (ctx, attrs, contents) = let
854 :     val attrVec = attrListToVec(ctx, attrMap, attrs)
855 :     in
856 :     HTML.TEXTAREA{
857 :     name = getNAME attrVec,
858 :     rows = getROWS attrVec,
859 :     cols = getCOLS attrVec,
860 :     content = contents
861 :     }
862 :     end
863 :     end (* local *)
864 :    
865 :     (**** Element AREA ****)
866 :     local
867 :     val attrMap = mkAttrs [
868 :     ("ALT", AT_TEXT),
869 :     ("COORDS", AT_TEXT),
870 :     ("HREF", AT_TEXT),
871 :     ("NOHREF", AT_IMPLICIT),
872 :     ("SHAPE", AT_NAMES["RECT", "CIRCLE", "POLY", "DEFAULT"])
873 :     ]
874 :     val getALT = require (getCDATA, attrMap, "ALT", "")
875 :     val getCOORDS = getCDATA (attrMap, "COORDS")
876 :     val getHREF = getCDATA (attrMap, "HREF")
877 :     val getNOHREF = getFlag (attrMap, "NOHREF")
878 :     val getSHAPE = getNAMES HTML.Shape.fromString (attrMap, "SHAPE")
879 :     in
880 :     fun mkAREA (ctx, attrs) = let
881 :     val attrVec = attrListToVec(ctx, attrMap, attrs)
882 :     in
883 :     HTML.AREA{
884 :     shape = getSHAPE attrVec,
885 :     coords = getCOORDS attrVec,
886 :     href = getHREF attrVec,
887 :     nohref = getNOHREF attrVec,
888 :     alt = getALT attrVec
889 :     }
890 :     end
891 :     end (* local *)
892 :    
893 :     (**** Element OPTION ****)
894 :     local
895 :     val attrMap = mkAttrs [
896 :     ("SELECTED", AT_IMPLICIT),
897 :     ("VALUE", AT_TEXT)
898 :     ]
899 :     val getSELECTED = getFlag (attrMap, "SELECTED")
900 :     val getVALUE = getCDATA (attrMap, "VALUE")
901 :     in
902 :     fun mkOPTION (ctx, attrs, contents) = let
903 :     val attrVec = attrListToVec(ctx, attrMap, attrs)
904 :     in
905 :     HTML.OPTION{
906 :     selected = getSELECTED attrVec,
907 :     value = getVALUE attrVec,
908 :     content = contents
909 :     }
910 :     end
911 :     end (* local *)
912 :    
913 :     end
914 :    

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