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/contrib/trace-menu.sml
ViewVC logotype

Annotation of /sml/trunk/src/eXene/contrib/trace-menu.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2 - (view) (download)

1 : monnier 2 (* ######################################################################
2 :     # CML_TRACE_MENU.SML #
3 :     ###################################################################### *)
4 :    
5 :     (* An implementation of an eXene interface to the TraceCML structure.
6 :    
7 :     AUTHOR: Clifford Krumvieda
8 :     Department of Computer Science
9 :     Cornell University
10 :     Ithaca, NY 14850
11 :     cliff@cs.cornell.edu
12 :     *)
13 :    
14 :     (* ######################################################################
15 :    
16 :     Trace menus: The mkTraceMenu function can be used to create a menu of
17 :     certain TraceCML modules. Each line in the menu consists of a box
18 :     and a module name; the box has a checkmark in it if its module is
19 :     being traced. Clicking in the box toggles the checkmark and trace
20 :     status.
21 :     The second argument to mkTraceMenu is a list of module names that
22 :     determine the "frontier" of modules appearing in the menu. A
23 :     typical value is ["/"].
24 :    
25 :     ###################################################################### *)
26 :    
27 :     functor MakeCMLTraceMenu (structure BufferChan : BUFFER_CHAN
28 :     and TraceCML : TRACE_CML
29 :     and Box: BOX
30 :     and Label: LABEL
31 :     and Toggle: TOGGLE
32 :     sharing Box.W = Label.W = Toggle.W) : CML_TRACE_MENU =
33 :     struct
34 :    
35 :     structure W = Box.W;
36 :    
37 :     local
38 :     structure BC = BufferChan
39 :     open Box Label Toggle W.CML
40 :     in
41 :    
42 :     type trace_menu = box_layout;
43 :     val widgetOf = Box.widgetOf;
44 :    
45 :     fun mkTraceMenu root only = let
46 :     val toggleCh = BC.buffer ();
47 :     fun transform (name, isTraced) = let
48 :     val toggle =
49 :     mkToggleCheck root {state = W.Active isTraced,
50 :     action = fn x =>
51 :     if (x andalso TraceCML.amTracing name) orelse
52 :     not (x orelse TraceCML.amTracing name) then ()
53 :     else BC.bufferSend (toggleCh, (name, x)),
54 :     color = NONE,
55 :     sz = 30};
56 :     val label =
57 :     mkLabel root {label = TraceCML.nameOf name,
58 :     font = NONE,
59 :     foregrnd = NONE,
60 :     backgrnd = NONE,
61 :     align = Label.W.HLeft};
62 :     val box = (HzCenter
63 :     [WBox (Toggle.widgetOf toggle),
64 :     Glue {nat = 5, min = 0, max = SOME 5},
65 :     WBox (Label.widgetOf label),
66 :     Glue {nat = 5, min = 0, max = NONE}]);
67 :     in
68 :     ((name, toggle), box)
69 :     end;
70 :     val (toggles, boxes) =
71 :     fold (fn (x, (ts, bs)) =>
72 :     (fn (t, b) => (t :: ts, b :: bs)) (transform x))
73 :     (fold (fn (x, a) => TraceCML.status(TraceCML.moduleOf x) @ a) only [])
74 :     ([], []);
75 :     fun server () = let
76 :     fun handleToggle (name, x) =
77 :     ((if x then TraceCML.traceOn else TraceCML.traceOff) name;
78 :     map (fn (n, t) => setState (t, TraceCML.amTracing n)) toggles; ());
79 :     in
80 :     handleToggle (BC.bufferAccept toggleCh);
81 :     server ()
82 :     end;
83 :     in
84 :     spawn server;
85 :     mkLayout root (VtCenter boxes)
86 :     end
87 :    
88 :     end
89 :     end;
90 :    
91 :     structure CMLTraceMenu =
92 :     MakeCMLTraceMenu (structure BufferChan = BufferChan
93 :     and TraceCML = TraceCML
94 :     and Box = Box
95 :     and Label = Label
96 :     and Toggle = Toggle);

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