DIRECTORY Commander, IO, Rope, Xl, XlCursor, XlDetails, XlPredefinedAtoms, XTk, XTkMigration, XTkWidgets, XTkShellWidgets; X11MigrationTool: CEDAR PROGRAM IMPORTS Commander, IO, Xl, XlCursor, XlDetails, XTk, XTkMigration, XTkShellWidgets, XTkWidgets ~ BEGIN MigrationToolInst: TYPE = RECORD [ toolShell: XTk.Widget ¬ NIL, applicationSelectorButton: XTk.Widget ¬ NIL, applicationLabel: XTk.Widget ¬ NIL, applicationWindow: Xl.Window ¬ Xl.nullWindow, destinationWidget: XTk.Widget ¬ NIL, wmProtocolsAtom, migrateAtom: Xl.XAtom ¬ [0], log: IO.STREAM ¬ NIL ]; ClearApplication: PROC [i: REF MigrationToolInst] = { SetApplication[i, Xl.nullWindow, "-- none selected --"]; }; SetApplication: PROC [i: REF MigrationToolInst, w: Xl.Window, text: Rope.ROPE] = { XTkWidgets.SetText[i.applicationLabel, text]; i.applicationWindow ¬ w; }; ApplyMigrate: XTk.WidgetNotifyProc = { i: REF MigrationToolInst ¬ NARROW[registerData]; applicationShellWindow: Xl.Window ¬ i.applicationWindow; time: Xl.TimeStamp ¬ Xl.currentTime; parameters: ARRAY[0..5) OF CARD32 ¬ [0, 0, 0, 0, 0]; destinationConnection: Xl.Connection; destinationName: Rope.ROPE; specialMode: BOOL ¬ FALSE; commandAtom: Xl.XAtom ¬ i.migrateAtom; IF applicationShellWindow=Xl.nullWindow THEN { IO.PutRope[i.log, "Select an application first\n"]; GOTO oops; }; IF ~VerifyApplication[i, applicationShellWindow] THEN { IO.PutRope[i.log, "Application is no more valid\n"]; ClearApplication[i]; GOTO oops; }; WITH event SELECT FROM br: Xl.ButtonReleaseEvent => IF br.state.control THEN specialMode ¬ TRUE; ENDCASE => {}; destinationName ¬ XTkWidgets.GetText[i.destinationWidget]; IF specialMode THEN { commandAtom ¬ Xl.MakeAtom[i.toolShell.connection, "PARC_Migration_Owner"]; } ELSE { destinationConnection ¬ Xl.CreateConnection[server: destinationName ! Xl.connectionNotCreated => { IO.PutRope[i.log, why.reason]; GOTO oops }]; Xl.CloseConnection[destinationConnection]; }; Xl.ChangeProperty[c: i.toolShell.connection, w: i.destinationWidget.window, property: i.migrateAtom, type: i.migrateAtom, data: destinationName]; parameters[0] ¬ Xl.AtomId[commandAtom]; --command parameters[1] ¬ time.t; parameters[2] ¬ Xl.WindowId[i.destinationWidget.window]; --window for property parameters[3] ¬ Xl.AtomId[i.migrateAtom]; --property for destination Xl.SendClientMessage32[c: i.toolShell.connection, destination: applicationShellWindow, window: applicationShellWindow, propagate: FALSE, eventMask: Xl.unspecifiedEvents, type: i.wmProtocolsAtom, data: parameters, details: XlDetails.ignoreErrors]; IF specialMode THEN IO.PutRope[i.log, "whistle trained...\n"] ELSE IO.PutRope[i.log, "migration request sent...\n"]; ClearApplication[i]; EXITS oops => {}; }; AppSelectDown: Xl.EventProcType = { i: REF MigrationToolInst ~ NARROW[clientData]; ev: Xl.ButtonPressEvent ~ NARROW[event]; c: Xl.Connection ~ ev.connection; IF Xl.SetButtonGrabOwner[c, ev.timeStamp, i]=succeeded THEN { s: Xl.GrabStatus; cursor: Xl.Cursor ¬ XlCursor.SharedStandardCursor[c, sailboat]; s ¬ Xl.GrabPointer[c: c, window: ev.eventWindow, ownerEvents: FALSE, eventMask: [buttonRelease: TRUE], pointerMode: asynchronous, keyboardMode: asynchronous, confine: Xl.nullWindow, cursor: cursor, timeStamp: ev.timeStamp]; IF s=success THEN { XTkWidgets.SetStyleKey[i.applicationSelectorButton, $WhiteOnBlack]; } ELSE { XTkWidgets.SetStyleKey[i.applicationSelectorButton, NIL]; Xl.ClearButtonGrabOwner[c, ev.timeStamp]; }; } }; AppSelectUp: Xl.EventProcType = { i: REF MigrationToolInst ~ NARROW[clientData]; ev: Xl.ButtonReleaseEvent ~ NARROW[event]; Xl.UngrabPointer[ev.connection, ev.timeStamp]; IF i=Xl.ButtonGrabOwner[ev.connection] THEN { Xl.ClearButtonGrabOwner[ev.connection, ev.timeStamp]; XTkWidgets.SetStyleKey[i.applicationSelectorButton, NIL]; FindApplication[i, ev]; } }; FindApplication: PROC [i: REF MigrationToolInst, ev: Xl.ButtonReleaseEvent] = { name: Rope.ROPE ¬ NIL; error, foundGood, foundBad: BOOL ¬ FALSE; pointerReply: Xl.PointerReply; propertyRec1, propertyRec2: Xl.PropertyReturnRec; parent: Xl.Window ¬ ev.root; WHILE parent#Xl.nullWindow AND ~foundGood AND ~error AND ~foundBad DO pointerReply ¬ Xl.QueryPointer[ev.connection, parent]; IF pointerReply.child#Xl.nullWindow THEN { propertyRec1 ¬ Xl.GetProperty[c: ev.connection, w: pointerReply.child, property: i.wmProtocolsAtom ! Xl.XError => {error ¬ TRUE; CONTINUE}]; IF error THEN EXIT; WITH propertyRec1.value SELECT FROM list: REF Xl.Card32Sequence => { FOR n: NAT IN [0..list.leng) DO IF list[n]=Xl.AtomId[i.migrateAtom] THEN {foundGood ¬ TRUE; EXIT}; ENDLOOP; IF ~foundGood THEN foundBad ¬ TRUE; }; ENDCASE => { IF propertyRec1.value#NIL THEN foundBad ¬ TRUE }; propertyRec2 ¬ Xl.GetProperty[c: ev.connection, w: pointerReply.child, property: XlPredefinedAtoms.wmName ! Xl.XError => {error ¬ TRUE; CONTINUE}]; IF ~error THEN { WITH propertyRec2.value SELECT FROM r: Rope.ROPE => name ¬ r; ENDCASE => {}; }; IF foundGood THEN EXIT; IF name#NIL THEN {foundBad ¬ TRUE; EXIT}; propertyRec1 ¬ Xl.GetProperty[c: ev.connection, w: pointerReply.child, property: XlPredefinedAtoms.wmHints ! Xl.XError => {error ¬ TRUE; CONTINUE}]; IF error THEN EXIT; IF propertyRec1.value#NIL THEN {foundBad ¬ TRUE; EXIT}; propertyRec1 ¬ Xl.GetProperty[c: ev.connection, w: pointerReply.child, property: XlPredefinedAtoms.wmNormalHints ! Xl.XError => {error ¬ TRUE; CONTINUE}]; IF error THEN EXIT; IF propertyRec1.value#NIL THEN {foundBad ¬ TRUE; EXIT}; }; parent ¬ pointerReply.child ENDLOOP; IF error THEN { IO.PutF1[i.log, "error while trying to find top level application %g\n", IO.rope[name]]; RETURN; }; IF foundBad THEN { IO.PutF1[i.log, "%g does not support migration\n", IO.rope[name]]; RETURN; }; IF ~foundGood THEN { IO.PutF1[i.log, "no top level application window found %g\n", IO.rope[name]]; RETURN; }; IO.PutF[i.log, "selected [%g] %g\n", IO.card[pointerReply.child.drawable.id], IO.rope[name]]; SetApplication[i, pointerReply.child, IO.PutFR["%g [%g]", IO.rope[name], IO.card[pointerReply.child.drawable.id]]]; }; VerifyApplication: PROC [i: REF MigrationToolInst, applicationWindow: Xl.Window] RETURNS [ok: BOOL ¬ FALSE] = { c: Xl.Connection ¬ i.toolShell.connection; propertyRec: Xl.PropertyReturnRec; error: BOOL ¬ FALSE; IF Xl.Alive[c] THEN { propertyRec ¬ Xl.GetProperty[c: c, w: applicationWindow, property: i.wmProtocolsAtom ! Xl.XError => {error ¬ TRUE; CONTINUE}]; IF ~error AND propertyRec.value#NIL THEN { WITH propertyRec.value SELECT FROM list: REF Xl.Card32Sequence => { FOR n: NAT IN [0..list.leng) DO IF list[n]=Xl.AtomId[i.migrateAtom] THEN RETURN [ok ¬ TRUE]; ENDLOOP; }; ENDCASE => {}; }; }; }; InitSomeFields: PROC [i: REF MigrationToolInst] = { c: Xl.Connection ¬ i.destinationWidget.connection; XTkWidgets.SetText[i.destinationWidget, Xl.ServerName[c]]; i.wmProtocolsAtom ¬ Xl.MakeAtom[c, "WM_PROTOCOLS"]; i.migrateAtom ¬ Xl.MakeAtom[c, "PARC_Migration"]; }; CreateMigrationToolWidget: PROC [connection: REF ¬ NIL] ~ { i: REF MigrationToolInst ¬ NEW[MigrationToolInst]; container: XTk.Widget ¬ XTkWidgets.CreateYStack[]; appTQ: Xl.TQ ¬ Xl.CreateTQ[]; doButton: XTk.Widget ¬ XTkWidgets.CreateButton[[], "Do migrate", [], ApplyMigrate, i]; appButton: XTk.Widget ¬ i.applicationSelectorButton ¬ XTkWidgets.CreateLabel[text: "Select application"]; appLabel: XTk.Widget ¬ i.applicationLabel ¬ XTkWidgets.CreateLabel[text: "-- none selected --"]; logWidget: XTk.Widget ¬ XTkWidgets.CreateStreamWidget[widgetSpec: [geometry: [size: [300, 100]]]]; i.toolShell ¬ XTkShellWidgets.CreateShell[windowHeader: "Migration Tool", packageName: "X11", shortName: "X11MigrationTool"]; i.destinationWidget ¬ XTkWidgets.CreateLabeledField[label: "destination:", init: "..."]; i.log ¬ XTkWidgets.CreateStream[logWidget]; XTk.AddPermanentMatch[ appButton, [proc: AppSelectUp, handles: Xl.CreateEventFilter[buttonRelease], tq: appTQ, data: i], [buttonRelease: TRUE] ]; XTk.AddPermanentMatch[appButton, [proc: AppSelectDown, handles: Xl.CreateEventFilter[buttonPress], tq: appTQ, data: i], [buttonPress: TRUE]]; XTkWidgets.SetShellChild[i.toolShell, container]; XTkWidgets.AppendChild[container, doButton]; XTkWidgets.AppendChild[container, appButton]; XTkWidgets.AppendChild[container, appLabel]; XTkWidgets.AppendChild[container, i.destinationWidget]; XTkWidgets.AppendChild[container, XTkWidgets.CreateRuler[widgetSpec: [geometry: [size: [-1, 1]]]]]; XTkWidgets.AppendChild[container, logWidget]; XTk.PutWidgetProp[i.toolShell, $MigrationTool, i]; XTkMigration.RegisterMigrator[i.toolShell, MigrateSelf]; XTkWidgets.BindScreenShell[shell: i.toolShell, connection: connection]; InitSomeFields[i]; XTkWidgets.RealizeShell[shell: i.toolShell]; }; CreateMigrationTool: Commander.CommandProc ~ { CreateMigrationToolWidget[] }; MigrateSelf: XTkMigration.MigrationProc = { log: IO.STREAM ¬ IO.noWhereStream; WITH XTk.GetWidgetProp[shell, $MigrationTool] SELECT FROM i: REF MigrationToolInst => log ¬ i.log; ENDCASE => {}; CreateMigrationToolWidget[destination]; IO.PutF1[log, "New MigrationTool on server %g created\n", IO.rope[Xl.ServerName[destination]]]; }; Commander.Register["X11MigrationTool", CreateMigrationTool, "Create window migration tool"]; END. LX11MigrationTool.mesa Copyright Σ 1991, 1992, 1993 by Xerox Corporation. All rights reserved. Created by Christian Jacobi, August 5, 1991 7:19 pm PDT Christian Jacobi, May 4, 1993 3:47 pm PDT Willie-s, November 25, 1991 4:48 pm PST --THIS IS HORRIBLE; I don't know how to atomicly get the application of the buttonRelease Κ =•NewlineDelimiter –(cedarcode) style˜codešœ™Kšœ Οeœ=™HK™7K™)K™'K™—šΟk œ˜ K˜pK˜—šΟnœžœž˜KšžœY˜`—Kšž˜K˜šœžœžœ˜"Kšœžœ˜Kšœ(žœ˜,Kšœžœ˜#Kšœ-˜-Kšœ žœ˜$Kšœ-˜-Kšœžœžœž˜Kšœ˜K˜—šŸœžœžœ˜5Kšœ8˜8K˜—K˜šŸœžœžœ-žœ˜RKšœ-˜-Kšœ˜K˜—K˜šŸ œ˜&Kšœžœžœ˜0Kšœ8˜8Kšœ$˜$Kšœ žœžœžœ˜4Kšœ%˜%Kšœžœ˜Kšœ žœžœ˜Kšœ&˜&šžœ&žœ˜.Kšžœ1˜3Kšžœ˜ K˜—šžœ/žœ˜7Kšžœ2˜4Kšœ˜Kšžœ˜ K˜—šžœžœž˜Kšœžœžœžœ˜IKšžœ˜—Kšœ:˜:šžœ ˜šžœ˜KšœJ˜JK˜—šžœ˜šœb˜bKšžœ˜Kšžœ˜ Kšœ˜—Kšœ*˜*K˜——Kšœ‘˜‘Kšœ(Οc ˜1Kšœ˜Kšœ9 ˜NKšœ* ˜DKšœ‚žœo˜φšžœ ˜Kšžœžœ'˜.Kšžœžœ/˜6—Kšœ˜Kšžœ ˜Kšœ˜K˜—šŸ œ˜#Kšœžœžœ ˜.Kšœžœ˜(Kšœ!˜!šžœ5žœ˜=Kšœ˜Kšœ?˜?Kšœ>žœžœ{˜ίšžœ ˜ šžœ˜KšœC˜CK˜—šžœ˜Kšœ4žœ˜9Kšœ)˜)Kšœ˜——K˜—K˜K˜—šŸ œ˜!Kšœžœžœ ˜.Kšœžœ˜*Kšœ.˜.šžœ%žœ˜-Kšœ5˜5Kšœ4žœ˜9Kšœ˜Kšœ˜—K˜—K˜šŸœžœžœ3˜PK™[Kšœ žœžœ˜Kšœžœžœ˜)Kšœ˜Kšœ1˜1Kšœ˜š žœžœ žœžœ ž˜EKšœ6˜6šžœ"žœ˜*Kšœ{žœžœ˜ŒKšžœžœžœ˜šžœžœž˜#šœžœ˜ šžœžœžœž˜Kšžœ"žœžœžœ˜BKšžœ˜—Kšžœ žœ žœ˜#Kšœ˜—šžœ˜ Kšžœžœžœ ž˜.Kšœ˜——Kšœ‚žœžœ˜“šžœžœ˜šžœžœž˜#Kšœžœ ˜Kšžœ˜—Kšœ˜—Kšžœ žœžœ˜Kš žœžœžœ žœžœ˜)Kšœƒžœžœ˜”Kšžœžœžœ˜Kš žœžœžœ žœžœ˜8Kšœ‰žœžœ˜šKšžœžœžœ˜Kš žœžœžœ žœžœ˜8K˜—Kšœ˜Kšžœ˜—šžœžœ˜KšžœGžœ ˜XKšžœ˜K˜—šžœ žœ˜Kšžœ1žœ ˜BKšžœ˜K˜—šžœ žœ˜Kšžœ<žœ ˜MKšžœ˜K˜—Kšžœ#žœ'žœ ˜]Kšœ&žœžœ žœ(˜sKšœ˜—K˜š Ÿœžœžœ2žœžœžœ˜oKšœ*˜*Kšœ"˜"Kšœžœžœ˜šžœ žœ˜Kšœmžœžœ˜~šžœžœžœžœ˜*šžœžœž˜"šœžœ˜ šžœžœžœž˜Kšžœ"žœžœžœ˜