
    <<ViewerOpsImplB.mesa>>
        <<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
        <<Doug Wyatt, April 21, 1985 4:04:37 pm PST>>
        <<Russ Atkinson (RRA) August 7, 1985 9:15:55 pm PDT>>
    <<>>
    DIRECTORY
        Carets USING [ResumeCarets, SuspendCarets],
        CedarProcess USING [DoWithPriority],
        Cursors USING [InvertCursor, SetCursor],
        InputFocus USING [GetInputFocus, SetInputFocus],
        Menus USING [CopyMenu, Menu],
        MessageWindow USING [Append, Blink],
        RefTab USING [Create, Fetch, Ref, Store],
        Rope USING [Compare, ROPE],
        TIPUser USING [TIPScreenCoords],
        ViewerBLT USING [Invalidate],
        ViewerClasses USING [Column, Viewer, ViewerClass, ViewerFlavor],
        ViewerEvents USING [ProcessEvent],
        ViewerForkers USING [ForkPaint],
        ViewerLocks USING [CallUnderViewerTreeLock, CallUnderWriteLock],
        ViewerGroupLocks USING [CallRootAndLinksUnderWriteLock],
        ViewerOps USING [ComputeColumn, EnumProc, EstablishViewerPosition, PaintViewer],
        ViewerPrivate USING [GreyScreen, rootViewerTree, WaitForPaintingToFinish],
        ViewerSpecs USING [captionHeight, menuBarHeight, menuHeight, windowBorderSize],
        WindowManager USING [colorDisplayOn];

    ViewerOpsImplB: CEDAR PROGRAM
        IMPORTS Carets, CedarProcess, Cursors, InputFocus, Menus, MessageWindow, RefTab, Rope, ViewerBLT, ViewerEvents, ViewerForkers, 
        ViewerGroupLocks, ViewerLocks, ViewerOps, ViewerPrivate, ViewerSpecs, WindowManager
        EXPORTS ViewerClasses, ViewerOps
        SHARES Menus, ViewerEvents
        = BEGIN OPEN ViewerClasses, ViewerSpecs, ViewerOps, WindowManager;

        ROPE: TYPE = Rope.ROPE;

    classTable: RefTab.Ref _ RefTab.Create[mod:31];
        <<to hold viewer classes >>

    RegisterViewerClass: PUBLIC PROC [flavor: ViewerFlavor, class: ViewerClass] = {
        <<let the Viewer package know about a new class of viewer.>>
        class.flavor _ flavor;
        [] _ RefTab.Store[classTable, flavor, class];
        };

    FetchViewerClass: PUBLIC PROC [flavor: ViewerFlavor] RETURNS [ViewerClass] = {
        <<class information from an existing viewer class.>>
        IF flavor = $TypeScript THEN flavor _ $Typescript;
        RETURN[NARROW[RefTab.Fetch[classTable, flavor].val]];
        };
    <<>>
    EnumerateViewers: PUBLIC PROC [enum: EnumProc] = {
        <<Safe in that caller can move the enumerated viewer in the tree in which case all viewers get seen at least once>>
        FOR c: Column DECREASING IN Column DO -- decreasing so will try static viewers last
            v: Viewer _ ViewerPrivate.rootViewerTree[c];
            next: Viewer;
            UNTIL v=NIL DO
                next _ v.sibling;
                IF ~enum[v] THEN RETURN;
                v _ next;
                ENDLOOP;
            ENDLOOP;
        };

    EnumerateChildren: PUBLIC PROC [viewer: Viewer, enum: EnumProc] = {
        v: Viewer _ viewer.child;
        next: Viewer;
        WHILE v#NIL DO
            next _ v.sibling;
            EnumerateChildren[v, enum];
            IF ~enum[v] THEN RETURN;
            v _ next; 
            ENDLOOP;
        };

    FindViewer: PUBLIC PROC [name: ROPE] RETURNS [viewer: Viewer] = {
        MatchName: EnumProc = {
            IF Rope.Compare[name, v.name, FALSE]=equal THEN {
                viewer _ v;
                RETURN[FALSE];
                }
            ELSE RETURN[TRUE];
            };
        EnumerateViewers[MatchName];
        };
    <<>>
    SaveAborted: PUBLIC ERROR [error: ROPE] = CODE; -- exported to ViewerClasses

    SaveViewer: PUBLIC PROC [viewer: Viewer] = {
        innerSaveFile: PROC = {
            list: LIST OF Viewer;
            errorMessage: ROPE _ NIL;

            <<First interogate the preSave procedures registered for this viewer to see if we should abort the save.>>
            FOR v: Viewer _ viewer, v.link WHILE v # NIL DO
                IF ViewerEvents.ProcessEvent[save, v, TRUE].abort THEN RETURN;
                IF v.link = viewer THEN EXIT;
                ENDLOOP;

            <<Now post the Save message in the caption(s)>>
            FOR v: Viewer _ viewer, v.link WHILE v # NIL DO
                v.saveInProgress _ TRUE;
                PaintViewer[v, caption, FALSE];
                list _ CONS[v, list];
                IF v.link = viewer THEN EXIT;
                ENDLOOP;

            <<Now call the Save procedure for the class (if any)>>
            IF viewer.class.save=NIL
                THEN errorMessage _ "no save procedure in viewer class"
                ELSE viewer.class.save[viewer ! SaveAborted => { errorMessage _ error; CONTINUE }];
            IF errorMessage#NIL THEN {
                MessageWindow.Append["Can't SAVE -- ", TRUE];
                MessageWindow.Append[errorMessage];
                MessageWindow.Blink[];
                };

            <<Finally, post the notice that the viewer is no longer being saved, and notify the postSave procedures registered for this viewer.>>
            FOR saved: LIST OF Viewer _ list, saved.rest UNTIL saved = NIL DO
                v: Viewer = saved.first;
                IF v.destroyed THEN LOOP;
                IF errorMessage=NIL THEN v.newVersion _ v.newFile _ FALSE;
                v.saveInProgress _ FALSE;
                PaintViewer[v, caption, FALSE];
                [] _ ViewerEvents.ProcessEvent[save, v, FALSE];
                ENDLOOP;
            };
        ViewerGroupLocks.CallRootAndLinksUnderWriteLock[innerSaveFile, viewer];
        };

    RestoreViewer: PUBLIC PROC [viewer: Viewer] = {
        <<RRA: for some reason, reset of a split viewer is fatal.  I don't have time to fix this, but I can keep it from hurting anyone (I 
        think).>>
        innerRestore: PROC = {
            IF viewer.link # NIL THEN {linked _ TRUE; RETURN};
            KillInputFocus[viewer];
            IF viewer.class.init # NIL THEN viewer.class.init[viewer];
            viewer.newVersion _ viewer.newFile _ FALSE;
            ViewerForkers.ForkPaint[viewer: viewer, hint: all];
            };
        linked: BOOL _ FALSE;
        ViewerGroupLocks.CallRootAndLinksUnderWriteLock[innerRestore, viewer];
        IF linked THEN {
            MessageWindow.Append["Sorry, can't reset a split viewer!"];
            MessageWindow.Blink[];
            };
        };

    KillInputFocus: PROC [viewer: Viewer] = {
        focus: Viewer _ InputFocus.GetInputFocus[].owner;
        WHILE focus # NIL DO
            IF focus # viewer
                THEN focus _ focus.parent
                ELSE {InputFocus.SetInputFocus[]; EXIT};
            ENDLOOP;
        };

    SetMenu: PUBLIC PROC [viewer: Viewer, menu: Menus.Menu, paint: BOOL _ TRUE] = {
        sameSize: BOOL = (menu#NIL AND viewer.menu#NIL AND
            viewer.menu.linesUsed=menu.linesUsed);
        IF viewer.iconic THEN paint _ FALSE;
        IF viewer.parent # NIL THEN ERROR;
        viewer.menu _ IF menu=NIL THEN NIL ELSE Menus.CopyMenu[menu];
        IF ~sameSize AND paint THEN
            EstablishViewerPosition[viewer, viewer.wx, viewer.wy, viewer.ww, viewer.wh];
        IF paint THEN
            ViewerForkers.ForkPaint[viewer: viewer, hint: IF sameSize THEN menu ELSE all, tryShortCuts: TRUE];
        };

    IndicateNewVersion: PUBLIC PROC [viewer: Viewer] = {
        <<Can't lock this because some callers do not have the proper locks set.  The code is reasonably careful, and we fork all of the 
        paints.>>
        FOR v: Viewer _ viewer, v.link WHILE v # NIL DO
            IF ViewerEvents.ProcessEvent[edit, v, TRUE].abort THEN RETURN;
            IF v.link = viewer THEN EXIT;
            ENDLOOP;
        FOR v: Viewer _ viewer, v.link WHILE v # NIL DO
            v.newVersion _ TRUE;
            ViewerForkers.ForkPaint[viewer: v, hint: caption, tryShortCuts: TRUE];
            [] _ ViewerEvents.ProcessEvent[edit, v, FALSE];
            IF v.link = viewer THEN EXIT;
            ENDLOOP;
        };

    SetNewFile: PUBLIC PROC [viewer: Viewer] = {
        <<Can't lock this because some callers do not have the proper locks set.  The code is reasonably careful, and we fork all of the 
        paints.>>
        FOR v: Viewer _ viewer, v.link WHILE v # NIL DO
            v.newFile _ TRUE;
            ViewerForkers.ForkPaint[viewer: v, hint: caption, tryShortCuts: TRUE];
            IF v.link = viewer THEN EXIT;
            ENDLOOP;
        };

    SetOpenHeight: PUBLIC PROC [viewer: Viewer, clientHeight: INTEGER] = {
        innerSetHeight: PROC = {
            wbs: INTEGER ~ IF viewer.border THEN ViewerSpecs.windowBorderSize ELSE 0;
            h: INTEGER _ clientHeight;
            h _ h+(IF viewer.caption THEN ViewerSpecs.captionHeight ELSE wbs); -- top border or caption
            IF viewer.menu#NIL THEN {
                <<menu and menu bar>>
                lines: NAT ~ viewer.menu.linesUsed;
                h _ h+lines*ViewerSpecs.menuHeight+ViewerSpecs.menuBarHeight;
                };
            h _ h+wbs; -- bottom border
            viewer.openHeight _ h;
            };
        ViewerLocks.CallUnderWriteLock[innerSetHeight, viewer];
        };

    SaveAllEdits: PUBLIC PROC = {
        <<poor man's crash recovery>>
        Save: EnumProc = {
            Cursors.InvertCursor[];
            IF (v.newVersion OR v.newFile) AND v.class.save # NIL THEN
                v.class.save[v, TRUE ! ANY => CONTINUE];
            v.newVersion _ v.newFile _ FALSE;
            IF v.icon=dirtyDocument THEN v.icon _ document;
            IF v.link#NIL THEN FOR t: Viewer _ v.link, t.link UNTIL t=v DO
                t.newVersion _ t.newFile _ FALSE;
                ENDLOOP;
            Cursors.InvertCursor[];
            RETURN[TRUE];
            };
        PaintCaption: EnumProc = { PaintViewer[v, caption] };
        inner: PROC = {
            Cursors.SetCursor[activate];
            EnumerateViewers[Save];
            Cursors.SetCursor[textPointer];
            EnumerateViewers[PaintCaption]; -- ok if this doesn't finish
            };
        CedarProcess.DoWithPriority[foreground, inner];
        };

    PaintEverything: PUBLIC PROC ~ {
        inner: PROC = {
            ViewerPrivate.GreyScreen[bw, 0, 0, 9999, 9999];
            ViewerBLT.Invalidate[];
            ComputeColumn[static];
            ComputeColumn[left];
            ComputeColumn[right];
            IF WindowManager.colorDisplayOn THEN ComputeColumn[color];
            };
        Carets.SuspendCarets[];
        ViewerLocks.CallUnderViewerTreeLock[inner];
        ViewerPrivate.WaitForPaintingToFinish[];
        Carets.ResumeCarets[];
        };

    UserToScreenCoords: PUBLIC PROC [self: Viewer, vx, vy: INTEGER _ 0] 
    RETURNS [sx, sy: INTEGER] ~ {
    sx _ vx;
    sy _ vy;
    FOR viewer: Viewer _ self, viewer.parent UNTIL viewer=NIL DO
    parent: Viewer ~ viewer.parent;
        invert: BOOL ~ (parent#NIL AND parent.class.topDownCoordSys);
    sx _ sx+viewer.cx+viewer.wx;
    sy _ sy+viewer.cy+(IF invert THEN parent.ch-(viewer.wy+viewer.wh) ELSE viewer.wy);
    ENDLOOP;
        };

    TopLevelHit: PROC[x, y: INTEGER, color: BOOL] RETURNS[Viewer] = {
        FOR column: Column DECREASING IN Column DO
            firstInColumn: Viewer ~ ViewerPrivate.rootViewerTree[column];
            FOR v: Viewer _ firstInColumn, v.sibling UNTIL v=NIL DO
                IF x IN[v.wx..v.wx+v.ww) AND y IN[v.wy..v.wy+v.wh) 
                AND color=(v.column=color AND NOT v.iconic) THEN RETURN[v];
                ENDLOOP;
            ENDLOOP;
        RETURN[NIL];
        };

    ViewerHit: PROC [parent: Viewer, px, py: INTEGER] 
    RETURNS [viewer: Viewer, x, y: INTEGER, client: BOOL] ~ {
        IF NOT parent.iconic
        AND px IN[parent.cx..parent.cx+parent.cw)
        AND py IN[parent.cy..parent.cy+parent.ch)
            THEN {
                topDown: BOOL ~ parent.class.topDownCoordSys;
                x _ px-parent.cx; y _ py-parent.cy;
                FOR v: Viewer _ parent.child, v.sibling UNTIL v=NIL DO
                    wx: INTEGER ~ v.wx;
                    wy: INTEGER ~ IF topDown THEN parent.ch-(v.wy+v.wh) ELSE v.wy;
                    IF x IN[wx..wx+v.ww) AND y IN[wy..wy+v.wh) THEN
                        RETURN ViewerHit[v, x-wx, y-wy];
                    ENDLOOP;
                RETURN [viewer: parent, x: x, y: y, client: TRUE];
                }
            ELSE RETURN [viewer: parent, x: px, y: py, client: FALSE];
        };

    MouseInViewer: PUBLIC PROC[tsc: TIPUser.TIPScreenCoords] 
    RETURNS [viewer: Viewer _ NIL, client: BOOL _ FALSE] ~ {
        parent: Viewer ~ TopLevelHit[tsc.mouseX, tsc.mouseY, tsc.color];
        IF parent#NIL THEN
            [viewer, tsc.mouseX, tsc.mouseY, client] _ 
            ViewerHit[parent, tsc.mouseX-parent.wx, tsc.mouseY-parent.wy];
        };

    END.