<<>>
    <<CodeTimerToolImpl.mesa>>
        <<Copyright Ó 1989 by Xerox Corporation.  All rights reserved.>>
        <<Pier, February 15, 1989 12:07:45 pm PST>>
        <<Bier, April 18, 1990 5:53:38 pm PDT>>
        <<>>
    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.PutFR["%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.PutFR["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.PutF[" %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.PutFR["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.PutFR["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.PutF[" %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 the code timer tool of April, 1990", 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.