
<<[Ivy]<Swinehart>Top>VBag.DF=>VBagImpl.Mesa>>
<<Last Edited by: Spreitzer, September 1, 1983 4:47 pm>>
<<Last Edited by: Swinehart, November 19, 1983 3:01 pm>>
    DIRECTORY AMBridge, AMModel, AMModelBridge, AMTypes, Atom, Buttons, EvalQuote, Interpreter, IO, Menus, Rope, VBag, ViewerOps, 
    ViewerTools, ViewRec, VTables, WorldVM;

    VBagImpl: CEDAR PROGRAM
        IMPORTS AMBridge, AMModel, AMModelBridge, AMTypes, Atom, EvalQuote, Buttons, Interpreter, IO, Rope, ViewerOps, ViewerTools, 
        ViewRec, VTables, WorldVM
        EXPORTS VBag =

    BEGIN

    ROPE: TYPE = Rope.ROPE;
    Viewer: TYPE = ViewRec.Viewer;

    sep: ROPE _ ".";

    Create: PUBLIC PROC[name: ROPE] RETURNS [VTables.VTable] = {
        RETURN[VTables.Create[name: name, scrollable: TRUE]];
        };

    Start: PUBLIC PROC [table: VTables.VTable, ra: REF ANY, name: ROPE _ NIL] =
        BEGIN
        tv, rtv: AMTypes.TypedVariable;
        rv: ViewRec.RecordViewer;
        rep: ROPE;
        r, c: INTEGER;
        TRUSTED {
            tv _ AMBridge.TVForReferent[NEW [REF ANY _ ra]];
            rtv _ AMBridge.TVForReferent[ra]};
        IF name = NIL THEN [rep, name] _ Format[tv] ELSE [rep, ] _ Format[tv];
        rv _ ViewRec.ViewTV[
            agg: rtv,
            createOptions: [doAllRecords: TRUE],
            label: name,
            viewerInit: [iconic: FALSE, parent: table, scrollable: FALSE],
            paint: FALSE];
        NoteName[rv, name];
        [r, c]_VTables.GetRowsAndColumns[table];
        IF r=1 AND VTables.GetTableEntry[table,0,0]=NIL THEN r_0
            ELSE VTables.SetRowsAndColumns[table, r+1, c];
        VTables.SetTableEntry[
            table: table, row: r, column: 0, name: name, flavor: $Viewer,
                clientData: ViewRec.RVQuaViewer[rv]];
        VTables.Install[table, TRUE];
        END;

    Frames: PUBLIC PROC [name: ROPE] = TRUSTED
        BEGIN
        Found: UNSAFE PROC [c: AMModel.Context] RETURNS [stop: BOOL] =
            BEGIN
            gf: AMTypes.TypedVariable _ AMModelBridge.FrameFromContext[c];
            rv: ViewRec.RecordViewer;
            rv _ ViewRec.ViewTV[
                agg: AMTypes.Globals[gf],
                createOptions: [doAllRecords: TRUE],
                viewerInit: [iconic: FALSE, name: name],
                paint: TRUE];
            NoteName[rv, name];
            stop _ FALSE;
            END;
        [] _ AMModel.NamedContexts[context: AMModel.RootContext[WorldVM.LocalWorld[]], name: name, proc: Found];
        END;

    RecognizeAggRef: ViewRec.Recognizer--PROC [t: Type, onlyRecognize: BOOLEAN, specs: BindingList, createOptions: CreateOptions] 
    RETURNS [IKnowYou: BOOLEAN, handler: Handler, handlerData: REF ANY _ NIL]-- =
        BEGIN
        ut: AMTypes.Type _ t;
        utc: AMTypes.Class _ AMTypes.TypeClass[ut];
        IF utc = definition THEN
            utc _ AMTypes.TypeClass[ut _ AMTypes.UnderType[ut]];
        SELECT utc FROM
            ref, list, pointer, longPointer => RETURN [TRUE, arHandler];
            ENDCASE;
        IKnowYou _ FALSE;
        END;

    arHandler: ViewRec.ComplexHandler _ NEW [ViewRec.ComplexHandlerRep _ [
        producer: ARProduce,
        updater: ARUpdate]];

    ARData: TYPE = REF ARDataRep;
    ARDataRep: TYPE = RECORD [
        name: ROPE,
        tv: AMTypes.TypedVariable,
        rv: ViewRec.RecordViewer];

    ARProduce: ViewRec.ComplexProducer--PROC [tv: TypedVariable, context: Context, handlerData: REF ANY] RETURNS [v: Viewer, 
    clientData: REF ANY, sampleable: BOOLEAN _ TRUE]-- =
        BEGIN
        name: ROPE _ context.name.Cat[": ", Format[tv].rope];
        ard: ARData _ NEW [ARDataRep _ [context.name, tv, context.for]];
        v _ Buttons.Create[
            info: [
                parent: context.main,
                name: name.Cat["1234567"],
                border: FALSE],
            proc: ARProc,
            clientData: ard,
            fork: FALSE,
            paint: FALSE];
        Buttons.ReLabel[button: v, newName: name, paint: FALSE];
        clientData _ ard;
        END;

    ARUpdate: ViewRec.Updater--PROC [tv: TypedVariable, v: Viewer, handlerData, clientData: REF ANY]-- =
        BEGIN
        ard: ARData _ NARROW[clientData];
        label: ROPE _ ard.name.Cat[": ", Format[tv].rope];
        Buttons.ReLabel[button: v, newName: label];
        END;

    ARProc: Menus.ClickProc--PROC [parent: REF ANY, clientData: REF ANY _ NIL, mouseButton: MouseButton _ red, shift, control: BOOL _ 
    FALSE]-- =
        BEGIN
        ard: ARData _ NARROW[clientData];
        rtv: AMTypes.TypedVariable;
        rut: AMTypes.Type;
        rutc: AMTypes.Class;
        ard.rv.DisplayMessage[ViewRec.clearMessagePlace];
        IF NOT ViewRec.FinishPendingBusiness[] THEN RETURN;
        IF control THEN
            BEGIN
            ard.rv.DisplayMessage["Left Clicking this button creates a new Record Viewer on the referent of this address.
            Middle Clicking evaluates the current Tioga selection, and assigns.
            Right Clicking selects current value to be result of &FromVBug[].
            Control clicking displays this message"];
            RETURN;
            END;
        SELECT mouseButton FROM
            red => BEGIN
                IF AMTypes.IsNil[ard.tv] THEN
                    {ard.rv.DisplayMessage["Can't dereference NIL"]; RETURN};
                IF NOT (AMTypes.IsAtom[ard.tv] OR AMTypes.IsRope[ard.tv]) THEN
                    BEGIN
                    rtv _ AMTypes.Referent[ard.tv];
                    rut _ AMTypes.TVType[rtv];
                    rutc _ AMTypes.TypeClass[rut];
                    IF rutc = definition THEN rutc _ AMTypes.TypeClass[rut _ AMTypes.UnderType[rut]];
                    SELECT rutc FROM
                        record, structure, array, sequence =>
                            BEGIN
                            rep, name: ROPE;
                            rv: ViewRec.RecordViewer;
                            [rep, name] _ Format[ard.tv];
                            IF name = NIL THEN
                                BEGIN
                                IF (name _ GetName[ard.rv]).Length[] > 0 THEN
                                    rep _ Rope.Cat[name _ name.Cat[".", ard.name], sep, rep];
                                END;
                            rv _ ViewRec.ViewTV[
                                agg: rtv,
                                createOptions: [doAllRecords: TRUE],
                                viewerInit: [iconic: FALSE, name: rep],
                                paint: TRUE];
                            NoteName[rv, name];
                            RETURN;
                            END;
                        ENDCASE;
                    END;
                ard.rv.DisplayMessage["Not referencing an aggregate"];
                END;
            yellow => BEGIN
                asRope: ROPE _ ViewerTools.GetSelectionContents[];
                val: AMTypes.TypedVariable;
                errMess: ROPE _ NIL;
                noResult: BOOLEAN _ TRUE;
                [val, errMess, noResult] _ Interpreter.Evaluate[asRope];
                IF errMess.Length[] > 0 THEN ard.rv.DisplayMessage[errMess]
                ELSE IF noResult THEN ard.rv.DisplayMessage["No result"]
                ELSE AMTypes.Assign[ard.tv, val !AMTypes.Error => {
                    ard.rv.DisplayMessage["Assign failed"];
                    CONTINUE}];
                END;
            blue => BEGIN
                toExec _ ard.tv;
                <<UserExec.DoIt[" _ &FromVBug[]", exec];>>
                END;
            ENDCASE => ERROR;
        END;

    toExec: AMTypes.TypedVariable _ NIL;

    Format: PROC [tv: AMTypes.TypedVariable] RETURNS [rope, name: ROPE] = TRUSTED {
        name _ NIL;
        IF AMTypes.IsNil[tv] THEN rope _ "NIL"
        ELSE IF AMTypes.IsRope[tv]
            THEN rope _ IO.PutFR["%g", IO.refAny[AMTypes.TVToName[tv]]]
        ELSE IF AMTypes.IsAtom[tv]
            THEN rope _ IO.PutFR["%g", IO.refAny[AMBridge.TVToATOM[tv]]]
        ELSE {
            referent: AMTypes.TypedVariable _ AMTypes.Referent[tv];
            SELECT AMTypes.TypeClass[AMTypes.UnderType[AMTypes.TVType[referent]]] FROM
                record, structure => name _ ViewRec.GetName[referent];
                ENDCASE => name _ NIL;
            rope _ IF name # NIL THEN Rope.Cat[name, sep] ELSE NIL;
            rope _ rope.Concat[IO.PutFR["%b^", IO.card[AMBridge.TVToLC[tv]]]];
            }
        };

    nameProp: ATOM _ Atom.MakeAtom["Mike Spreitzer December 12, 1983 10:45 pm"];

    NoteName: PROC [rv: ViewRec.RecordViewer, name: ROPE] =
        BEGIN
        v: Viewer _ rv.RVQuaViewer[];
        ViewerOps.AddProp[v, nameProp, name];
        END;

    GetName: PROC [rv: ViewRec.RecordViewer] RETURNS [name: ROPE] =
        BEGIN
        v: Viewer _ rv.RVQuaViewer[];
        name _ NARROW[ViewerOps.FetchProp[v, nameProp]];
        END;

    FromVBug: EvalQuote.EvalQuoteProc--PROC [head: EvalHead, tree: Tree, target: Type _ nullType, data: REF _ NIL] RETURNS [return: 
    TV]-- =
        BEGIN
        return _ toExec;
        END;

    Setup: PROC =
        BEGIN
        ViewRec.RegisterRecognizerByType[RecognizeAggRef, Back, CODE[REF BOOL], TypeClass];
        ViewRec.RegisterRecognizerByType[RecognizeAggRef, Back, CODE[POINTER TO BOOL], TypeClass];
        ViewRec.RegisterRecognizerByType[RecognizeAggRef, Back, CODE[LONG POINTER TO BOOL], TypeClass];
        ViewRec.RegisterRecognizerByType[RecognizeAggRef, Back, CODE[LIST OF CARDINAL], TypeClass];
        EvalQuote.Register[name: "&FromVBug", proc: FromVBug, symTab: NIL];
        END;

    Setup[];

    END.