
DIRECTORY 
Rope, 
Xl,
XlDispatch,
XTk,
XTkFriends,		
XTkPseudoRoot;

XTkPseudoRootImpl: CEDAR PROGRAM
IMPORTS Xl, XlDispatch, XTk, XTkFriends
EXPORTS XTkPseudoRoot
~ BEGIN  

newPseudoChild: PUBLIC ATOM ¬ $newPseudoChild;
pseudoChildDestroyed: PUBLIC ATOM ¬ $pseudoChildDestroyed;

pseudoRootClass: XTk.ImplementorClass ¬ XTkFriends.CreateClass[[
key: $bare, wDataNum: 1, 
classNameHint: $pseudoRoot, 
backgroundKey: $white, 
initInstPart: PseudoRootInitInstPart, 
eventMask: [substructureRedirect: TRUE], 
configureLR: PSRConfigureLR
]];

pseudoRootEvents: Xl.EventFilter ~ Xl.CreateEventFilter[configureRequest, mapRequest];
pseudoChildEvents: Xl.EventFilter ~ Xl.CreateEventFilter[destroyNotify];

PseudoRootInstPart: TYPE = REF PseudoRootInstPartRec;
PseudoRootInstPartRec: TYPE = RECORD [
catchChildDestruction: Xl.Match ¬ NIL,
childWindow: Xl.Window ¬ Xl.nullWindow
];

CreatePseudoRoot: PUBLIC PROC [spec: XTk.WidgetSpec ¬ []] RETURNS [w: XTk.Widget] = {
w ¬ XTk.CreateWidget[spec, pseudoRootClass];
};

PseudoChild: PUBLIC PROC [pseudoRoot: XTk.Widget] RETURNS [pseudoChild: Xl.Window] = {
RETURN [ GetPseudoRootInstPart[pseudoRoot].childWindow ];
};

PseudoRootInitInstPart: XTk.InitInstancePartProc = {
prIP: PseudoRootInstPart ~ NEW[PseudoRootInstPartRec];
XTkFriends.AssignInstPart[widget, pseudoRootClass, prIP];
};

GetPseudoRootInstPart: PROC [psr: XTk.Widget] RETURNS [PseudoRootInstPart] = INLINE {
RETURN [ NARROW[XTkFriends.InstPart[psr, pseudoRootClass]] ];
};

synchronous: Xl.Details ~ NEW[Xl.DetailsRec ¬ [synchronous: TRUE]];
ignoreErrors: Xl.Details ~ NEW[Xl.DetailsRec ¬ [errorMatch: NEW[Xl.MatchRep ¬ [proc: IgnoreErrors, handles: NIL, tq: Xl.CreateTQ[]]]]];
IgnoreErrors: Xl.EventProcType = {};

RedirectChildMapping: Xl.EventProcType = {
psr: XTk.Widget ~ NARROW[clientData];
prIP: PseudoRootInstPart ~ GetPseudoRootInstPart[psr];
SELECT event.type FROM
mapRequest => {
mr: Xl.MapRequestEvent ~ NARROW[event];
new: BOOL ¬ mr.window#prIP.childWindow;
IF new THEN {
IF prIP.childWindow#Xl.nullWindow THEN {
type: Xl.XAtom ~ Xl.MakeAtom[event.connection, "PARC_PseudoChildReplaced"];
Xl.UnmapSubWindows[c: event.connection, window: psr.window];
XlDispatch.RemoveMatch[c: event.connection, w: prIP.childWindow, match: prIP.catchChildDestruction, details: ignoreErrors];
Xl.SendClientMessage32[c: event.connection, destination: prIP.childWindow, propagate: FALSE, eventMask: Xl.unspecifiedEvents, window: prIP.childWindow, type: type, data: [Xl.AtomId[type], Xl.WindowId[psr.window], 0, 0, 0], details: ignoreErrors];
prIP.childWindow ¬ Xl.nullWindow;
};
XlDispatch.AddMatch[c: event.connection, w: mr.window, match: prIP.catchChildDestruction, details: synchronous 
! Xl.XError => GOTO oops
];
prIP.childWindow ¬ mr.window;
};
Xl.ConfigureWindow[c: event.connection, window: prIP.childWindow, geometry: [pos: [0, 0], size: psr.actual.size, borderWidth: Xl.dontUse], details: synchronous 
! Xl.XError => {prIP.childWindow ¬ Xl.nullWindow; GOTO oops}
];
Xl.MapWindow[c: event.connection, window: prIP.childWindow, details: ignoreErrors];
IF new THEN XTkFriends.CallNotifiers[psr, newPseudoChild, newPseudoChild, mr];
};
configureRequest => {--dont--}
ENDCASE => {}
EXITS oops => {};
};

ChildDestroyed: Xl.EventProcType = {
psr: XTk.Widget ~ NARROW[clientData];
prIP: PseudoRootInstPart ~ GetPseudoRootInstPart[psr];
SELECT event.type FROM
destroyNotify => {
dn: Xl.DestroyNotifyEvent ~ NARROW[event];
IF dn.window=prIP.childWindow THEN {
prIP.childWindow ¬ Xl.nullWindow;
XTkFriends.CallNotifiers[psr, pseudoChildDestroyed, pseudoChildDestroyed, dn];
};
};
ENDCASE => {}
};

