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

SCM Repository

[smlnj] Diff of /sml/branches/blume-private-devel/src/smlnj-lib/Controls/controls.sml
ViewVC logotype

Diff of /sml/branches/blume-private-devel/src/smlnj-lib/Controls/controls.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1634, Tue Sep 28 15:53:10 2004 UTC revision 1635, Tue Sep 28 17:12:31 2004 UTC
# Line 11  Line 11 
11      fun control {name, pri, obscurity, help, ctl} = Ctl{      fun control {name, pri, obscurity, help, ctl} = Ctl{
12              name = Atom.atom name,              name = Atom.atom name,
13              get = fn () => !ctl,              get = fn () => !ctl,
14              set = fn v => ctl := v,              set = fn SOME v => (fn () => ctl := v)
15                       | NONE => let val v = !ctl in fn () => ctl := v end,
16              priority = pri,              priority = pri,
17              obscurity = obscurity,              obscurity = obscurity,
18              help = help              help = help
# Line 27  Line 28 
28     *)     *)
29      exception ValueSyntax of {tyName : string, ctlName : string, value : string}      exception ValueSyntax of {tyName : string, ctlName : string, value : string}
30    
31      fun stringControl {tyName, fromString, toString} = let      fun stringControl {tyName, fromString, toString} (Ctl c) =
32            fun mk (Ctl{name, get, set, priority, obscurity, help}) = Ctl{          let val {name, get, set, priority, obscurity, help} = c
33                    name = name,              fun fromString' s =
34                    get = fn () => toString(get()),                  case fromString s of
35                    set = fn sval => (case fromString sval                      NONE => raise ValueSyntax { tyName = tyName,
                      of NONE => raise ValueSyntax{  
                             tyName = tyName,  
36                              ctlName = Atom.toString name,                              ctlName = Atom.toString name,
37                              value = sval                                                  value = s }
38                            }                    | SOME v => v
39                        | SOME v => set v          in
40                      (* end case *)),              Ctl { name = name,
41                      get = toString o get,
42                      set = set o Option.map fromString',
43                    priority = priority,                    priority = priority,
44                    obscurity = obscurity,                    obscurity = obscurity,
45                    help = help                    help = help }
                 }  
           in  
             mk  
46            end            end
47    
48      fun name (Ctl{name, ...}) = Atom.toString name      fun name (Ctl{name, ...}) = Atom.toString name
49      fun get (Ctl{get, ...}) = get()      fun get (Ctl{get, ...}) = get()
50      fun set (Ctl{set, ...}, v) = set v      fun set (Ctl{set, ...}, v) = set (SOME v) ()
51      fun info (Ctl{priority, obscurity, help, ...}) = {      fun set' (Ctl{set, ...}, v) = set (SOME v)
52              priority = priority, obscurity = obscurity, help = help      fun info (Ctl{priority, obscurity, help, ...}) =
53            }          { priority = priority, obscurity = obscurity, help = help }
54    
55      fun compare (Ctl{priority=p1, ...}, Ctl{priority=p2, ...}) = let      fun save'restore (Ctl{set,...}) = set NONE
56            fun collate ([], []) = EQUAL  
57              | collate ([], _) = LESS      fun compare (Ctl{priority=p1, ...}, Ctl{priority=p2, ...}) =
58              | collate (_, []) = GREATER          List.collate Int.compare (p1, p2)
             | collate (x::xs, y::ys) =  
                 if (x = y) then collate(xs, ys)  
                 else if (x < y) then LESS  
                 else GREATER  
           in  
             collate (p1, p2)  
           end  
59    
60    end    end

Legend:
Removed from v.1634  
changed lines
  Added in v.1635

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