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/trunk/src/smlnj-lib/Controls/controls.sml
ViewVC logotype

Diff of /sml/trunk/src/smlnj-lib/Controls/controls.sml

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

revision 1632, Mon Sep 27 22:18:07 2004 UTC revision 1633, Tue Sep 28 03:08:33 2004 UTC
# Line 12  Line 12 
12              name = Atom.atom name,              name = Atom.atom name,
13              get = fn () => !ctl,              get = fn () => !ctl,
14              set = fn v => ctl := v,              set = fn v => ctl := v,
15                set' = fn v => fn () => ctl := v,
16                save'restore = fn () => let val v = !ctl in fn () => ctl := v end,
17              priority = pri,              priority = pri,
18              obscurity = obscurity,              obscurity = obscurity,
19              help = help              help = help
# Line 28  Line 30 
30      exception ValueSyntax of {tyName : string, ctlName : string, value : string}      exception ValueSyntax of {tyName : string, ctlName : string, value : string}
31    
32      fun stringControl {tyName, fromString, toString} = let      fun stringControl {tyName, fromString, toString} = let
33            fun mk (Ctl{name, get, set, priority, obscurity, help}) = Ctl{            fun fromString' name s =
34                    name = name,                case fromString s of
35                    get = fn () => toString(get()),                    NONE => raise ValueSyntax { tyName = tyName,
                   set = fn sval => (case fromString sval  
                      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  
40                      (* end case *)),            fun mk (Ctl{name, get, set, set', save'restore,
41                          priority, obscurity, help}) =
42                  Ctl { name = name,
43                        get = toString o get,
44                        set = set o fromString' name,
45                        set' = set' o fromString' name,
46                        save'restore = save'restore,
47                    priority = priority,                    priority = priority,
48                    obscurity = obscurity,                    obscurity = obscurity,
49                    help = help                      help = help }
                 }  
50            in            in
51              mk              mk
52            end            end
# Line 50  Line 54 
54      fun name (Ctl{name, ...}) = Atom.toString name      fun name (Ctl{name, ...}) = Atom.toString name
55      fun get (Ctl{get, ...}) = get()      fun get (Ctl{get, ...}) = get()
56      fun set (Ctl{set, ...}, v) = set v      fun set (Ctl{set, ...}, v) = set v
57        fun set' (Ctl{set', ...}, v) = set' v
58      fun info (Ctl{priority, obscurity, help, ...}) = {      fun info (Ctl{priority, obscurity, help, ...}) = {
59              priority = priority, obscurity = obscurity, help = help              priority = priority, obscurity = obscurity, help = help
60            }            }
61    
62        fun save'restore (Ctl{save'restore,...}) = save'restore ()
63    
64      fun compare (Ctl{priority=p1, ...}, Ctl{priority=p2, ...}) = let      fun compare (Ctl{priority=p1, ...}, Ctl{priority=p2, ...}) = let
65            fun collate ([], []) = EQUAL            fun collate ([], []) = EQUAL
66              | collate ([], _) = LESS              | collate ([], _) = LESS

Legend:
Removed from v.1632  
changed lines
  Added in v.1633

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