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/eXene/widgets/basics/widget-attrs.sml
ViewVC logotype

Annotation of /sml/trunk/src/eXene/widgets/basics/widget-attrs.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2 - (view) (download)

1 : monnier 2 (* widget-attrs.sml
2 :     *
3 :     * COPYRIGHT (c) 1991,1994 by AT&T Bell Laboratories.
4 :     *
5 :     * High-level view of widget attributes.
6 :     *)
7 :    
8 :     signature WIDGET_ATTRS =
9 :     sig
10 :     exception InvalidAttr of string
11 :    
12 :     type attr_spec = Attrs.attr_name * Attrs.attr_type * Attrs.attr_value
13 :     type arg = Attrs.attr_name * Attrs.attr_value
14 :    
15 :     type view
16 :     type attrs
17 :    
18 :     val attrs : (view * attr_spec list * arg list) -> attrs
19 :     val findAttr : attrs -> Attrs.attr_name -> Attrs.attr_value
20 :    
21 :     end (* WIDGET_ATTRS *)
22 :    
23 :     structure WidgetAttrs : WIDGET_ATTRS =
24 :     struct
25 :     exception InvalidAttr of string
26 :    
27 :     type attr_spec = Attrs.attr_name * Attrs.attr_type * Attrs.attr_value
28 :     type arg = Attrs.attr_name * Attrs.attr_value
29 :     type view = Styles.style_view * Styles.style
30 :     datatype attrs = ATTRS of {lookup : Attrs.attr_name -> Attrs.attr_value}
31 :    
32 :     structure QuarkTbl = HashTableFn (struct
33 :     type hash_key = Quark.quark
34 :     val hashVal = Quark.hash
35 :     val sameKey = Quark.same
36 :     end)
37 :    
38 :     fun okay (attrSpecs : attr_spec list) n =
39 :     List.find (fn s => Quark.same(n,#1 s)) attrSpecs
40 :    
41 :     fun add (okay,tbl) (n,v) =
42 :     case okay n of
43 :     SOME (_,t,_) => QuarkTbl.insert tbl (n,(v,t))
44 :     | NONE => ()
45 :    
46 :     fun attrs ((name,style),attrSpecs, []) =
47 :     ATTRS{lookup = Styles.findAttrs style (name, attrSpecs)}
48 :     | attrs ((name,style),attrSpecs, args) = let
49 :     val cvt = Attrs.cvtAttrValue (Styles.ctxtOf style)
50 :     val base = Styles.findAttrs style (name, attrSpecs)
51 :     val tbl = QuarkTbl.mkTable (8, Fail "widget-attrs")
52 :     fun lookup n = case QuarkTbl.find tbl n of
53 :     SOME v => cvt v
54 :     | NONE => base n
55 :     in
56 :     app (add (okay attrSpecs,tbl)) args;
57 :     ATTRS{lookup = lookup}
58 :     end
59 :    
60 :     fun findAttr (ATTRS{lookup}) name =
61 :     (lookup name) handle _ => raise InvalidAttr (Quark.stringOf name)
62 :    
63 :     end (* WidgetAttrs *)

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