
    <<WhiteboardOpsImpl.mesa>>
        <<Copyright © 1984, 1986 by Xerox Corporation. All rights reserved.>>
        <<Maxwell, June 25, 1984 1:31:29 pm PDT>>
        <<Cattell, September 1, 1983 10:40 am>>
        <<Donahue, June 13, 1986 9:12:27 am PDT>>
        <<(Changed to reflect new error-handling policy)>>
        <<(Fixed treatment of ShowPress viewers)>>
        <<(Fixed bug in opening tool viewers -- didn't get tool argument properly)>>
        <<(Removed working directory stuff to be consistent with new DBTools)>>
        <<(Replaced "AddTool" with "AddCommandFile")>>
        <<Widom, August 24, 1984 5:05:57 pm PDT>>
        <<Last Edited by: Winkler, December 18, 1984 4:51:56 pm PST>>
        <<Rick Beach, January 28, 1986 8:00:57 pm PST>>

    DIRECTORY
        Atom USING [MakeAtom],
        BasicTime USING [GMT, nullGMT],
        Commander USING [CommandProc, Register],
        Convert USING [RopeFromTime],
        DBDefs USING [Segment],
        DBIcons USING [Exists],
        DBNames USING [DecomposeName, MakeName],
        DBTools USING [ApplyTool, ViewerToTool],
        FileNames USING [GetShortName],
        Icons USING [IconFlavor],
        InputFocus USING [GetInputFocus, Focus],
        IO USING [EndOf, GetTokenRope, GetLineRope, RIS, SkipWhitespace, STREAM],
        Menus USING [FindEntry, MenuEntry, ReplaceMenuEntry],
        Nut USING [Display, GetNutInfo, NoRegistration, SetFrozenProperty],
        Process USING [Detach],
        Rope USING [Cat, Equal, IsEmpty, ROPE],
        TIPUser USING [TIPScreenCoords],
        ViewerClasses USING [Column, NotifyProc, Viewer, ViewerClass, ViewerFlavor, ViewerRec],
        ViewerOps USING [CloseViewer, EnumerateViewers, EnumProc, FetchProp, FindViewer, OpenIcon, PaintViewer],
        ViewerPrivate USING [InvertForMenus],
        ViewerTools USING [GetSelectedViewer, GetTiogaContents, TiogaContentsRec],
        WhiteboardDB USING [Close, CopyWB, Delete, Destroy, Display, Enumerate, Erase, EstablishWhiteboardDB, GetChildren, GetCreateDate, 
        GetIconProps, GetToolArgument, New, NewBox, NewIcon, stopped, WBError, WBExists, whiteboard],
        WhiteboardNut USING [CreateWBViewer, CreateTextViewer, DoCommandFile],
        WhiteboardOps USING [],
        WhiteboardViewers USING [DontLog, Expand, GrowBox, MoveChild, NearestChild];

    WhiteboardOpsImpl: CEDAR PROGRAM
    IMPORTS Atom, Commander, Convert, DBIcons, DBNames, DBTools, FileNames, InputFocus, IO, Menus, Nut, Process, Rope, ViewerOps, 
    ViewerPrivate, ViewerTools, WhiteboardDB, WhiteboardNut, WhiteboardViewers
    EXPORTS WhiteboardOps
    SHARES ViewerOps, ViewerClasses, Menus
    = BEGIN OPEN WhiteboardOps;

        ROPE: TYPE = Rope.ROPE;
<<Command interpreter>>
    Notify: PUBLIC ViewerClasses.NotifyProc = {
        OPEN WhiteboardViewers;
        p: TIPUser.TIPScreenCoords;
        FOR list: LIST OF REF ANY _ input, list.rest UNTIL list = NIL DO
            WITH list.first SELECT FROM
                z: ATOM => {
                    parent: ViewerClasses.Viewer = IF self.parent = NIL THEN self ELSE self.parent;
                    IF WhiteboardDB.stopped THEN LOOP;
                    SELECT z FROM
                        $Grow =>
                            IF parent.class.flavor = $Whiteboard THEN {
                                v: ViewerClasses.Viewer = NearestChild[self, p.mouseX, p.mouseY, $Text];
                                IF v # NIL THEN GrowBox[parent, v, p.mouseX, parent.ch -p.mouseY] };
                        $Instructions => {
                            [] _ WhiteboardDB.NewBox[self, 100, 100, 241, 116, 
                               NEW[ViewerTools.TiogaContentsRec _ [contents: "\nINSTRUCTIONS:\nLEFT => move entity\nshift LEFT => 
                            add text box\nctrl shift LEFT => copy text box\nctrl LEFT => delete entity\nMIDDLE => open icon\nshift 
                            MIDDLE => open icon fullsize\nctrl MIDDLE => expand whiteboard\nRIGHT => grow text box\n\n", 
                            formatting: "\000\000\000\006\000\000\235\312\000\215\000\000\002\230\000\002\232\002\233\b\002 
                            @\f\317s\001\230\nJ\232\003\233H\002 
                            
                            
                            
                            
                            
                            
                            
                            
                            
                            
                            
                            
                            
                            
                            
                            
                            
                            \000\004\236\004\320cs\013\230\023J\232\003\237\l\236\004\240\f\230\032J\232\005\237\004\234\001\237\l\236\004\240\n\230 
                            
                            
                            
                            
                            
                            
                            
                            
                            
                            
                            
                            
                            
                            
                            
                            
                            
                            
                            
                            
                            
                            
                            
                            
                            
                            
                            
                            
                            
                            
                            
                            
                            
                            
                            
                            
                            
                            
                            
                            
                            
                            
                            
                            
                            
                            
                            
                            J\232\003\237\t\236\004\240\n\230\032J\232\003\237\006\236\004\240\t\230\023J\232\003\237\f\236\004\240\022\230\"J\232\003\237\013\236\004\240\021\230 
                            
                            
                            
                            
                            
                            
                            
                            
                            
                            
                            
                            
                            
                            
                            J\232\003\237\005\236\004\240\n\230\026\227J\230\000\227\000\205\227\000\000\000\000\000\352\000\000\001}\000\000"]]];
                            };
                        $NewBox => {
                            [] _ WhiteboardDB.NewBox[parent, p.mouseX, parent.ch - p.mouseY, 128, 32];
                            };
                    $CopyBox => {
                    focus: InputFocus.Focus = InputFocus.GetInputFocus[];
                    boxToCopy: ViewerClasses.Viewer = IF focus = NIL THEN NIL ELSE focus.owner;
                    IF boxToCopy.parent = NIL OR boxToCopy.parent.class.flavor # $Whiteboard THEN RETURN; -- not a whiteboard text box
                    [] _ WhiteboardDB.NewBox[parent, p.mouseX, parent.ch - p.mouseY, boxToCopy.ww, boxToCopy.wh, 
                    ViewerTools.GetTiogaContents[boxToCopy]]
                     };
                        $Open => {
                            v: ViewerClasses.Viewer = NearestChild[self, p.mouseX, p.mouseY, $WhiteboardIcon];
                            IF v # NIL THEN OpenProc[v];
                            };
                        $OpenFull => {
                            v: ViewerClasses.Viewer = NearestChild[self, p.mouseX, p.mouseY, $WhiteboardIcon];
                            IF v # NIL THEN OpenFullProc[v];
                            };
                        $Remove => {
                            child: ViewerClasses.Viewer = NearestChild[self, p.mouseX, p.mouseY];
                            parent: ViewerClasses.Viewer = IF self.parent = NIL THEN self ELSE self.parent;
                            IF child = NIL THEN RETURN;
                            WhiteboardDB.Delete[child];
                            parent.newVersion _ TRUE;
                            ViewerOps.PaintViewer[parent, client];
                            ViewerOps.PaintViewer[parent, caption];
                            };
                        $Expand => {
                            v: ViewerClasses.Viewer = NearestChild[self, p.mouseX, p.mouseY];
                            parent: ViewerClasses.Viewer = IF self.parent = NIL THEN self ELSE self.parent;
                            name: ROPE;
                            type: ATOM;
                            IF v = NIL THEN RETURN;
                            [name, type] _ WhiteboardDB.GetIconProps[v];
                            IF type = WhiteboardDB.whiteboard AND WhiteboardDB.WBExists[name] THEN
                                TRUSTED{ Process.Detach[ FORK ExpandProc[parent, v, name] ] };
                            };
                        $Freeze => {
                            self: ViewerClasses.Viewer = NARROW[parent];
                            frozen: Menus.MenuEntry = Menus.FindEntry[self.menu, "Freeze"];
                            IF frozen = NIL THEN RETURN;
                            Menus.ReplaceMenuEntry[self.menu, frozen];
                            ViewerOps.PaintViewer[self, menu];
                            [] _ Nut.SetFrozenProperty[self, TRUE];
                            };
                        $AddSelected => {
                            icon: ViewerClasses.Viewer _ ViewerTools.GetSelectedViewer[];
                            parent: ViewerClasses.Viewer = IF self.parent = NIL THEN self ELSE self.parent;    
                            IF icon = NIL THEN RETURN;
                            WHILE icon.parent # NIL DO icon _ icon.parent ENDLOOP;
                            IF icon # NIL THEN AddNewIcon[parent, icon, 100, 100];
                            };
                        $AddCommandFile => {
                            parent: ViewerClasses.Viewer = IF self.parent = NIL THEN self ELSE self.parent;    
                            icon: ViewerClasses.Viewer _ ViewerTools.GetSelectedViewer[];
                            IF icon = NIL THEN RETURN;
                            IF icon.icon # document THEN RETURN;
                            [] _ WhiteboardDB.NewIcon[parent, 100, 100, icon.name, $ToolRope, "Typescript", FileNames.GetShortName[icon.name]];
                            };
                        $Erase => {
                            WhiteboardDB.Erase[self];
                            self.newVersion _ TRUE;
                            ViewerOps.PaintViewer[self, all];
                            };
                        $Move => {
                            child: ViewerClasses.Viewer = NearestChild[self, p.mouseX, p.mouseY];
                            IF child # NIL THEN MoveChild[child];
                            };
                        ENDCASE => NULL;
                    };
            z: TIPUser.TIPScreenCoords => p _ z;
            ENDCASE => NULL;
            ENDLOOP;
        };
<<Support routines>>
    AddNewIcon: PROC[wb, child: ViewerClasses.Viewer, x, y: INTEGER] = {
        name, label, iconName, argument: ROPE;
        segment: DBDefs.Segment;
        domain, entity: ROPE;
        [segment , domain, entity] _ Nut.GetNutInfo[child];
        IF NOT Rope.Equal[domain, NIL] AND NOT Rope.Equal[entity, NIL] THEN {
            IF Rope.Equal[domain, "Whiteboard"] THEN { -- it's one of ours!
                [] _ WhiteboardDB.NewIcon[wb, x, y, entity, WhiteboardDB.whiteboard, "Whiteboard"] }
            ELSE {
                name _ DBNames.MakeName[segment, domain, entity];
                iconName _ IF DBIcons.Exists[domain] THEN domain ELSE "Acorn";
                label _ NARROW[ViewerOps.FetchProp[child, $IconLabel]];
                IF Rope.IsEmpty[label] THEN label _ child.label;
                [] _ WhiteboardDB.NewIcon[wb, x, y, name, $Entity, iconName, label] };
            RETURN };
        IF child.icon = document AND child.class.flavor = $Text THEN {
            [] _ WhiteboardDB.NewIcon[wb, x, y, child.name, $Text, "Document", FileNames.GetShortName[child.name]];
            RETURN };
        <<otherwise it's a tool>>
        [name, argument] _ DBTools.ViewerToTool[child];
        IF name = NIL THEN
            <<try out the child before giving up (a  hack to handle ShowPress viewers)>>
            IF child.class.flavor = $Container AND child.child # NIL THEN {
                child _ child.child;
                [name, argument] _ DBTools.ViewerToTool[child] };
        IF name = NIL THEN RETURN; -- the viewer can't be mapped into a tool
        <<try finding an appropriate label from the tools database, the $IconLabel property, or the name of the tool>>
        IF child.class.flavor = $Sil OR child.class.flavor = $Press THEN {
            IF Rope.Equal[child.name, "No Name"] THEN label _ NIL
            ELSE { argument _ label; label _ FileNames.GetShortName[label] } }
        ELSE {
            label _ NARROW[ViewerOps.FetchProp[child, $IconLabel]];
            IF Rope.IsEmpty[label] THEN label _ child.label };
        <<it's a tool that creates a viewer; find an appropriate icon for it>>
        iconName _ IF DBIcons.Exists[name] THEN name ELSE "Tool";
        [] _ WhiteboardDB.NewIcon[wb, x, y, name, $Tool, iconName, label, argument];
        };

    OpenProc: PROC[ clientData: REF ANY ] = TRUSTED {
        Process.Detach[ FORK OpenIcon[NARROW[clientData]] ];
        };

    OpenIcon: PROCEDURE[icon: ViewerClasses.Viewer] = {
        ENABLE UNWIND => icon.spare0 _ FALSE; 
        name: ROPE;
        type: ATOM;
        IF icon = NIL THEN RETURN;
        <<invert the icon first to give information on when display complete>>
        ViewerPrivate.InvertForMenus[icon, 0, 0, icon.ww, icon.wh];
        icon.spare0 _ TRUE; -- remember that the viewer is inverted
        IF WhiteboardViewers.DontLog[icon] THEN {
            <<it's an ephemeral icon (one that doesn't really exist on the whiteboard); make it a whiteboard>>
            name _ icon.name;
            type _ WhiteboardDB.whiteboard }
        ELSE [name, type] _ WhiteboardDB.GetIconProps[icon];
        SELECT type FROM
            NIL => NULL;
            $Entity => { 
                domain, entity, segment: ROPE;
                seg: DBDefs.Segment;
                [domain ~ domain, entity ~ entity, segment ~ segment] _ DBNames.DecomposeName[name];
                seg _ IF NOT Rope.Equal[segment, ""] THEN Atom.MakeAtom[segment] ELSE NIL;
                IF seg # NIL THEN
                    [] _ Nut.Display[entity, domain, seg, icon.parent ! Nut.NoRegistration => { CONTINUE }] }; 
            $Whiteboard => WhiteboardNut.CreateWBViewer[name, icon.parent]; 
            $Text => WhiteboardNut.CreateTextViewer[name];
            $Tool => {
                <<Note: in the case of tools, the name of the viewer is taken as the argument to be provided (unless it has the same name as the 
                tool itself)>>
                v: ViewerClasses.Viewer _ ViewerOps.FindViewer[name];
                IF v = NIL OR v.destroyed THEN {
                    argument: ROPE = WhiteboardDB.GetToolArgument[icon];
                    DBTools.ApplyTool[name, argument] }
                ELSE { IF v.iconic THEN ViewerOps.OpenIcon[v]; ViewerOps.PaintViewer[v, all] } };
            $ToolRope => { WhiteboardNut.DoCommandFile[name] };
            ENDCASE;
        <<now repaint the icon that was inverted when this got started>>
        IF NOT icon.destroyed THEN
            ViewerPrivate.InvertForMenus[icon, 0, 0, icon.ww, icon.wh];
        icon.spare0 _ FALSE -- reset the inverted bit (checked by PaintIconic)
        }; 

    OpenFullProc: PROC[ clientData: REF ANY ] = {
        viewer: ViewerClasses.Viewer = NARROW[clientData];
        CloseViewers: ViewerOps.EnumProc = {
            IF v.column = viewer.column THEN ViewerOps.CloseViewer[v];
            };
        IF viewer # NIL THEN ViewerOps.EnumerateViewers[CloseViewers];
        TRUSTED { Process.Detach[ FORK OpenIcon[NARROW[clientData]] ] };
        };

    ExpandProc: PROC[parent, wb: ViewerClasses.Viewer, wbName: ROPE] = {
        wbList: LIST OF ROPE _ WhiteboardDB.GetChildren[wbName];
        WhiteboardViewers.Expand[parent, wb, wbList];
        };
<<Registration (with Commander)>>
    RegisterProcs: PROC[] = {
        Commander.Register[key: "Whiteboard", proc: DisplayIt, doc: "\nDisplays the named whiteboard"];

        Commander.Register[key: "WBDisplay", proc: DisplayIt, doc: "\nDisplays the named whiteboard"];

        Commander.Register[key: "WBCreate", proc: NewIt, doc: "Creates a new whiteboard with the given name"];

        Commander.Register[key: "WBDestroy", proc: DestroyIt, doc: "\nDestroys the named whiteboard (be careful!)"];

        Commander.Register[key: "WBCopy", proc: CopyIt, doc: "\nCopyWB <from> <to>  (for copying whiteboards)"];

        Commander.Register[key: "WBlist", proc: Enumerate,
         doc: "\nEnumerates whiteboards contained in the named whiteboard\n (Enumerates all whiteboards if no name is given)"];

        Commander.Register[key: "WBOpen", proc: OpenIt, doc: "\nWBOpen <file> opens a new whiteboard database (closing a previously open 
        one, if necessary)"];

        Commander.Register[key: "WBClose", proc: CloseIt, doc: "\nWBClose closes the database connections whiteboards uses and destroys all 
        current whiteboard viewers"];

        };

    DisplayIt: Commander.CommandProc = {
        ENABLE WhiteboardDB.WBError => {
            SELECT reason FROM
                $ServerDown => {msg _ "Display Failed -- server unavailable; retry later"; CONTINUE};
                $TransactionAbort => {msg _ "Display Failed -- transaction aborted; retry later"; CONTINUE};
                ENDCASE => REJECT;
            };
        h: IO.STREAM = IO.RIS[cmd.commandLine];
        name: ROPE;
        [] _ h.SkipWhitespace[];
        IF h.EndOf THEN {
            msg _ "A whiteboard name must be supplied.";
            RETURN };
        name _ h.GetTokenRope[].token;
        IF NOT WhiteboardDB.WBExists[name] THEN
            msg _ Rope.Cat["Whiteboard ", name, " doesn't exist."]
        ELSE [] _ WhiteboardDB.Display[name];
        };

    NewIt: Commander.CommandProc = {
        ENABLE WhiteboardDB.WBError => {
            SELECT reason FROM
                $ServerDown => {msg _ "Display Failed -- server unavailable; retry later"; CONTINUE};
                $TransactionAbort => {msg _ "Display Failed -- transaction aborted; retry later"; CONTINUE};
                $ReadOnly => {msg _ "Can't create new whiteboard -- database is readonly"; CONTINUE};
                ENDCASE => REJECT;
            };
        h: IO.STREAM = IO.RIS[cmd.commandLine];
        name: ROPE;
        [] _ h.SkipWhitespace[];
        IF h.EndOf THEN {
            msg _ "A whiteboard name must be supplied.";
            RETURN };
        name _ h.GetTokenRope[].token;
        IF WhiteboardDB.WBExists[name] THEN 
            msg _ Rope.Cat["Whiteboard ", name, " already exists."]
        ELSE [] _ WhiteboardDB.New[name];
        };

    DestroyIt: Commander.CommandProc = {
        ENABLE WhiteboardDB.WBError => {
            SELECT reason FROM
                $ServerDown => {msg _ "Destroy Failed -- server unavailable; retry later"; CONTINUE};
                $TransactionAbort => {msg _ "Destroy Failed -- transaction aborted; retry later"; CONTINUE};
                $ReadOnly => {msg _ "Destroy Failed -- database is readonly"; CONTINUE};
                ENDCASE => REJECT;
            };
        h: IO.STREAM = IO.RIS[cmd.commandLine];
        name: ROPE;
        [] _ h.SkipWhitespace[];
        IF h.EndOf THEN {
            msg _ "A whiteboard name must be supplied.";
            RETURN };
        name _ h.GetTokenRope[].token;
        IF NOT WhiteboardDB.WBExists[name] THEN msg _ "No such whiteboard"
            ELSE WhiteboardDB.Destroy[name];
        };

    CopyIt: Commander.CommandProc = {
        ENABLE WhiteboardDB.WBError => {
            SELECT reason FROM
                $ServerDown => {msg _ "Copy Failed -- server unavailable; retry later"; CONTINUE};
                $TransactionAbort => {msg _ "Copy Failed -- transaction aborted; retry later"; CONTINUE};
                $ReadOnly => {msg _ "Copy Failed -- database is readonly"; CONTINUE};
                ENDCASE => REJECT;
            };
        h: IO.STREAM = IO.RIS[cmd.commandLine];
        from, to: ROPE;
        [] _ h.SkipWhitespace[];
        IF h.EndOf THEN {
            msg _ "Syntax is:  CopyWB <from> <to>";
            RETURN };
        from _ h.GetTokenRope[].token;
        [] _ h.SkipWhitespace[];
        IF h.EndOf THEN {
            msg _ "Syntax is:  CopyWB <from> <to>";
            RETURN };
        to _ h.GetTokenRope[].token;
        IF NOT WhiteboardDB.WBExists[from] THEN {
            msg _ "No such whiteboard to copy from";
            RETURN };
        WhiteboardDB.CopyWB[from, to];
        };

    Enumerate: Commander.CommandProc = {
        ENABLE WhiteboardDB.WBError => {
            SELECT reason FROM
                $ServerDown => {msg _ "Enumerate Failed -- server unavailable; retry later"; CONTINUE};
                $TransactionAbort => {msg _ "Enumerate Failed -- transaction aborted; retry later"; CONTINUE};
                ENDCASE => REJECT;
            };
        h: IO.STREAM = IO.RIS[cmd.commandLine];
        pattern: ROPE;
        wbList: LIST OF ROPE;
        [] _ h.SkipWhitespace[];
        IF h.EndOf THEN pattern _ NIL ELSE pattern _ h.GetLineRope[];
        wbList _ WhiteboardDB.Enumerate[pattern];
        IF wbList = NIL THEN msg _ "No whiteboards matching pattern"
        ELSE TRUSTED {
            FOR wbNames: LIST OF ROPE _ wbList, wbNames.rest UNTIL wbNames = NIL DO
                createDate: BasicTime.GMT = WhiteboardDB.GetCreateDate[wbNames.first];
                dateRope: Rope.ROPE = IF createDate = BasicTime.nullGMT THEN "unknown" ELSE LOOPHOLE[Convert.RopeFromTime[createDate]];
                msg _ Rope.Cat[msg, wbNames.first, "  last edited: "];
                msg _ Rope.Cat[msg, dateRope, "\n"]
                ENDLOOP;
            };
        };

    OpenIt: Commander.CommandProc = {
        ENABLE WhiteboardDB.WBError => {
            SELECT reason FROM
                $ServerDown => {msg _ "Server unavailable; retry later"; CONTINUE};
                $NoDatabaseOpen => {msg _ "Must supply a database name"; CONTINUE};
                ENDCASE => REJECT;
            };
        h: IO.STREAM = IO.RIS[cmd.commandLine];
        name: ROPE;
        [] _ h.SkipWhitespace[];
        IF h.EndOf THEN name _ NIL ELSE name _ h.GetLineRope[];
        WhiteboardDB.EstablishWhiteboardDB[name]
        };

    CloseIt: Commander.CommandProc = { WhiteboardDB.Close[] };
<<Initialization>>
    RegisterProcs[];

    END.

    <<>>
    <<>>