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>> ~
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.