XTkShellWidgetsImpl.mesa
Copyright Ó 1988, 1989, 1990, 1991, 1992 by Xerox Corporation. All rights reserved.
Created by Christian Jacobi, October 18, 1988 11:22:01 am PDT
Christian Jacobi, August 13, 1993 10:30 am PDT
DIRECTORY
Ascii,
Atom,
Random,
Rope,
RopeList,
Xl,
XlICCCMTypes,
XlConventions,
XlDispatch,
XlPredefinedAtoms,
XTk,
XTkDB,
XTkIcon,
XTkFriends,
XTkMigration,
XTkNotification,
XTkPrivate,
XTkShellWidgets;
XTkShellWidgetsImpl:
CEDAR
MONITOR
IMPORTS Atom, Random, Rope, RopeList, XlDispatch, Xl, XlConventions, XTk, XTkDB, XTkFriends, XTkIcon, XTkMigration, XTkNotification, XTkPrivate
EXPORTS XTkShellWidgets
SHARES Xl, XTk =
BEGIN OPEN Xl, XTk, XTkShellWidgets;
shellClass: ImplementorClass ¬ XTkFriends.CreateClass[[key: $top, wDataNum: 1, preferredSizeLR: ShellPreferredSizeLR, preStopFastAccess: ShellPreStopFastAccess, configureLR: ShellConfigureLR, initInstPart: ShellInitInstPart, className: ShellClassName, eventMask: [structureNotify: TRUE], backgroundKey: $white, removeChildLR: ShellRemoveChildLR, internalEnumerateChildren: ShellInternalEnumerateChildren, forgetScreenLR: ShellForgetScreenLR, bindScreenLX: ShellBindScreenLX]];
ToWindow:
PROC [x:
REF
READONLY
ANY]
RETURNS [w: Xl.Window ¬ Xl.nullWindow] = {
WITH x
SELECT
FROM
widget: REF READONLY WidgetRep => w ¬ widget.window;
window: REF READONLY Window => w ¬ window;
ENDCASE => {};
};
IsShell:
PUBLIC
PROC [w: XTk.Widget]
RETURNS [
BOOL] = {
RETURN [XTk.HasClass[w, shellClass]];
};
connectionDeadSet: EventFilter ~ Xl.CreateEventFilter[finalEvent];
ConnectionDiedHandler: EventProcType = {
--on rootTQ
SELECT event.type
FROM
finalEvent => {
ev: Xl.FinalEvent ~ NARROW[event];
shell: Widget ~ NARROW[clientData];
IF ~ev.refCountTransition
AND shell.connection=ev.connection
AND shell.state<=screened
THEN {
shellIP: ShellInstPart ~ GetShellInstPart[shell];
closure: REF Closure ¬ shellIP.connectionDiedClosure;
XTkFriends.PreStopFastAccess[shell, errorConnection];
shellIP.connection ¬ NIL;
IF closure=
NIL
THEN DestroyShell[shell]
ELSE closure.proc[shell, closure.registerData, $connectionDied, ev];
};
};
ENDCASE => {};
};
shellRootEvents: Xl.EventFilter ~ Xl.CreateEventFilter[destroyNotify, configureNotify];
shellOtherEvents: Xl.EventFilter ~ Xl.CreateEventFilter[clientMessage];
OtherShellEvents: <<NOT rootTQ>> Xl.EventProcType = {
shell: Widget ~ NARROW[clientData];
shellIP: ShellInstPart ~ GetShellInstPart[shell];
IF shell.state>realized OR shell.fastAccessAllowed#ok THEN RETURN;
SELECT event.type
FROM
clientMessage => {
client: Xl.ClientMessageEvent ~ NARROW[event];
IF client.window#shell.window OR client.format#32 THEN RETURN;
IF client.typeAtom#shellIP.wmProtocolsAtom THEN RETURN;
SELECT client.w[0]
FROM
shellIP.cachedWmAtom => {
SetFocus[shell, [client.w[1]], NIL];
};
Xl.MakeAtom[shell.connection, "WM�LETE←WINDOW"] => {
IF shellIP.deletionProtocol
THEN {
closure: REF Closure ¬ shellIP.wmDeletionClosure;
IF closure=
NIL
THEN DestroyByWindowManager[shell, NIL, $wmDeleteWindow, client]
ELSE closure.proc[shell, closure.registerData, $wmDeleteWindow, client];
};
};
ENDCASE => RETURN;
};
ENDCASE => {};
};
ShellEventLR: <<on rootTQ>> Xl.EventProcType = {
ENABLE ABORTED => GOTO oops;
shell: Widget ~ NARROW[clientData];
shellIP: ShellInstPart ~ GetShellInstPart[shell];
IF shell.state>realized OR shell.fastAccessAllowed#ok THEN RETURN;
SELECT event.type
FROM
configureNotify => {
g: Geometry;
cn: ConfigureNotifyEvent ~ NARROW[event];
IF shellIP.crazyShell
THEN {
IF cn.window#shellIP.parentWindow THEN RETURN;
}
ELSE {
IF cn.window#shell.window THEN RETURN;
shell.actual.pos ¬ cn.geometry.pos;
shell.actual.borderWidth ¬ cn.geometry.borderWidth;
};
IF shell.actual.size#cn.geometry.size
THEN {
g ¬ [size: cn.geometry.size, pos: [dontUse, dontUse], borderWidth: dontUse];
--Note: The sizing has not yet happened! .
ShellCheatConfigureLR[shell, g];
};
};
destroyNotify => {
d: Xl.DestroyNotifyEvent ~ NARROW[event];
SELECT d.window
FROM
shellIP.parentWindow, shell.window => {
closure: REF Closure ¬ shellIP.windowDiedClosure;
IF shell.connection#d.connection OR shell.state>screened THEN RETURN;
XTkFriends.PreStopFastAccess[shell, errorWindow];
IF closure=
NIL
THEN DestroyShell[shell]
ELSE closure.proc[shell, closure.registerData, $destroyNotify, d];
};
ENDCASE => {}
};
ENDCASE => {};
EXITS oops => NULL;
};
ShellRemoveChildLR: XTk.RemoveChildProc = {
shellIP: ShellInstPart ~ GetShellInstPart[widget];
oldChild: XTk.Widget ¬ shellIP.child;
IF oldChild#
NIL
THEN {
shellIP.child ¬ NIL;
done ¬ TRUE;
XTkFriends.ForgetScreenLR[oldChild];
};
};
AddChildLR:
PROC [shell: XTk.Widget, newChild: Widget] = {
shellIP: ShellInstPart ~ GetShellInstPart[shell];
oldChild: Widget ¬ shellIP.child;
IF oldChild=newChild THEN RETURN;
SELECT newChild.parent
FROM
NIL, shell => XTkFriends.AssignParentAndCheckScreenLR[newChild, shell];
ENDCASE => ERROR;
IF oldChild#
NIL
THEN {
shellIP.child ¬ NIL;
XTkFriends.OrphanizeLR[oldChild, normal];
};
IF newChild.s.mapping=dontUse THEN newChild.s.mapping ¬ mapped;
shellIP.child ¬ newChild;
NoteChildChange[shell];
XTkFriends.ReconfigureChildrenLR[shell];
};
ShellInternalEnumerateChildren: XTk.InternalEnumerateChildrenProc = {
child: XTk.Widget ¬ ShellChild[self];
IF child#
NIL
AND child.state<dead
THEN {
stop ¬ proc[self, child, data].stop
};
};
ShellCheatConfigureLR:
PROC [shell: XTk.Widget, geometry: Geometry] = {
CheatConfigureLR: ConfigureProc = {
IF geometry.pos.x # dontUse THEN widget.actual.pos.x ¬ geometry.pos.x;
IF geometry.pos.y # dontUse THEN widget.actual.pos.y ¬ geometry.pos.y;
IF geometry.size.width # dontUse THEN widget.actual.size.width ¬ geometry.size.width;
IF geometry.size.height # dontUse THEN widget.actual.size.height ¬ geometry.size.height;
IF geometry.borderWidth # dontUse THEN widget.actual.borderWidth ¬ geometry.borderWidth;
IF mapping # dontUse THEN widget.actualMapping ¬ mapping;
BEGIN
c: Xl.Connection ~ widget.connection;
win: Xl.Window ~ widget.window;
Xl.ConfigureWindow[c: c, window: win, geometry: geometry];
END;
ShellPropagateConfigureLR[widget, FALSE];
XTkFriends.CallNotifiers[widget, $ShellPostReconfigure];
IF widget.fastAccessAllowed=ok THEN Xl.Flush[widget.connection];
};
IF geometry.pos.x = shell.actual.pos.x THEN geometry.pos.x ¬ dontUse;
IF geometry.pos.y = shell.actual.pos.y THEN geometry.pos.y ¬ dontUse;
IF geometry.size.width = shell.actual.size.width THEN geometry.size.width ¬ dontUse;
IF geometry.size.height = shell.actual.size.height THEN geometry.size.height ¬ dontUse;
IF geometry.borderWidth = shell.actual.borderWidth THEN geometry.borderWidth ¬ dontUse;
IF geometry#[[dontUse, dontUse], [dontUse, dontUse], dontUse]
THEN {
CheatConfigureLR[shell, geometry, dontUse, FALSE];
};
};
DestroyByWindowManager: <<any thread>> XTk.WidgetNotifyProc = {
IF widget.fastAccessAllowed=ok
THEN {
XTkFriends.PreStopFastAccess[widget, normal];
IF widget.actualMapping=mapped
THEN {
Xl.UnmapWindow[widget.connection, widget.window, XTkPrivate.detailsForNoErrors];
};
};
DestroyShell[widget];
};
ShellChild:
PROC [shell: ShellWidget]
RETURNS [Widget¬
NIL] = {
shellIP: ShellInstPart ~ GetShellInstPart[shell];
RETURN [shellIP.child];
};
ShellPreferredSizeLR: PreferredSizeProc = {
child: Widget = ShellChild[widget];
maySkip[x] ¬ TRUE; maySkip[y] ¬ TRUE;
IF widget.s.geometry.size.width > 0
THEN {
maySkip[w] ¬ TRUE;
proposed.size.width ¬ widget.s.geometry.size.width;
};
IF widget.s.geometry.size.height > 0
THEN {
maySkip[h] ¬ TRUE;
proposed.size.height ¬ widget.s.geometry.size.height;
};
IF widget.s.geometry.pos.x # dontUse
THEN {
already maySkip[x] ← TRUE;
proposed.pos.x ¬ widget.s.geometry.pos.x;
};
IF widget.s.geometry.pos.y # dontUse
THEN {
already maySkip[y] ← TRUE;
proposed.pos.y ¬ widget.s.geometry.pos.y;
};
IF widget.s.geometry.borderWidth # dontUse
THEN {
maySkip[b] ¬ TRUE;
proposed.borderWidth ¬ widget.s.geometry.borderWidth;
};
IF child =
NIL
OR (maySkip[w]
AND maySkip[h]
AND maySkip[b])
THEN RETURN [proposed]
ELSE {
g: Geometry ¬ XTkFriends.PreferredSizeLR[child, NIL, proposed, maySkip];
IF g.borderWidth<0 THEN g.borderWidth ¬ 0;
preferred.size.width ¬
SELECT
TRUE
FROM
widget.s.geometry.size.width>0 => widget.s.geometry.size.width,
g.size.width>0 => g.size.width + g.borderWidth*2,
ENDCASE => dontUse;
preferred.size.height ¬
SELECT
TRUE
FROM
widget.s.geometry.size.height>0 => widget.s.geometry.size.height,
g.size.height>0 => g.size.height + g.borderWidth*2,
ENDCASE => dontUse;
};
preferred.pos ¬ widget.s.geometry.pos;
preferred.borderWidth ¬ widget.s.geometry.borderWidth;
};
EnsureRootThread:
PROC [inq: Xl.
TQ]
RETURNS [tq: Xl.
TQ] = {
IF inq=
NIL
THEN {
tq ¬ Xl.CreateTQ[$root, XTk.rootLockingOrder, FALSE]
}
ELSE {
tq ¬ inq;
IF Xl.GetLockOrderNum[tq]<XTk.rootLockingOrder THEN ERROR;
};
};
InterOpShellCreateWindowLR:
PROC [widget: Widget, shellIP: ShellInstPart] = {
connection: Xl.Connection ~ widget.connection;
gr: GeometryRec ¬ GetGeometry[connection, shellIP.parentWindow]; --crash if not a window...
IF widget.actual.pos.x<0 THEN widget.actual.pos.x ¬ 0;
IF widget.actual.pos.y<0 THEN widget.actual.pos.y ¬ 0;
IF widget.actual.borderWidth<0 THEN widget.actual.borderWidth ¬ 0;
IF widget.actual.size.width<=0
THEN
widget.actual.size.width ¬ MAX[gr.geometry.size.width - 2*widget.actual.borderWidth, 1];
IF widget.actual.size.height<=0
THEN
widget.actual.size.height ¬ MAX[gr.geometry.size.height - 2*widget.actual.borderWidth, 1];
--my own direct events
XTk.AddTemporaryMatch[widget, [proc: ShellEventLR, handles: shellRootEvents, tq: widget.rootTQ, data: widget], [structureNotify: TRUE]];
--my parents events: we need to know about resizing
AddDispatch[connection, shellIP.parentWindow, NEW[MatchRep ¬ [proc: ShellEventLR, handles: shellRootEvents, tq: widget.rootTQ, data: widget]], [structureNotify: TRUE]];
widget.window ¬ Xl.CreateWindow[c: connection, matchList: XTkFriends.CollectMatchesLR[widget], parent: shellIP.parentWindow, geometry: widget.actual, depth: widget.depth, attributes: widget.attributes];
ShellPropagateConfigureLR[widget, TRUE];
IF widget.actualMapping=mapped
THEN {
Xl.MapWindow[connection, widget.window, XTkPrivate.detailsForFlushNoErrors];
};
};
skipPos: GeometryRequest ~ [TRUE, TRUE, FALSE, FALSE, FALSE];
NormalShellCreateWindowLR:
PROC [widget: Widget, shellIP: ShellInstPart] = {
g: Geometry; cheatWM: BOOL; goodSize, goodPos: BOOL ¬ TRUE;
connection: Xl.Connection ~ widget.connection;
hints: REF XTkShellWidgets.ICCCMHints ~ GetHints[widget];
IF shellIP.parentWindow=nullWindow
THEN {
shellIP.parentWindow ¬ Xl.DefaultScreen[connection].root;
};
shellIP.wmProtocolsAtom ¬ Xl.MakeAtom[connection, "WM←PROTOCOLS"];
IF widget.s.geometry.borderWidth<0 THEN widget.s.geometry.borderWidth ¬ 0;
g ¬ XTkFriends.PreferredSizeLR[widget: widget, proposed: widget.s.geometry, maySkip: skipPos];--exceptional to query its own preference
IF g.size.width <= 0 THEN {g.size.width ¬ 40; goodSize ¬ FALSE};
IF g.size.height <= 0 THEN {g.size.width ¬ 20; goodSize ¬ FALSE};
IF g.borderWidth < 0 THEN {g.borderWidth ¬ 0};
widget.s.geometry.size ¬ g.size;
widget.s.geometry.borderWidth ¬ g.borderWidth;
IF goodSize
THEN {
hints.wmNormalHints.obsoleteSz ¬ widget.s.geometry.size;
hints.wmNormalHints.clientSize ¬ TRUE;
hints.wmNormalHintsChanged ¬ TRUE;
};
cheatWM ¬ widget.attributes.overrideRedirect=illegal AND XlConventions.WMQueryPosition[connection];
IF cheatWM THEN widget.attributes.overrideRedirect ¬ true;
IF widget.s.geometry.pos.x = dontUse
THEN {
widget.s.geometry.pos.x ¬ Random.ChooseInt[max: 500]; goodPos ¬ FALSE
};
IF widget.s.geometry.pos.y = dontUse
THEN {
widget.s.geometry.pos.y ¬ Random.ChooseInt[max: 400]; goodPos ¬ FALSE
};
IF goodPos
THEN {
hints.wmNormalHints.obsoletePos ¬ widget.s.geometry.pos;
hints.wmNormalHintsChanged ¬ TRUE;
};
XTk.AddTemporaryMatch[widget, [proc: ShellEventLR, handles: shellRootEvents, tq: widget.rootTQ, data: widget]];
XTk.AddTemporaryMatch[widget, [proc: OtherShellEvents, handles: shellOtherEvents, tq: Xl.CreateTQ[], data: widget]];
widget.actual ¬ widget.s.geometry;
widget.window ¬ Xl.CreateWindow[c: connection, matchList: XTkFriends.CollectMatchesLR[widget], parent: shellIP.parentWindow, geometry: widget.actual, depth: widget.depth, attributes: widget.attributes];
ProtectedUpdateHints[widget];
ShellPropagateConfigureLR[widget, TRUE]; --size will probably change later if window manager orders different size...
IF widget.actualMapping=mapped
THEN {
Xl.MapWindow[connection, widget.window];
};
IF cheatWM
THEN {
widget.attributes.overrideRedirect ¬ illegal;
Xl.ChangeWindowAttributes[connection, widget.window, [overrideRedirect: false]];
};
IF shellIP.childrenWithColorMap#NIL THEN TrackColorMap[widget, NIL];
};
ShellConfigureLR: ConfigureProc = {
--Note (except for creation):
-- Ordering new size with Configure is a rare event
-- Normally sizing has already happened by window manager!
existW: BOOL ¬ widget.actualMapping<unconfigured;
createW: BOOL ¬ mapping<unconfigured AND ~existW;
IF geometry.pos.x # dontUse THEN widget.actual.pos.x ¬ geometry.pos.x;
IF geometry.pos.y # dontUse THEN widget.actual.pos.y ¬ geometry.pos.y;
IF geometry.size.width # dontUse
THEN
widget.actual.size.width ¬ geometry.size.width;
IF geometry.size.height # dontUse
THEN
widget.actual.size.height ¬ geometry.size.height;
IF geometry.borderWidth # dontUse
THEN
widget.actual.borderWidth ¬ geometry.borderWidth;
IF mapping # dontUse THEN widget.actualMapping ¬ mapping;
IF createW
THEN {
shellIP: ShellInstPart ~ GetShellInstPart[widget];
shellIP.cachedWmAtom ¬ Xl.MakeAtom[widget.connection, "WM←TAKE𡤏OCUS"];
widget.actualMapping ¬ mapping;
IF shellIP.crazyShell
THEN InterOpShellCreateWindowLR[widget, shellIP]
ELSE NormalShellCreateWindowLR[widget, shellIP];
}
ELSE {
--order new size anyway
XTkFriends.SimpleConfigureOneLevelLR[widget: widget, geometry: geometry, mapping: mapping, reConsiderChildren: reConsiderChildren];
ShellPropagateConfigureLR[widget, reConsiderChildren];
XTkFriends.CallNotifiers[widget, $ShellPostReconfigure];
};
IF widget.fastAccessAllowed=ok THEN Xl.Flush[widget.connection];
};
ShellPropagateConfigureLR:
PROC [widget: Widget, reConsiderChildren:
BOOL] = {
child: Widget = ShellChild[widget];
IF child#
NIL
THEN {
g: Geometry ¬ [size: widget.actual.size, pos: [0, 0], borderWidth: BorderWidth[child]];
childMap: Mapping ¬ IF reConsiderChildren THEN child.s.mapping ELSE dontUse;
IF g.size.width<=0 THEN g.size.width ¬ 1;
IF g.size.height<=0 THEN g.size.height ¬ 1;
IF reConsiderChildren THEN XTk.SetWidgetFlag[widget, XTk.mustReConsiderChildren, FALSE];
XTkFriends.ConfigureLR[child, g, childMap, reConsiderChildren];
};
};
ShellInstPart: TYPE = REF ShellInstPartRec;
ShellInstPartRec:
TYPE =
RECORD [
child: XTk.Widget ¬ NIL,
originalRootTQ: Xl.TQ ¬ NIL,
connection: REF ¬ NIL,
parentWindow: Window ¬ Xl.nullWindow,
className: ATOM ¬ NIL,
iconName: ROPE ¬ NIL,
packageName: ROPE ¬ NIL,
shortName: ROPE ¬ NIL,
finallyUnmapped: BOOL ¬ FALSE,
crazyShell: BOOL ¬ FALSE, --interoperability thing: parentWindow # root
hints: REF XTkShellWidgets.ICCCMHints ¬ NIL,
--normal shells only
deletionProtocol: BOOL ¬ FALSE,
wmDeletionClosure: REF Closure ¬ NIL,
windowDiedClosure: REF Closure ¬ NIL,
connectionDiedClosure: REF Closure ¬ NIL,
focusGoal: REF ¬ NIL,
focusTime: TimeStamp ¬ [0],
dontQueryGeometry: BOOL ¬ FALSE,
childrenWithColorMap: LIST OF Widget ¬ NIL,
wmProtocolsAtom: XAtom ¬ [0], --speed up !
connectionWatcherMatch: Xl.Match ¬ NIL,
cachedWmAtom: XAtom ¬ [0]
];
IsARoot:
PROC [connection: Connection, window: Window]
RETURNS [
BOOL¬
FALSE] = {
FOR i:
INT
IN [0..ScreenCount[connection])
DO
IF NthScreen[connection, i].root=window THEN RETURN [TRUE];
ENDLOOP
};
ShellInitInstPart: InitInstancePartProc = {
shellIP: ShellInstPart ~ NEW[ShellInstPartRec];
XTkFriends.AssignInstPart[widget, shellClass, shellIP];
IF widget.parent#NIL THEN ERROR;
};
Closure: TYPE = RECORD [proc: XTk.WidgetNotifyProc, registerData: REF ¬ NIL]; --use a ref to gain atomicity
RegisterCallConnectionDied:
PUBLIC
PROC [shell: ShellWidget, proc: WidgetNotifyProc, registerData:
REF ¬
NIL] = {
shellIP: ShellInstPart ~ GetShellInstPart[shell];
closure: REF Closure ~ IF proc#NIL THEN NEW[Closure ¬ [proc, registerData]] ELSE NIL;
shellIP.connectionDiedClosure ¬ closure;
};
RegisterCallWindowDied:
PUBLIC PROC [shell: ShellWidget, proc: WidgetNotifyProc, registerData:
REF ¬
NIL] = {
shellIP: ShellInstPart ~ GetShellInstPart[shell];
closure: REF Closure ~ IF proc#NIL THEN NEW[Closure ¬ [proc, registerData]] ELSE NIL;
shellIP.windowDiedClosure ¬ closure;
};
RegisterCallWMDeleteWindow:
PUBLIC
PROC [shell: ShellWidget, proc: XTk.WidgetNotifyProc, registerData:
REF ¬
NIL] = {
shellIP: ShellInstPart ~ GetShellInstPart[shell];
closure: REF Closure ~ IF proc#NIL THEN NEW[Closure ¬ [proc, registerData]] ELSE NIL;
shellIP.wmDeletionClosure ¬ closure;
};
GetHints:
PUBLIC
PROC [shell: ShellWidget]
RETURNS [
REF XTkShellWidgets.ICCCMHints] = {
shellIP: ShellInstPart ~ GetShellInstPart[shell];
IF shellIP.hints=
NIL
THEN {
shellIP.hints ¬ NEW[XTkShellWidgets.ICCCMHints];
shellIP.hints.wmHints.initialState ¬ 1;
};
RETURN [shellIP.hints];
};
UpdateHints:
PUBLIC
PROC [shell: ShellWidget] = {
shellIP: ShellInstPart ~ GetShellInstPart[shell];
action: PROC = {ProtectedUpdateHints[shell]};
IF shell.fastAccessAllowed#ok THEN RETURN;
Xl.CallWithLock[shellIP.originalRootTQ, action];
};
ProtectedUpdateHints:
PROC [shell: ShellWidget] = {
c: Xl.Connection ¬ shell.connection;
shellIP: ShellInstPart ~ GetShellInstPart[shell];
h: REF XTkShellWidgets.ICCCMHints ~ GetHints[shell];
IF c=NIL OR h=NIL OR shell.fastAccessAllowed#ok THEN RETURN;
IF h.wmHintsChanged
THEN {
h.wmHintsChanged ¬ FALSE;
h.wmHints.windowGroup ¬ ToWindow[h.windowGroup];
XlConventions.SetWMHints[c, shell.window, h.wmHints];
};
IF h.wmNormalHintsChanged
THEN {
h.wmNormalHintsChanged ¬ FALSE;
XlConventions.SetWMNormalHints[c, shell.window, h.wmNormalHints];
};
IF h.iconNameChanged
THEN {
h.iconNameChanged ¬ FALSE;
XlConventions.SetIconName[c, shell.window, h.iconName];
};
IF h.windowHeaderChanged
THEN {
h.windowHeaderChanged ¬ FALSE;
XlConventions.SetWindowName[c, shell.window, h.windowHeader];
};
IF h.wmClassChanged
THEN {
h.wmClassChanged ¬ FALSE;
XlConventions.SetWMClass[c, shell.window, h.wmClassClass, h.wmClassInstance];
};
IF h.transientForChanged
THEN {
h.transientForChanged ¬ FALSE;
XlConventions.SetWMTransient[c, shell.window, ToWindow[h.transientFor]];
};
IF h.protocolsChanged
THEN {
h.protocolsChanged ¬ FALSE;
XlConventions.SetWMProtocols[c, shell.window, h.protocols];
};
Xl.Flush[c, TRUE];
};
ForgetHints:
PROC [h:
REF XTkShellWidgets.ICCCMHints] = {
IF h#
NIL
THEN {
h.wmHints.windowGroup ¬ Xl.nullWindow;
h.wmHints.iconMask ¬ Xl.nullPixmap;
h.wmHints.iconPixmap ¬ Xl.nullPixmap;
h.wmHints.iconWindow ¬ Xl.nullWindow;
h.wmHintsChanged ¬ h.wmHints#[];
h.wmNormalHintsChanged ¬ h.wmNormalHints#[];
h.windowHeaderChanged ¬ h.windowHeader#NIL;
h.iconNameChanged ¬ h.iconName#NIL;
h.transientForChanged ¬ h.transientFor#NIL;
h.wmClassChanged ¬ h.wmClassInstance#NIL OR h.wmClassClass#NIL;
h.protocolsChanged ¬ h.protocols#NIL;
};
};
CreateShell:
PUBLIC
PROC [widgetSpec: WidgetSpec, child: Widget ¬
NIL, windowHeader:
ROPE ¬
NIL, iconName:
ROPE ¬
NIL, className:
ATOM ¬
NIL, packageName:
ROPE ¬
NIL, shortName:
ROPE ¬
NIL, rootTQ:
TQ ¬
NIL, dontQueryGeometry:
BOOL ¬
FALSE, deletionProtocol:
BOOL ¬
TRUE, focusProtocol:
BOOL ¬
TRUE, standardMigration:
BOOL ¬
TRUE]
RETURNS [widget: Widget] = {
widget ¬ XTk.CreateWidget[widgetSpec, shellClass];
rootTQ ¬ EnsureRootThread[rootTQ];
BEGIN
shellIP: ShellInstPart ~ GetShellInstPart[widget];
shellIP.originalRootTQ ¬ rootTQ;
shellIP.crazyShell ¬ FALSE;
shellIP.dontQueryGeometry ¬ dontQueryGeometry;
shellIP.className ¬ (IF className#NIL THEN className ELSE $Shell);
shellIP.deletionProtocol ¬ deletionProtocol;
shellIP.packageName ¬ packageName;
IF widgetSpec.instName=
NIL
THEN {
IF ~Rope.IsEmpty[shortName] THEN widgetSpec.instName ← Atom.MakeAtom[shortName];
}
ELSE {
IF Rope.IsEmpty[shortName] THEN shortName ← Atom.GetPName[widgetSpec.instName];
};
shellIP.shortName ¬ shortName;
shellIP.iconName ¬ iconName;
END;
BEGIN
hints: REF XTkShellWidgets.ICCCMHints ¬ GetHints[widget];
IF windowHeader#
NIL
THEN {
hints.windowHeader ¬ windowHeader;
hints.windowHeaderChanged ¬ TRUE;
};
IF iconName#
NIL
THEN {
hints.iconName ¬ iconName;
hints.iconNameChanged ¬ TRUE;
};
IF className#
NIL
AND hints.wmClassClass=
NIL
THEN {
hints.wmClassClass ¬ Atom.GetPName[className];
hints.wmClassChanged ¬ TRUE;
};
IF focusProtocol THEN SetFocusMethod[shell: widget, focusProtocol: true];
IF deletionProtocol
THEN {
hints.protocols ¬ AddRope["WM�LETE←WINDOW", hints.protocols];
hints.protocolsChanged ¬ TRUE;
};
END;
IF child#
NIL
THEN
AddChildLR[shell: widget, newChild: child];
IF standardMigration
THEN
XTkMigration.RegisterMigrator[widget, XTkMigration.StandardMigrator];
};
ApplicationClassName:
PUBLIC
PROC [shell: ShellWidget]
RETURNS [className
: ATOM] = {
shellIP: ShellInstPart ~ GetShellInstPart[shell];
RETURN [shellIP.className]
};
BindScreenShell:
PUBLIC
PROC [shell: ShellWidget, connection:
REF ¬
NIL, parentWindow: Xl.Window ¬ Xl.nullWindow] = {
MyCreateConnection:
PROC [r: Rope.
ROPE ¬
NIL, atom:
ATOM ¬
NIL] = {
c ¬ Xl.CreateConnection[server: r, applicationKey: atom];
refCountObject ¬ NIL;
mustDecrementRefCount ¬ TRUE;
};
refCountObject: REF ¬ NIL;
mustDecrementRefCount: BOOL ¬ FALSE;
c: Xl.Connection;
screenDepth: Xl.ScreenDepth;
shellIP: ShellInstPart ~ GetShellInstPart[shell];
IF shellIP.connection#NIL THEN ERROR; --already bound
shell.connection ¬ NIL;
IF connection=
NIL
THEN {
--This is a convention by which the environment gets a chance to fill in the connection, or, make a readable error message.
XTkNotification.CallAll[$GetShellConnection, shell, shellIP.className];
c ¬ shellIP.connection ¬ shell.connection;
--The created connection has a ref count increased which needs to be undone
IF Xl.Alive[c]
THEN {
refCountObject ¬ shell;
mustDecrementRefCount ¬ TRUE;
};
};
IF ~Xl.Alive[c]
THEN {
IF connection=
NIL
THEN MyCreateConnection[]
ELSE
WITH connection
SELECT
FROM
a: ATOM => MyCreateConnection[NIL, a];
r: Rope.ROPE => MyCreateConnection[r];
rt: REF READONLY TEXT => MyCreateConnection[Rope.FromRefText[rt]];
xc: Xl.Connection => c ¬ xc;
ENDCASE => ERROR;
IF ~Xl.Alive[c]
THEN {
err: REF Xl.EventRep.errorNotify ~ NEW[Xl.EventRep.errorNotify];
err.connection ¬ c;
err.errorKind ¬ requestFromDeadConnection;
err.explanation ¬ "XTk.BindScreenShell using dead connection";
ERROR Xl.XError[err];
};
shell.connection ¬ shellIP.connection ¬ c;
};
shellIP.parentWindow ¬ parentWindow;
screenDepth ¬ Xl.QueryScreenDepth[c, shellIP.parentWindow];
IF parentWindow=Xl.nullWindow
THEN {
Try to select a more favorable screenDepth
screen: Xl.Screen ¬ screenDepth.screen;
IF screenDepth.depth#1
AND screenDepth.depth#8
THEN {
FOR sdl: Xl.ScreenDepthL ¬ screen.screenDepthL, sdl.rest
WHILE sdl#
NIL
DO
IF sdl.first.screen=screen
AND sdl.first.nVisualTypes>0
THEN {
IF sdl.first.depth=1
OR sdl.first.depth=8
THEN {
screenDepth ¬ sdl.first
};
};
ENDLOOP;
};
};
XTkFriends.BindScreenLR[widget: shell, rootTQ: shellIP.originalRootTQ, screen: screenDepth.screen, screenDepth: screenDepth];
IF mustDecrementRefCount THEN Xl.DecRefCount[c, refCountObject];
};
ShellBindScreenLX: XTk.BindScreenProc = {
shellIP: ShellInstPart ~ GetShellInstPart[widget];
shellIP.connectionWatcherMatch ¬ NEW[Xl.MatchRep ¬ [proc: ConnectionDiedHandler, handles: connectionDeadSet, tq: rootTQ, data: widget]];
XlDispatch.AddMatch[screen.connection, Xl.nullWindow, shellIP.connectionWatcherMatch, Xl.unspecifiedEvents, XTkPrivate.detailsForNoErrors];
Xl.IncRefCount[screen.connection, widget];
IF ~shellIP.dontQueryGeometry
THEN {
g: Xl.Geometry ¬ XTkDB.GetGeometryFromDB[widget];
IF g.size.width>0 THEN widget.s.geometry.size.width ¬ g.size.width;
IF g.size.height>0 THEN widget.s.geometry.size.height ¬ g.size.height;
IF g.pos.x>=0 THEN widget.s.geometry.pos.x ¬ g.pos.x;
IF g.pos.y>=0 THEN widget.s.geometry.pos.y ¬ g.pos.y;
IF g.borderWidth>=0 THEN widget.s.geometry.borderWidth ¬ g.borderWidth;
IF g.size.width>0
AND g.size.height>0
THEN {
h: REF XTkShellWidgets.ICCCMHints ~ GetHints[widget];
h.wmNormalHints.userSize ¬ h.wmNormalHints.clientSize ¬ TRUE;
h.wmNormalHintsChanged ¬ TRUE;
};
IF g.pos.y>=0
AND g.pos.x>=0
THEN {
h: REF XTkShellWidgets.ICCCMHints ~ GetHints[widget];
h.wmNormalHints.userPos ¬ h.wmNormalHints.clientPos ¬ TRUE;
h.wmNormalHintsChanged ¬ TRUE;
};
};
};
ForgetScreenShell:
PUBLIC
PROC [shell: ShellWidget] = {
shellIP: ShellInstPart ~ GetShellInstPart[shell];
action:
PROC = {
shellIP.connection ¬ NIL;
XTkFriends.ForgetScreenLR[shell]
};
Xl.CallWithLock[shellIP.originalRootTQ, action];
};
RefCountData: TYPE = RECORD [c: Xl.Connection, object: REF];
ShellForgetScreenLR: XTk.TerminateProc = {
c: Xl.Connection ¬ widget.connection;
shellIP: ShellInstPart ~ GetShellInstPart[widget];
ForgetHints[shellIP.hints];
IF Xl.Alive[c]
THEN {
rcd: REF RefCountData ~ NEW[RefCountData ¬ [c, widget]]; --Save the connection-object pair as the original widget.connection might change before QueuedDecrementRefCount is done.
wm: Xl.Match ¬ shellIP.connectionWatcherMatch;
IF wm#
NIL
THEN {
XlDispatch.RemoveMatch[c, Xl.nullWindow, wm, XTkPrivate.detailsForNoErrors];
shellIP.connectionWatcherMatch ¬ NIL;
};
--enqueued to be last thing on rootTQ, and, connection stays alive for our continuation (e.g. super classes TerminateProc).
Xl.Enqueue[tq: widget.rootTQ, proc: QueuedDecrementRefCount, data: rcd];
};
};
QueuedDecrementRefCount<<old rootTQ>>: Xl.EventProcType = {
rcd: REF RefCountData ¬ NARROW[clientData];
Xl.DecRefCount[rcd.c, rcd.object];
};
CreateInteroperabilityShell:
PUBLIC
PROC [widgetSpec: WidgetSpec ¬ [], child: Widget ¬
NIL, className:
ATOM ¬
NIL, rootTQ:
TQ ¬
NIL]
RETURNS [widget: Widget] = {
widget ¬ XTk.CreateWidget[widgetSpec, shellClass];
rootTQ ¬ EnsureRootThread[rootTQ];
BEGIN
shellIP: ShellInstPart ~ GetShellInstPart[widget];
shellIP.crazyShell ¬ TRUE;
shellIP.originalRootTQ ¬ rootTQ;
shellIP.dontQueryGeometry ¬ TRUE;
shellIP.className ¬ (IF className#NIL THEN className ELSE $InterOpShell);
END;
IF child#
NIL
THEN
AddChildLR[shell: widget, newChild: child];
};
BindInteroperabilityShell:
PUBLIC
PROC [shell: ShellWidget, connection: Xl.Connection, foreignParent: Xl.Window] = {
BindScreenShell[shell, connection, foreignParent];
};
SetShellChild:
PUBLIC
PROC [shell: ShellWidget, child: Widget] = {
action:
PROC = {
IF child.s.mapping=dontUse THEN child.s.mapping ¬ mapped;
AddChildLR[shell: shell, newChild: child]
};
shellIP: ShellInstPart ~ GetShellInstPart[shell];
Xl.CallWithLock[shellIP.originalRootTQ, action];
};
ConfigureRec: TYPE = RECORD [widget: Widget, geometry: Xl.Geometry, mapping: Mapping, reConsiderChildren: BOOL];
ForkRealizeShell:
PUBLIC
PROC [shell: ShellWidget, geometry: Xl.Geometry, mapping: Mapping, reConsiderChildren:
BOOL] = {
shellIP: ShellInstPart ~ GetShellInstPart[shell];
cr: REF ConfigureRec ¬ NEW[ConfigureRec ¬ [shell, geometry, mapping, reConsiderChildren]];
Xl.Enqueue[shellIP.originalRootTQ, ForkedRealizeShell, cr];
};
ForkedRealizeShell<<rootTQ>>: Xl.EventProcType = {
cr: REF ConfigureRec ¬ NARROW[clientData];
ReallyRealizeShellLR[cr.widget, cr.geometry, cr.mapping, cr.reConsiderChildren];
};
RealizeShell:
PUBLIC
PROC [shell: ShellWidget, geometry: Xl.Geometry, mapping: Mapping, reConsiderChildren:
BOOL] = {
shellIP: ShellInstPart ~ GetShellInstPart[shell];
action: PROC = {ReallyRealizeShellLR[shell, geometry, mapping, reConsiderChildren]};
Xl.CallWithLock[shellIP.originalRootTQ, action];
};
ReallyRealizeShellLR:
PROC [shell: ShellWidget, geometry: Xl.Geometry, mapping: Mapping, reConsiderChildren:
BOOL] = {
shellIP: ShellInstPart ~ GetShellInstPart[shell];
IF mapping=dontUse
THEN {
IF shell.actualMapping>=dontUse THEN mapping ¬ mapped
};
IF shell.state>screened THEN BindScreenShell[shell];
XTkIcon.SetIconName[shell, TRUE, shellIP.iconName];
XTkIcon.SetIconMask[shell, TRUE, shellIP.packageName, shellIP.shortName];
XTkFriends.ConfigureLR[shell, geometry, mapping, reConsiderChildren];
BEGIN
c: Xl.Connection ¬ shell.connection;
IF Xl.Alive[c] THEN Xl.Flush[c, TRUE];
END;
};
DestroyShell:
PUBLIC
PROC [shell: ShellWidget] = {
shellIP: ShellInstPart ~ GetShellInstPart[shell];
action: PROC = {XTkFriends.DestroyWidgetLR[shell]};
Xl.CallWithLock[shellIP.originalRootTQ, action];
};
ShellPreStopFastAccess: TerminateProc = {
shellIP: ShellInstPart ~ GetShellInstPart[widget];
shellIP.focusTime ¬ [0];
IF ~shellIP.finallyUnmapped
AND widget.window#nullWindow
THEN {
shellIP.finallyUnmapped ¬ TRUE;
IF reason=normal AND Xl.Alive[widget.connection] THEN Xl.UnmapWindow[widget.connection, widget.window, XTkPrivate.detailsForFlushSoonNoErrors];
};
WITH shellIP.focusGoal
SELECT
FROM
w: XTk.Widget => {};
ENDCASE => shellIP.focusGoal ¬ NIL;
};
GetShellInstPart:
PROC [w: Widget]
RETURNS [ShellInstPart] =
INLINE {
RETURN [ NARROW[XTkFriends.InstPart[w, shellClass]] ];
};
EntryTrackCM:
ENTRY
PROC [shell: ShellWidget, shellIP: ShellInstPart, w: Widget] = {
ENABLE UNWIND => NULL;
IF shellIP#
NIL
THEN {
cnt: INT ¬ 1;
lag: LIST OF Widget ¬ shellIP.childrenWithColorMap;
IF w#
NIL
THEN {
lag ¬ CONS[w, lag];
--prevent duplications
FOR l:
LIST
OF Widget ¬ lag, lag.rest
WHILE l#
NIL
DO
IF l.first=w THEN RETURN;
ENDLOOP
};
WHILE lag#
NIL
AND lag.first.state>=dead
DO
lag ¬ lag.rest;
ENDLOOP;
shellIP.childrenWithColorMap ¬ lag;
IF lag=NIL THEN RETURN;
DO
IF lag.rest=NIL THEN EXIT;
IF lag.rest.first.state>=dead
THEN lag.rest ¬ lag.rest.rest
ELSE {lag ¬ lag.rest; cnt ¬ cnt+1}
ENDLOOP;
IF shell.fastAccessAllowed=ok
THEN {
d: REF Xl.Card32Sequence ¬ MakeColorMapData[shellIP, cnt];
PutTheColorMapProp[shell, d ! Xl.XError => CONTINUE];
buffer ¬ d;
}
};
};
buffer: REF Xl.Card32Sequence ¬ NIL;
MakeColorMapData:
INTERNAL
PROC [shellIP: ShellInstPart, cnt:
INT]
RETURNS [d:
REF Xl.Card32Sequence ¬
NIL] = {
IF cnt>0
THEN {
lw: LIST OF Widget ¬ shellIP.childrenWithColorMap;
IF buffer#
NIL
AND buffer.leng>=cnt
THEN {d ¬ buffer; buffer ¬ NIL}
ELSE d ¬ NEW[Card32Sequence[cnt]];
FOR i:
INT
IN [0..cnt)
DO
IF lw#
NIL
THEN {d[i] ¬ lw.first.window; lw ¬ lw.rest}
ELSE d[i] ¬ Xl.nullWindow;
ENDLOOP
};
};
PutTheColorMapProp:
PROC [shell: ShellWidget, value:
REF Xl.Card32Sequence] = {
IF value#
NIL
THEN {
propertyKey: XAtom ¬ Xl.MakeAtom[shell.connection, "WM𡤌OLORMAP←WINDOWS"];
Xl.ChangeProperty[shell.connection, shell.window, propertyKey, XlPredefinedAtoms.window, replace, value];
};
};
TrackColorMap:
PUBLIC
PROC [shell: ShellWidget, w: Widget] = {
IF shell=NIL THEN shell ¬ XTk.RootWidget[w];
IF shell#
NIL
AND shell.fastAccessAllowed=ok
THEN {
shellIP: ShellInstPart ~ GetShellInstPart[shell];
IF shellIP.crazyShell THEN RETURN; --don't know how...
EntryTrackCM[shell, shellIP, w];
};
ShellClassName: ClassNameProc = {
shellIP: ShellInstPart ~ GetShellInstPart[widget];
RETURN [shellIP.className];
};
AddRope:
PROC [r: Rope.
ROPE, list:
LIST
OF Rope.
ROPE]
RETURNS [
LIST
OF Rope.
ROPE] = {
IF ~RopeList.Memb[list, r] THEN list ¬ CONS[r, list];
RETURN [list]
};
SetFocusMethod:
PUBLIC
PROC [shell: ShellWidget, focusProtocol, inputHint: Xl.
BOOL3 ¬ illegal] = {
h: REF XTkShellWidgets.ICCCMHints ¬ GetHints[shell];
IF focusProtocol#illegal
THEN {
wmTakeFocus: Rope.ROPE ¬ "WM←TAKE𡤏OCUS";
SELECT focusProtocol
FROM
true => {
h.protocols ¬ AddRope[wmTakeFocus, h.protocols];
h.protocolsChanged ¬ TRUE
};
false => {
h.protocols ¬ RopeList.DRemove[h.protocols, wmTakeFocus];
h.protocolsChanged ¬ TRUE
};
ENDCASE => {};
};
IF inputHint#illegal
THEN {
SELECT inputHint
FROM
true => {h.wmHints.input ¬ 1; h.wmHintsChanged ¬ TRUE};
false => {h.wmHints.input ¬ 0; h.wmHintsChanged ¬ TRUE};
ENDCASE => {};
};
UpdateHints[shell];
};
SetFocusTarget:
PUBLIC
PROC [shell: ShellWidget, child:
REF, time: Xl.TimeStamp] = {
shellIP: ShellInstPart ~ GetShellInstPart[shell];
IF ValidTime[shellIP.focusTime, time] THEN shellIP.focusGoal ¬ child
};
ValidTime:
PROC [lastTime, eventTime: Xl.TimeStamp]
RETURNS [
BOOL] = {
RETURN [
Xl.Period[from: lastTime, to: eventTime]>=0
OR eventTime=Xl.currentTime OR lastTime=Xl.currentTime
OR
--this is it! We want to prevent invalid times. But we want to survive if a crazy server did not get an event for LAST[TimeStamp]/2. So we assume a 2 minutes is the maximum delay which invalid times could be caused due to unsynchronized nonsense
Xl.Period[from: eventTime, to: lastTime]>120000 ]
};
SetFocus:
PUBLIC
PROC [shell: ShellWidget, time: Xl.TimeStamp, child:
REF] = {
w: Window;
shellIP: ShellInstPart ~ GetShellInstPart[shell];
IF ValidTime[shellIP.focusTime, time]
THEN {
IF child=NIL THEN child ¬ shellIP.focusGoal ELSE shellIP.focusGoal ¬ child;
w ¬ ToWindow[child];
IF w#Xl.nullWindow
THEN {
shellIP.focusTime ¬ time;
IF shell.fastAccessAllowed=ok
THEN
Xl.SetInputFocus[shell.connection, w, parent, time, XTkPrivate.detailsForFlushNoErrors];
};
};
};
FocusTime:
PUBLIC
PROC [shell: ShellWidget]
RETURNS [Xl.TimeStamp] = {
shellIP: ShellInstPart ~ GetShellInstPart[shell];
RETURN [shellIP.focusTime];
};
Might consider caching iconic/open state to suppress unnecessary operation. However, then we would need to keep atomically track of state. I'm not against it, but I'm not yet sure whether it is worth the effort.
Iconify:
PUBLIC
PROC [shell: ShellWidget] = {
--Forget about such things as using rootTQ. We never know iconic state atomically anyway since interactive actions of user through window manager are not synchronized.
IF shell.state>=dead THEN RETURN;
shell.s.mapping ¬ mapped;
SetIconicHint[shell, TRUE]; --irrelevant if open or iconic, useful if was withdrawn...
IF shell.state=realized
AND shell
.fastAccessAllowed=ok
THEN {
root: Xl.Window ¬ shell.screenDepth.screen.root;
atom: Xl.XAtom ¬ Xl.MakeAtom[shell.connection, "WM𡤌HANGE←STATE"];
Xl.SendClientMessage32[c: shell.connection, destination: root, propagate:
FALSE,
eventMask: [substructureRedirect: TRUE, substructureNotify: TRUE],
window: shell.window,
type: atom,
data: [3, 0, 0, 0, 0],
details: XTkPrivate.detailsForFlushSoonNoErrors
];
};
--ELSE wont open and iconify shell; just make sure shell will be iconic on realization
};
OpenIcon:
PUBLIC
PROC [shell: ShellWidget] = {
--Forget about such things as using rootTQ. We never know iconic state atomically anyway since interactive actions of user through window manager are not synchronized.
IF shell.state>=dead THEN RETURN;
SetIconicHint[shell, FALSE]; --irrelevant if iconic or opened; useful if withdrawn...
shell.s.mapping ¬ mapped;
IF shell.state=realized
AND shell
.fastAccessAllowed=ok
THEN {
Xl.MapWindow[shell.connection, shell.window, XTkPrivate.detailsForFlushNoErrors];
--ELSE wont realize shell; just make sure shell will be opened on realization
}
};
WithDraw:
PUBLIC
PROC [shell: ShellWidget] = {
--Forget about such things as using rootTQ. We never know iconic state atomically anyway since interactive actions of user through window manager are not synchronized.
IF shell.state>=dead THEN RETURN;
shell.s.mapping ¬ unmapped;
IF shell.state=realized
AND shell
.fastAccessAllowed=ok
THEN {
root: Xl.Window ¬ shell.screenDepth.screen.root;
eb: Xl.EventRep.unmapNotify;
eb.eventWindow ¬ root;
eb.window ¬ shell.window;
eb.fromConfigure ¬ FALSE;
Xl.UnmapWindow[shell.connection, shell.window];
Xl.SendEvent[c: shell.connection, destination: root, propagate: FALSE, eventMask: [substructureRedirect: TRUE, substructureNotify: TRUE], eventBody: eb, details: XTkPrivate.detailsForFlushSoonNoErrors];
};
--ELSE shell stays withdrawn; however OpenIcon and Iconify will be delayed until realization.
};
SetIconicHint:
PROC [shell: ShellWidget, iconic:
BOOL] = {
shellIP: ShellInstPart ~ GetShellInstPart[shell];
h: REF XTkShellWidgets.ICCCMHints ¬ GetHints[shell];
h.wmHints.initialState ¬ IF iconic THEN 3 ELSE 1;
h.wmHintsChanged ¬ TRUE;
UpdateHints[shell];
};
SetHeader:
PUBLIC PROC [shell: ShellWidget, header:
ROPE]
= {
h: REF XTkShellWidgets.ICCCMHints ¬ GetHints[shell];
h.windowHeader ¬ header;
h.windowHeaderChanged ¬ TRUE;
UpdateHints[shell];
};
SetIconName:
PUBLIC PROC [shell: ShellWidget, header:
ROPE] = {
h: REF XTkShellWidgets.ICCCMHints ¬ GetHints[shell];
h.iconNameChanged ¬ TRUE;
UpdateHints[shell];
};
END.