PSRConfigureLR: XTk.ConfigureProc = {
existW, createW: BOOL;
prIP: PseudoRootInstPart ~ GetPseudoRootInstPart[widget];
existW ¬ widget.actualMapping<unconfigured;
createW ¬ mapping<unconfigured AND ~existW;
IF createW THEN {
tq: Xl.TQ ¬ Xl.CreateTQ[];
XTk.AddTemporaryMatch[widget, [proc: RedirectChildMapping, handles: pseudoRootEvents, tq: tq, data: widget]];
prIP.catchChildDestruction ¬ NEW[Xl.MatchRep ¬ [proc: ChildDestroyed, handles: pseudoChildEvents, tq: tq, data: widget]]
};
XTkFriends.SimpleConfigureOneLevelLR[widget, geometry, mapping];
IF prIP.childWindow#Xl.nullWindow THEN {
g: Xl.Geometry ¬ geometry;
g.pos ¬ [0, 0];
g.borderWidth ¬ 0;
IF g.size.width<=0 THEN g.size.width ¬ widget.actual.size.width;
IF g.size.height<=0 THEN g.size.height ¬ widget.actual.size.height;
g.size.width ¬ MAX[1, g.size.width - 2*g.borderWidth];
g.size.height ¬ MAX[1, g.size.height - 2*g.borderWidth];
Xl.ConfigureWindow[c: widget.connection, window: prIP.childWindow, geometry: g, details: ignoreErrors];
};
};

END.


  Z  XTkPseudoRootImpl.mesa
Copyright س 1991, 1992 by Xerox Corporation.  All rights reserved.
Created by Christian Jacobi, April 29, 1991 2:10:48 pm PDT
Christian Jacobi, February 21, 1992 5:51 pm PST

A new child has been created, use it.
A child has been deleted: remove it from the data structures
When reconfigured, simply resize the child
‌ت؛  •NewlineDelimiter
–(cedarcode) styleک codeڑœ™Kڑœ
دeœ7™BKڑœ:™:Kڑœ/™/K™ —ڑدk	œک
KڑœکKڑœکKڑœکKڑœکKڑœکKڑœکKک —ڑدnœ‍œ‍ک Kڑ‍œ ک'Kڑ‍œک—Kڑœ‍œک	Kک Kڑœ‍œ‍œک.Kڑœ‍œ‍œک:Kک ڑœ@ک@KڑœکKڑœکKڑœکKڑœ&ک&Kڑœ"‍œک)KڑœکKڑœک—Kک KڑœVکVKڑœHکHKک Kڑœ‍œ‍œک5ڑœ‍œ‍œک&Kڑœ"‍œک&Kڑœ&ک&Kڑœک—Kک ڑںœ‍œ‍œ‍œکUKڑœ,ک,Kڑœک—Kک ڑںœ‍œ‍œ‍œکVKڑ‍œ3ک9Kڑœک—Kک ڑںœک4Kڑœ‍œک6Kڑœ9ک9KکKک —ڑںœ‍œ‍œ‍œکUKڑ‍œ‍œ.ک=KکKک —Kڑœ‍œ‍œکCKڑœ‍œ‍œ-‍œک‡Kڑںœک$Kک ڑںœک*K™%Kڑœ‍œک%Kڑœ6ک6ڑ‍œ‍کڑœکKڑœ‍œک'Kڑœ‍œک'ڑ‍œ‍œکڑ‍œ ‍œک(KڑœKکKKڑœ<ک<Kڑœ{ک{KڑœV‍œ›کِKڑœ!ک!Kک—ڑœoکoKڑœ‍œکKڑœک—KڑœکKک—ڑœ ک Kڑœ2‍œک<Kڑœک—KڑœSکSKڑ‍œ‍œCکNKک—KڑœدcœکKڑ‍œک—Kڑ‍œکKڑœک—Kک ڑںœک$K™<Kڑœ‍œک%Kڑœ6ک6ڑ‍œ‍کڑœکKڑœ‍œک*ڑ‍œ‍œک$Kڑœ!ک!KڑœNکNKڑœک—Kک—Kڑ‍œک—Kڑœک—Kک ڑںœک%Kڑœ*™*Kڑœ‍œکKڑœ9ک9Kڑœ+ک+Kڑœ‍œ	ک+ڑ‍œ	‍œکKڑœ‍œکKڑœmکmKڑœ‍œXکxKڑœک—Kڑœ@ک@ڑ‍œ ‍œک(KڑœکKڑœکKڑœکKڑ‍œ‍œ)ک@Kڑ‍œ‍œ+کCKڑœ‍œ$ک6Kڑœ‍œ%ک8KڑœgکgKک—KڑœکKک —Kڑ‍œکک Kک —Kک — …—    
    