
    <<GenericToolImpl.mesa>>
        <<Copyright © 1986 by Xerox Corporation.  All rights reserved.>>
        <<Demers, January 31, 1986 3:42:33 pm PST>>
        <<Hal Murray, May 5, 1986 11:20:13 pm PDT>>
    <<>>
    DIRECTORY
        Abutters USING [Abutter, Create, QuaViewer, Series, SetLayout],
        AMTypes USING [UnderType],
        GenericTool USING [ButtonProc, Option, OptionList, ROPE, STREAM, ToolHandle, ToolObject],
        IO USING [PutF, STREAM],
        Loader USING [BCDBuildTime],
        Rope USING [Cat, ROPE],
        SafeStorage USING [GetReferentType],
        TypeScript USING [Create],
        ViewerClasses USING [Viewer, ViewerRec],
        ViewerEvents USING [EventProc, RegisterEventProc],
        ViewerIO USING [CreateViewerStreams],
        ViewerOps USING [AddProp, FetchProp],
        ViewRec USING [BindAllOfANameInType, BindAllOfATypeFromRefs, Binding, BindingList, BindingListAppend, clearMessagePlace, 
        DisplayMessage, RecordViewer, RVQuaViewer, Type, ViewerQuaRV, ViewRef];

    GenericToolImpl: CEDAR PROGRAM
    IMPORTS Abutters, AMTypes, IO, Loader, Rope, SafeStorage, TypeScript, ViewerEvents, ViewerIO, ViewerOps, ViewRec
    EXPORTS GenericTool
    ~ BEGIN
        OPEN GenericTool;

        CreateInstance: PUBLIC PROC [
        toolName: ROPE,
        control: REF ANY,
        options: OptionList _ NIL,
        data: REF ANY _ NIL,
        preDestroy: ButtonProc _ NIL]
        RETURNS [tH: ToolHandle] ~ {
            bL: ViewRec.BindingList _ LIST[];
            controlType: ViewRec.Type ~ AMTypes.UnderType[SafeStorage.GetReferentType[control]];

            tH _ NEW[ToolObject _ [control~control, data~data]];
            bL _ ViewRec.BindAllOfATypeFromRefs[
                rec~control,
                handle~NEW[ToolHandle _ tH],
                visible~TRUE];

            FOR finger: OptionList _ options, finger.rest WHILE finger # NIL DO
                next: ViewRec.BindingList;
                WITH finger.first SELECT FROM
                    ro: readonly Option => {
                        next _ ViewRec.BindAllOfANameInType[
                            agType~controlType,
                            name~ro.name,
                            b~[
                                name~NIL,
                                it~Value[val~NIL, visible~TRUE, editable~FALSE, dontAssign~TRUE]
                                ]
                            ];
                        };
                    inv: invisible Option => {
                        next _ ViewRec.BindAllOfANameInType[
                            agType~controlType,
                            name~inv.name,
                            b~[
                                name~NIL,
                                it~Value[val~NIL, visible~FALSE, editable~FALSE, dontAssign~TRUE]
                                ]
                            ];
                        };
                    nfy: notify Option => TRUSTED {
                        next _ ViewRec.BindAllOfANameInType[
                            agType~controlType,
                            name~nfy.name,
                            b~[
                                name~NIL,
                                it~Notify[notify~LOOPHOLE[nfy.proc], clientData~tH]
                                ]
                            ];
                        };
                    ENDCASE => ERROR;
                bL _ ViewRec.BindingListAppend[a~bL, b~next];
                ENDLOOP;

            tH.abutter _ Abutters.Create[
                viewerFlavor~NIL, info~[name~toolName, label~toolName, scrollable~FALSE, caption~TRUE],
                paint~FALSE];
            tH.logViewer _ TypeScript.Create[
                info~[
                    parent~Abutters.QuaViewer[tH.abutter]],
                paint~FALSE
                ];
            { logName: ROPE ~ Rope.Cat[toolName, ".log"];
                [in~tH.in, out~tH.out] _ ViewerIO.CreateViewerStreams[name~logName, viewer~tH.logViewer, backingFile~logName, editedStream~FALSE] };
            tH.controlsViewer _ ViewRec.RVQuaViewer[ ViewRec.ViewRef[
                agg~control,
                specs~bL, 
                createOptions~[relayoutable~FALSE, doAllRecords~TRUE, exclusiveProcs~FALSE],
                viewerInit~[
                    parent~Abutters.QuaViewer[tH.abutter]],
                paint~FALSE
                ] ];
            Abutters.SetLayout[
                a~ tH.abutter,
                rules~[
                    left~[
                        rigid~LIST [],
                        end~parallel[
                            p~LIST [
                                [rigid~LIST [], end~stretch[se~[viewer~tH.controlsViewer]]],
                                [rigid~LIST [], end~stretch[se~[viewer~tH.logViewer]]]
                                ]
                            ]
                        ],
                    right~[
                        rigid~LIST [],
                        end~parallel[
                            p~LIST [
                                [rigid~LIST [], end~stretch[se~[viewer~tH.controlsViewer]]],
                                [rigid~LIST [], end~stretch[se~[viewer~tH.logViewer]]]
                                ]
                            ]
                        ],
                    top~[
                        rigid~LIST [ [viewer~tH.controlsViewer] ],
                        end~stretch[se~[viewer~tH.logViewer]]
                        ],
                    bottom~[
                        rigid~LIST [],
                        end~stretch[se~[viewer~tH.logViewer]]
                        ]
                    ],
                paint~TRUE
                ];
            tH.preDestroy _ preDestroy;
            ViewerOps.AddProp[Abutters.QuaViewer[tH.abutter], $ToolHandle, tH];
            [] _ ViewerEvents.RegisterEventProc[proc~DestroyEventProc, event~destroy, filter~Abutters.QuaViewer[tH.abutter], before~TRUE];
            IO.PutF[tH.out, "%g of %g\n\n",
            [rope[toolName]], [time[Loader.BCDBuildTime[CreateInstance]]]
                ];

            };

        DestroyEventProc: ViewerEvents.EventProc
            <<[viewer: Viewer, event: ViewerEvent, before: BOOL] RETURNS [abort: BOOL _ FALSE]>>
            ~ {
            tH: ToolHandle;
            IF event # destroy OR before # TRUE THEN ERROR;
            IF (tH _ NARROW[ViewerOps.FetchProp[viewer, $ToolHandle]]) = NIL THEN RETURN;
            IF tH.preDestroy = NIL THEN RETURN;
            tH.preDestroy[tH];
            };

        PutMsgRope: PUBLIC PROC [tH: ToolHandle, rope: ROPE, clear: BOOL _ FALSE] ~ {
            rv: ViewRec.RecordViewer ~ ViewRec.ViewerQuaRV[tH.controlsViewer];
            IF clear THEN ViewRec.DisplayMessage[rv~rv, msg~ViewRec.clearMessagePlace];
            ViewRec.DisplayMessage[rv~rv, msg~rope];
            };

        END.