
    <<XTkMigrationImpl.mesa>>
        <<Copyright Ó 1991, 1992 by Xerox Corporation.  All rights reserved.>>
        <<Christian Jacobi, September 5, 1991 4:29 pm PDT>>
        <<Christian Jacobi, May 11, 1992 10:28 am PDT>>
        <<>>
    DIRECTORY Rope, Xl, XTk, XTkMigration, XTkShellWidgets;

    XTkMigrationImpl: CEDAR MONITOR
        IMPORTS Xl, XTk, XTkShellWidgets
        EXPORTS XTkMigration
        SHARES Xl <<errorMatch>> ~ 
    BEGIN

    TryMigrate: Xl.EventProcType = {
        migrateAtom, migrationOwnerAtom: Xl.XAtom;
        shell: XTk.Widget ~ NARROW[clientData];
        ev: Xl.ClientMessageEvent ~ NARROW[event];
        connection: Xl.Connection ~ ev.connection;
        IF ev.window#shell.window OR ev.format#32 THEN RETURN;
        IF ~Xl.Alive[connection] THEN RETURN;
        BEGIN
            ENABLE Xl.XError, UNCAUGHT => GOTO oops; --avoid crashes which have nothing to do with migration
            IF ev.typeAtom#Xl.MakeAtom[connection, "WM_PROTOCOLS"] THEN RETURN;
            migrateAtom ¬ Xl.MakeAtom[connection, "PARC_Migration"];
            migrationOwnerAtom ¬ Xl.MakeAtom[connection, "PARC_Migration_Owner"];
            END;
        SELECT ev.w[0] FROM
            <<migrateAtom is a protocol which causes this shell to migrate>>
            <<migrationOwnerAtom is a protocol which causes this shell to add a property which is persistent over migration.>>
            migrateAtom, migrationOwnerAtom => {
                pr: Xl.PropertyReturnRec;
                unusedTimeStamp: Xl.TimeStamp ~ [ev.w[1]]; 
                window: Xl.Window ~ [[ev.w[2]]]; 
                property: Xl.XAtom ~ [ev.w[3]]; 
                IF Xl.AtomId[property]=0 THEN RETURN;
                IF window=Xl.nullWindow THEN RETURN;
                pr ¬ Xl.GetProperty[c: ev.connection, w: window, property: property
                    ! Xl.XError => GOTO oops
                    ];
                WITH pr.value SELECT FROM
                    r: Rope.ROPE => {
                        SELECT ev.w[0] FROM
                            migrateAtom => {[] _ Migrate[shell, r]; RETURN};
                            migrationOwnerAtom => {SetMigrationOwner[shell, r]; RETURN};
                            ENDCASE => RETURN 
                        };
                    ENDCASE => GOTO oops;
                };
            ENDCASE => RETURN;
        EXITS oops => {};
        };

    SetMigrationOwner: PROC [shell: XTk.Widget, owner: Rope.ROPE] = {
        XTk.PutWidgetProp[shell, $MigrationOwner, owner];
        SetMigrationOwnerProperty[shell, owner]
        };

    Migrate: PUBLIC PROC [shell: XTk.Widget, destination: REF] RETURNS [msg: Rope.ROPE _ NIL] = {
        WITH XTk.GetWidgetProp[shell, $migration] SELECT FROM
            proc: REF XTkMigration.MigrationProc => {
                iMadeIt: BOOL ¬ FALSE;
                newConnection: Xl.Connection;
                IF ~SetMigrating[shell].ok THEN RETURN ["migration already in progress"];
                WITH destination SELECT FROM
                    c: Xl.Connection => newConnection _ c;
                    r: Rope.ROPE => {
                        iMadeIt _ TRUE;
                        newConnection ¬ Xl.CreateConnection[server: r 
                            ! Xl.connectionNotCreated => {msg _ why.reason; ClearMigrating[shell]; GOTO oops}
                            ];
                        };
                    ENDCASE => {
                        ClearMigrating[shell];
                        ERROR;
                        };
                msg _ proc[shell, newConnection ! UNWIND => {
                    ClearMigrating[shell];
                    IF iMadeIt THEN Xl.CloseConnection[newConnection];
                    }];
                ClearMigrating[shell];
                IF iMadeIt THEN Xl.DecRefCount[newConnection, NIL];
                };
            ENDCASE => {}
        EXITS oops => {};
        };

    SetMigrating: ENTRY PROC [shell: XTk.Widget] RETURNS [ok: BOOL] = {
        IF XTk.GetWidgetProp[shell, $Migrating]#NIL THEN RETURN [FALSE];
        XTk.PutWidgetProp[shell, $Migrating, NEW[INT]];
        RETURN [TRUE];
        };

    ClearMigrating: PROC [shell: XTk.Widget] = {
        XTk.PutWidgetProp[shell, $Migrating, NIL];
        };

    SetMigrationOwnerProperty: PROC [shell: XTk.Widget, owner: Rope.ROPE] = {
        migrationOwnerAtom: Xl.XAtom ¬ Xl.MakeAtom[shell.connection, "PARC_Migration_Owner"];
        Xl.ChangeProperty[c: shell.connection, w: shell.window, property: migrationOwnerAtom, type: migrationOwnerAtom, data: owner]
        };


    RegisterMigrator: PUBLIC PROC [shell: XTk.Widget, migrator: XTkMigration.MigrationProc ¬ NIL] = {
        old: REF ¬ XTk.GetWidgetProp[shell, $migration];
        IF migrator=NIL THEN migrator ¬ StandardMigrator;
        XTk.PutWidgetProp[shell, $migration, NEW[XTkMigration.MigrationProc ¬ migrator]];
        IF old=NIL THEN {
            hints: REF XTkShellWidgets.ICCCMHints ¬ XTkShellWidgets.GetHints[shell];
            IF hints#NIL THEN {
                hints.protocols ¬ CONS["PARC_Migration", hints.protocols];
                };
            XTk.AddPermanentMatch[shell, [proc: TryMigrate, handles: Xl.CreateEventFilter[clientMessage], tq: Xl.CreateTQ[], data: shell]];
            XTk.RegisterNotifier[shell, XTk.postWindowCreationKey, PostWindowCreation];
            }; 
        };
        <<>>
    PostWindowCreation: XTk.WidgetNotifyProc = {
        WITH XTk.GetWidgetProp[widget, $MigrationOwner] SELECT FROM
            owner: Rope.ROPE => SetMigrationOwnerProperty[widget, owner]
            ENDCASE => {};
        };

    StandardMigrator: PUBLIC XTkMigration.MigrationProc = {
        failed: BOOL ¬ FALSE;
        oldConnection: Xl.Connection ¬ shell.connection;
        IF ~Xl.Alive[destination] THEN RETURN ["connection not alive"];
        IF Xl.Alive[oldConnection] THEN Xl.IncRefCount[oldConnection, shell];
        XTkShellWidgets.ForgetScreenShell[shell];
        XTkShellWidgets.BindScreenShell[shell, destination];
        XTkShellWidgets.RealizeShell[shell ! Xl.XError => {
            msg _ err.explanation;
            failed ¬ TRUE; 
            CONTINUE
            }];
        IF failed THEN {
            XTkShellWidgets.ForgetScreenShell[shell];
            IF Xl.Alive[oldConnection] THEN {
                XTkShellWidgets.BindScreenShell[shell, oldConnection];
                XTkShellWidgets.RealizeShell[shell];
                };
            };
        IF Xl.Alive[oldConnection] THEN Xl.DecRefCount[oldConnection, shell];
        };

    END.