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

Parent Directory | 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