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
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 = {
PROC [parent: Viewer, clientData: REF ANY ← NIL,
mouseButton: MouseButton ← red, shift, control: BOOL ← FALSE];
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 = {
PROC [intervalName: ATOM, process: CARD, starts, totalMsec, minMsec, maxMsec, maxIndex, startsWithoutStops: CARD, level: NAT ← 0] RETURNS [done: BOOL ← FALSE];
This should do duplicate suppression
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 = {
PROC [tableName: ATOM, table: Table] RETURNS [done: BOOL ← FALSE];
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 = {
PROC [parent: Viewer, clientData: REF ANY ← NIL, mouseButton: MouseButton ← red, shift, control: BOOL ← FALSE];
toolData: ToolData ¬ NARROW[clientData];
textViewer: Viewer ¬ toolData.textViewer;
ViewerTools.SetSelection[textViewer];
};
heraldLook: CHAR ¬ 'b;
entryHeight: INTEGER ¬ 20;
gap: INTEGER ¬ 5;
CreateCodeTimerTool: Commander.CommandProc = {
PROC [cmd: Handle] RETURNS [result: REF ← NIL, msg: ROPE ← NIL];
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.