DIRECTORY
Atom, Buttons, CodeTimer, Commander, MJSContainers, IO, Menus, RefTab, Rope, TypeScript, ViewerClasses, ViewerOps, ViewerTools;

CodeTimerToolImpl: CEDAR PROGRAM
IMPORTS Atom, Buttons, CodeTimer, Commander, MJSContainers, IO, Menus, RefTab, Rope, TypeScript, ViewerOps, ViewerTools = BEGIN

ToolData: TYPE = REF ToolDataObj;
ToolDataObj: TYPE = RECORD [
typescript, textViewer: Viewer
];
Viewer: TYPE = ViewerClasses.Viewer;

PrintHerald: PROC [r: Rope.ROPE, look: CHAR, typescript: Viewer] = {
TypeScript.ChangeLooks[typescript, look];
TypeScript.PutRope[typescript, r];
TypeScript.ChangeLooks[typescript, ' ]; -- clear looks
};

scratch: IO.STREAM;
scratchRope: Rope.ROPE;

PrintIntervalProc: ViewerClasses.ClickProc = {
toolData: ToolData ¬ NARROW[MJSContainers.GetClientData[parent]];
typescript: Viewer ¬ toolData.typescript;
problemMessage: Rope.ROPE;
BEGIN
ENABLE CodeTimer.Problem => {
problemMessage ¬ msg;
GOTO CTProblem;
};
textViewer: Viewer ¬ toolData.textViewer;
table, interval: Rope.ROPE;
tableName, intervalName: ATOM;
from: CodeTimer.Table;
PrintHerald["\nPrintInterval: \n", heraldLook, typescript];
table ¬ ViewerTools.GetContents[viewer: textViewer];
IF Rope.Length[table]=0 THEN GOTO BogusT;
tableName ¬ Atom.MakeAtom[table];
from ¬ CodeTimer.GetTable[tableName];
IF from=NIL THEN GOTO BogusT;
interval ¬ ViewerTools.GetSelectionContents[];
IF Rope.Length[interval]=0 THEN GOTO BogusI;
intervalName ¬ Atom.MakeAtom[interval];
scratch ¬ IO.ROS[scratch];
CodeTimer.PrintInt[scratch, intervalName, tableName];
scratchRope ¬ IO.RopeFromROS[self: scratch, close: TRUE];
IF Rope.Length[scratchRope]=0 THEN scratchRope ¬ IO.PutFR1["%g  is empty\n", [rope[interval]] ];
TypeScript.PutRope[typescript, scratchRope];
TypeScript.BackSpace[typescript, 1]; -- extra CR
EXITS
BogusT => TypeScript.PutRope[typescript, "NIL or unknown table - Bogus"];
BogusI => TypeScript.PutRope[typescript, "NIL or unknown interval - Bogus"];
CTProblem => TypeScript.PutRope[typescript, problemMessage];
END;
};

PrintAllIntervalsProc: ViewerClasses.ClickProc = {
toolData: ToolData ¬ NARROW[MJSContainers.GetClientData[parent]];
typescript: Viewer ¬ toolData.typescript;
problemMessage: Rope.ROPE;
BEGIN
ENABLE CodeTimer.Problem => {
problemMessage ¬ msg;
GOTO CTProblem;
};
table: Rope.ROPE;
tableName: ATOM;
from: CodeTimer.Table;
textViewer: Viewer ¬ toolData.textViewer;
PrintHerald["\nPrintAllIntervals: \n", heraldLook, typescript];
table ¬ ViewerTools.GetContents[viewer: textViewer];
IF Rope.Length[table]=0 THEN GOTO Bogus;
tableName ¬ Atom.MakeAtom[table];
from ¬ CodeTimer.GetTable[tableName];
IF from=NIL THEN GOTO Bogus;
scratch ¬ IO.ROS[scratch];
CodeTimer.PrintTable[scratch, from];
scratchRope ¬ IO.RopeFromROS[self: scratch, close: TRUE];
IF Rope.Length[scratchRope]=0 THEN scratchRope ¬ IO.PutFR1["Table %g is empty\n", [rope[table]] ];
TypeScript.PutRope[typescript, scratchRope];
TypeScript.BackSpace[typescript, 1]; -- extra CR
EXITS
Bogus => TypeScript.PutRope[typescript, "NIL or unknown table - Bogus"];
CTProblem => TypeScript.PutRope[typescript, problemMessage];
END;
};

ListIntervalsProc: ViewerClasses.ClickProc = {
toolData: ToolData ¬ NARROW[MJSContainers.GetClientData[parent]];
typescript: Viewer ¬ toolData.typescript;
problemMessage: Rope.ROPE;
BEGIN
ENABLE CodeTimer.Problem => {
problemMessage ¬ msg;
GOTO CTProblem;
};
DoPrintName: CodeTimer.ForEachIntervalInContextProc = {
found: BOOL ¬ intervalTable.Fetch[intervalName].found;
IF NOT found THEN {
scratch.PutF1[" %g", [atom[intervalName]] ];
[] ¬ intervalTable.Store[intervalName, intervalName];
};
};
table: Rope.ROPE;
tableName: ATOM;
from: CodeTimer.Table;
intervalTable: RefTab.Ref ¬ RefTab.Create[];
textViewer: Viewer ¬ toolData.textViewer;
PrintHerald["\nListIntervals: ", heraldLook, typescript];
table ¬ ViewerTools.GetContents[viewer: textViewer];
IF Rope.Length[table]=0 THEN GOTO Bogus;
tableName ¬ Atom.MakeAtom[table];
from ¬ CodeTimer.GetTable[tableName];
IF from=NIL THEN GOTO Bogus;
scratch ¬ IO.ROS[scratch];
[] ¬ CodeTimer.ForEachIntervalInContext[from, DoPrintName];
scratchRope ¬ IO.RopeFromROS[self: scratch, close: TRUE];
TypeScript.PutRope[typescript, scratchRope];
EXITS
Bogus => TypeScript.PutRope[typescript, "NIL or unknown table - Bogus"];
CTProblem => TypeScript.PutRope[typescript, problemMessage];
END;
};

ResetIntervalProc: ViewerClasses.ClickProc = {
toolData: ToolData ¬ NARROW[MJSContainers.GetClientData[parent]];
typescript: Viewer ¬ toolData.typescript;
problemMessage: Rope.ROPE;
BEGIN
ENABLE CodeTimer.Problem => {
problemMessage ¬ msg;
GOTO CTProblem;
};
table, interval: Rope.ROPE;
tableName, intervalName: ATOM;
from: CodeTimer.Table;
textViewer: Viewer ¬ toolData.textViewer;
PrintHerald["\nResetInterval: ", heraldLook, typescript];
table ¬ ViewerTools.GetContents[viewer: textViewer];
IF Rope.Length[table]=0 THEN GOTO BogusT;
tableName ¬ Atom.MakeAtom[table];
from ¬ CodeTimer.GetTable[tableName];
IF from=NIL THEN GOTO BogusT;
interval ¬ ViewerTools.GetSelectionContents[];
IF Rope.Length[interval]=0 THEN GOTO BogusI;
intervalName ¬ Atom.MakeAtom[interval];
CodeTimer.ResetInterval[intervalName, from];
TypeScript.PutRope[typescript, IO.PutFR1["Interval %g reset", [rope[interval]] ]];
EXITS
BogusT => TypeScript.PutRope[typescript, "NIL or unknown table - Bogus"];
BogusI => TypeScript.PutRope[typescript, "NIL or unknown interval - Bogus"];
CTProblem => TypeScript.PutRope[typescript, problemMessage];
END;
};

ResetAllIntervalsProc: ViewerClasses.ClickProc = {
toolData: ToolData ¬ NARROW[MJSContainers.GetClientData[parent]];
typescript: Viewer ¬ toolData.typescript;
problemMessage: Rope.ROPE;
BEGIN
ENABLE CodeTimer.Problem => {
problemMessage ¬ msg;
GOTO CTProblem;
};
table: Rope.ROPE;
tableName: ATOM;
textViewer: Viewer ¬ toolData.textViewer;
from: CodeTimer.Table;
PrintHerald["\nResetAllIntervals: ", heraldLook, typescript];
table ¬ ViewerTools.GetContents[viewer: textViewer];
IF Rope.Length[table]=0 THEN GOTO Bogus;
tableName ¬ Atom.MakeAtom[table];
from ¬ CodeTimer.GetTable[tableName];
IF from=NIL THEN GOTO Bogus;
CodeTimer.ResetTable[from];
TypeScript.PutRope[typescript, IO.PutFR1["Table %g reset", [rope[table]] ]];
EXITS
Bogus => TypeScript.PutRope[typescript, "NIL or unknown table - Bogus"];
CTProblem => TypeScript.PutRope[typescript, problemMessage];
END;
};

ListTablesProc: ViewerClasses.ClickProc = {
toolData: ToolData ¬ NARROW[MJSContainers.GetClientData[parent]];
typescript: Viewer ¬ toolData.typescript;
problemMessage: Rope.ROPE;
BEGIN
ENABLE CodeTimer.Problem => {
problemMessage ¬ msg;
GOTO CTProblem;
};
PrintTableName: CodeTimer.ForEachTableProc = {
scratch.PutF1[" %g", [atom[tableName]] ];
};

textViewer: Viewer ¬ toolData.textViewer;
PrintHerald["\nListTables: ", heraldLook, typescript];
scratch ¬ IO.ROS[scratch];
[] ¬ CodeTimer.ForEachTable[PrintTableName];
scratchRope ¬ IO.RopeFromROS[self: scratch, close: TRUE];
TypeScript.PutRope[typescript, IF Rope.Length[scratchRope]=0 THEN "No tables" ELSE scratchRope];
EXITS
CTProblem => TypeScript.PutRope[typescript, problemMessage];
END;
};

SetSelectionProc: ViewerClasses.ClickProc = {
toolData: ToolData ¬ NARROW[clientData];
textViewer: Viewer ¬ toolData.textViewer;
ViewerTools.SetSelection[textViewer];
};

heraldLook: CHAR ¬ 'b;
entryHeight: INTEGER ¬ 20;
gap: INTEGER ¬ 5;

CreateCodeTimerTool: Commander.CommandProc = {
menu: ViewerClasses.Menu;
printInterval, printAllIntervals, listIntervals, resetInterval, resetAllIntervals, listTables: Menus.MenuEntry;

buttonLabel, container, textViewer, typescript: Viewer;

toolData: ToolData ¬ NEW[ToolDataObj];

menu ¬ Menus.CreateMenu[2];
printInterval ¬ Menus.CreateEntry[name: "PrintInterval", proc: PrintIntervalProc, fork: FALSE];
printAllIntervals ¬ Menus.CreateEntry[name: "PrintAllIntervals", proc: PrintAllIntervalsProc, fork: FALSE];
listIntervals ¬ Menus.CreateEntry[name: "ListIntervals", proc: ListIntervalsProc, fork: FALSE];
resetInterval ¬ Menus.CreateEntry[name: "ResetInterval", proc: ResetIntervalProc, fork: FALSE];
resetAllIntervals ¬ Menus.CreateEntry[name: "ResetAllIntervals", proc: ResetAllIntervalsProc, fork: FALSE];
listTables ¬ Menus.CreateEntry[name: "ListTables", proc: ListTablesProc, fork: FALSE];

Menus.AppendMenuEntry[menu, printInterval, 0];
Menus.AppendMenuEntry[menu, printAllIntervals, 0];
Menus.AppendMenuEntry[menu, listIntervals, 0];
Menus.AppendMenuEntry[menu, resetInterval, 1];
Menus.AppendMenuEntry[menu, resetAllIntervals, 1];
Menus.AppendMenuEntry[menu, listTables, 1];

container ¬ MJSContainers.Create[viewerFlavor: $VanillaMJSContainer, info: [name: "CodeTimerTool", menu: menu, scrollable: FALSE, data: toolData], paint: FALSE];
buttonLabel ¬ Buttons.Create[clientData: toolData, info: [name: "TableName: ", parent: container, border: FALSE], proc: SetSelectionProc, fork: FALSE, paint: FALSE];
textViewer ¬ ViewerOps.CreateViewer[flavor: $Text, info: [parent: container, wx: buttonLabel.wx+buttonLabel.ww+gap, wh: entryHeight, border: TRUE, scrollable: FALSE], paint: FALSE];
MJSContainers.ChildXBound[container, textViewer];

typescript ¬ TypeScript.Create[info: [parent: container, wy: entryHeight, border: FALSE, scrollable: TRUE], paint: FALSE];
toolData.typescript ¬ typescript;
toolData.textViewer ¬ textViewer;
MJSContainers.ChildXBound[container, typescript];
MJSContainers.ChildYBound[container, typescript];

PrintHerald["\nWelcome to CodeTimerTool of March, 1993", heraldLook, typescript];

ViewerOps.PaintViewer[viewer: container, hint: all, clearClient: TRUE, whatChanged: NIL];
};

Commander.Register["CodeTimerTool", CreateCodeTimerTool, "Creates a tool to look at the tables of timed code intervals.  Use codeTimerOn to enable timing."];

END.

Φ
CodeTimerToolImpl.mesa
Copyright Σ 1989, 1993 by Xerox Corporation.  All rights reserved.
Pier, February 15, 1989 12:07:45 pm PST
Bier, March 26, 1993 4:36 pm PST

PROC [parent: Viewer, clientData: REF ANY _ NIL, 
mouseButton: MouseButton _ red, shift, control: BOOL _ FALSE];
PROC [intervalName: ATOM, process: CARD, starts, totalMsec, minMsec, maxMsec, maxIndex, startsWithoutStops: CARD, level: NAT _ 0] RETURNS [done: BOOL _ FALSE];
This should do duplicate suppression
PROC [tableName: ATOM, table: Table] RETURNS [done: BOOL _ FALSE];
PROC [parent: Viewer, clientData: REF ANY _ NIL, mouseButton: MouseButton _ red, shift, control: BOOL _ FALSE];
PROC [cmd: Handle] RETURNS [result: REF _ NIL, msg: ROPE _ NIL];
ΚŽ•NewlineDelimiter

–
"cedarcode" style™
codeš
œ™Kšœ
Οe
œ7™BK™'K™ K™—š
Οk	˜	Kš
œ˜K˜—šΟnœžœ
ž˜ Kšžœsž˜—K˜Kšœ
žœžœ
˜!šœ
žœžœ˜K˜K˜—šœžœ˜$K˜—šŸœžœ
žœžœ˜DKš
œ)˜)Kš
œ"˜"Kšœ(Οc˜6K˜K˜—Kšœ	žœ
žœ
˜Kšœžœ
˜K˜šŸœ˜.Kšžœžœ
žœžœ3žœžœ™pKšœžœ&˜AK˜)Kšœžœ
˜š
ž˜šžœ˜K˜Kšžœ˜K˜—K˜)Kšœžœ
˜Kšœžœ
˜Kš
œ˜Kš
œ;˜;K•StartOfExpansion [viewer: 
ViewerClasses.Viewer]˜4Kšžœžœ
žœ˜)K˜!KšœŸœ˜%Kšžœžœ
žœ
žœ˜K–[]˜.Kšžœžœ
žœ˜,K˜'Kšœ
žœ
žœ
˜Kšœ
Οbœ#˜5K–&[self: 
STREAM, close: 
BOOL _ TRUE]šœžœ#žœ˜9Kšžœžœžœ-˜`Kš
œ,˜,Kšœ% ˜0š
ž˜Kš
œI˜IKš
œL˜LKš
œ<˜<—Kšžœ
˜—K˜K˜—šŸœ˜2Kšœžœ&˜AK˜)Kšœžœ
˜š
ž˜šžœ˜K˜Kšžœ˜K˜—Kšœžœ
˜Kšœžœ
˜Kš
œ˜K˜)Kš
œ?˜?K– [viewer: 
ViewerClasses.Viewer]˜4Kšžœžœ
žœ˜(K˜!KšœŸœ˜%Kšžœžœ
žœ
žœ˜Kšœ
žœ
žœ
˜Kšœ
Ÿ
œ˜$K–&[self: 
STREAM, close: 
BOOL _ TRUE]šœžœ#žœ˜9Kšžœžœžœ/˜bKš
œ,˜,Kšœ% ˜0š
ž˜Kš
œH˜HKš
œ<˜<—Kšžœ
˜—K˜K˜—šŸœ˜.Kšœžœ&˜AK˜)Kšœžœ
˜š
ž˜šžœ˜K˜Kšžœ˜K˜—š
œ7˜7KšžœžœžœEžœ	žœžœžœžœ™Ÿ
K–―
[stream: 
STREAM, format: 
ROPE _ NIL, v1: 
IO.Value _ [null[]], v2: 
IO.Value _ [null[]], v3: 
IO.Value _ [null[]], v4: 
IO.Value _ [null[]], v5: 
IO.Value _ [null[]]]™$Kšœžœ+˜6šžœ
žœžœ˜K˜,K˜5K˜—K˜—Kšœžœ
˜Kšœžœ
˜Kš
œ˜K˜,K˜)Kš
œ9˜9K– [viewer: 
ViewerClasses.Viewer]˜4Kšžœžœ
žœ˜(K˜!KšœŸœ˜%Kšžœžœ
žœ
žœ˜Kšœ
žœ
žœ
˜K˜;K–&[self: 
STREAM, close: 
BOOL _ TRUE]šœžœ#žœ˜9Kš
œ,˜,š
ž˜Kš
œH˜HKš
œ<˜<—Kšžœ
˜—K˜K˜—šŸœ˜.Kšœžœ&˜AK˜)Kšœžœ
˜š
ž˜šžœ˜K˜Kšžœ˜K˜—Kšœžœ
˜Kšœžœ
˜Kš
œ˜K˜)Kš
œ9˜9K– [viewer: 
ViewerClasses.Viewer]˜4Kšžœžœ
žœ˜)K˜!KšœŸœ˜%Kšžœžœ
žœ
žœ˜K–[]˜.Kšžœžœ
žœ˜,K˜'Kšœ
Ÿ
œ˜,Kšœžœ1˜Rš
ž˜Kš
œI˜IKš
œL˜LKš
œ<˜<—Kšžœ
˜—K˜K˜—šŸœ˜2Kšœžœ&˜AK˜)Kšœžœ
˜š
ž˜šžœ˜K˜Kšžœ˜K˜—Kšœžœ
˜Kšœžœ
˜K˜)Kš
œ˜Kš
œ=˜=K– [viewer: 
ViewerClasses.Viewer]˜4Kšžœžœ
žœ˜(K˜!KšœŸœ˜%Kšžœžœ
žœ
žœ˜Kšœ
‘
œ˜Kšœžœ+˜Lš
ž˜Kš
œH˜HKš
œ<˜<—Kšžœ
˜—K˜K˜—šŸœ˜+Kšœžœ&˜AK˜)Kšœžœ
˜š
ž˜šžœ˜K˜Kšžœ˜K˜—š
œ.˜.Kš
žœ
žœžœžœžœ™BK–―
[stream: 
STREAM, format: 
ROPE _ NIL, v1: 
IO.Value _ [null[]], v2: 
IO.Value _ [null[]], v3: 
IO.Value _ [null[]], v4: 
IO.Value _ [null[]], v5: 
IO.Value _ [null[]]]˜)K˜K˜—K˜)Kš
œ6˜6Kšœ
žœ
žœ
˜K˜,K–&[self: 
STREAM, close: 
BOOL _ TRUE]šœžœ#žœ˜9Kšœžœžœ
žœ˜`š
ž˜Kš
œ<˜<—Kšžœ
˜—K˜K˜—šŸœ˜-Kšžœžœ
žœžœ2žœžœ™oKšœžœ
˜(K˜)Kš
œ%˜%K˜—K˜Kšœžœ˜Kšœ
žœ˜Kšœžœ˜K˜šŸœ˜.Kšžœžœ
žœžœžœžœ™@Kš
œ˜Kš
œo˜oK˜Kš
œ7˜7K˜Kšœžœ˜&K–Δ[info: 
ViewerClasses.ViewerRec _ [class: 
NIL, wx: 
0, wy: 
0, ww: 
0, wh: 
0, cx: 
0, cy: 
0, cw: 
0, ch: 
0, lock: 
[process: 
PROCESS#0B, count: 
0B (0)], tipTable: 
NIL, name: 
NIL, file: 
NIL, label: 
NIL, menu: 
NIL, icon: 
177777B?, column: 
left, caption: 
FALSE, scrollable: 
TRUE, hscrollable: 
FALSE, iconic: 
TRUE, border: 
TRUE, newVersion: 
FALSE, newFile: 
FALSE, visible: 
TRUE, offDeskTop: 
FALSE, destroyed: 
FALSE, init: 
FALSE, saveInProgress: 
FALSE, inhibitDestroy: 
FALSE, guardDestroy: 
FALSE, paintingWedged: 
FALSE, spare0: 
FALSE, spare1: 
FALSE, spare2: 
FALSE, spare3: 
FALSE, spare4: 
FALSE, spare5: 
FALSE, spare6: 
FALSE, position: 
0, openHeight: 
0, link: 
NIL, parent: 
NIL, sibling: 
NIL, child: 
NIL, props: 
NIL, data: 
NIL], paint: 
BOOL _ TRUE]˜K˜KšœXžœ˜_Kšœdžœ˜kKšœXžœ˜_KšœXžœ˜_Kšœdžœ˜kKšœOžœ˜VK˜K˜.K˜2K˜.K˜.K˜2K˜+K˜Kšœ{žœžœ˜‘
K–γ[info: 
ViewerClasses.ViewerRec _ [class: 
NIL, wx: 
0, wy: 
0, ww: 
0, wh: 
0, cx: 
0, cy: 
0, cw: 
0, ch: 
0, lock: 
[process: 
PROCESS#0B, count: 
0B (0)], tipTable: 
NIL, name: 
NIL, file: 
NIL, label: 
NIL, menu: 
NIL, icon: 
177777B?, column: 
left, caption: 
FALSE, scrollable: 
TRUE, hscrollable: 
FALSE, iconic: 
TRUE, border: 
TRUE, newVersion: 
FALSE, newFile: 
FALSE, visible: 
TRUE, offDeskTop: 
FALSE, destroyed: 
FALSE, init: 
FALSE, saveInProgress: 
FALSE, inhibitDestroy: 
FALSE, guardDestroy: 
FALSE, paintingWedged: 
FALSE, spare0: 
FALSE, spare1: 
FALSE, spare2: 
FALSE, spare3: 
FALSE, spare4: 
FALSE, spare5: 
FALSE, spare6: 
FALSE, position: 
0, openHeight: 
0, link: 
NIL, parent: 
NIL, sibling: 
NIL, child: 
NIL, props: 
NIL, data: 
NIL], font: 
ImagerFont.Font _ NIL, paint: 
BOOL _ TRUE]šœjžœ!žœ	žœ˜₯
Kšœ
žœžœ
žœ˜΅
Kš
œ1˜1K˜KšœRžœžœ
žœ˜zK˜!K˜!Kš
œ1˜1Kš
œ1˜1K˜K˜QK˜Kš
œY˜YK˜K˜—K˜
K˜Kšžœ
˜K˜—…—%μ;P