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
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 = {
A new child has been created, use it.
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 = {
A child has been deleted: remove it from the data structures
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 = {
When reconfigured, simply resize the child
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.