XTk.mesa
Copyright Ó 1988, 1989, 1990, 1991 by Xerox Corporation. All rights reserved.
Created by Christian Jacobi, October 13, 1988 12:38:47 pm PDT
Christian Jacobi, April 7, 1992 11:16 am PDT
Willie-s, September 30, 1991 6:36 pm PDT
DIRECTORY
Atom USING [PropList],
Xl USING [Attributes, Connection, dontUse, Event, Geometry, MatchList, MatchRep, nullVisual, nullWindow, Point, Screen, ScreenDepth, SetOfEvent, Size, TQ, unspecifiedEvents, Visual, Window];
XTk: CEDAR DEFINITIONS
~ BEGIN OPEN Xl;
This is a quite simple toolkit.
Every visual object is called a widget; a widget is the data structure around a window.
This toolkit is influenced by the standard X toolkit intrinsics, but it is simplified, scaled down, and, cedarized.
Documentation
Friendly use expected;
Clients of a widget must NOT change most of the fields directly. Widgets are robust in the sense that fooling with a widget will not harm another top level widget tree. Widgets allow complete access of the whole X11 protocol by exposing the underlying window (Xl layer); they serve mainly to split the window creation process into phases to simplify geometry management and enable migration.
This package splits the "world" into three sides
Its implementation, and, the X window client interface.
Mechanisms to make the whole show possible.
Widget class implementors.
Are a little bit priviledged, and, also have more duties. They should be able to play many inheritance games.
Widget clients.
This is the main issue of the package: Widget clients should be easy to program. Widget clients should not modify most widget fields directly.
Phases
Creation: Data structures are created.
Screen binding: Enables fonts and sizes for geometry management.
Realization (Configure): Creation of X windows; finish set up of event matching requirements.
Running: Handle events; nothing happens unless widget client or widget class provides event handler.
Interactive modifications (Configure): ...
Fast stop interactive access.
Unrealization: Destroy X window.
Forgeting screen.
Widget destruction: (Get rid of circular references for the benefit of D-Machines)
Synchronization issues
Widgets of a particular tree should be created in a single thread (field access is NOT monitorized). Once the widget tree is created and left to events, further structural modifications, realization or resizing are only allowed with the lock of the "rootTQ".
Convention: Forked access to widget is NOT allwed before the widget is included in a widget tree defining the "rootTQ).
Event procedures may use different threads as they desire; except if they refer to other widgets the procedure should wait until that widget is realized to make sure the rootTQ of it is defined. Critical event procedures might simply run on "rootTQ" instead of testing widget for realization before use.
The postfix LR (Locking Root) on a procedure means the procedure must be called only with the rootTQ lock hold. This also implies that LR marked procedure or procedure variables must not be assigned to unmarked procedure variables or parameters.
The reverse does NOT hold: A LR marked procedure may of course call procedures without locking requirements, and, an unmarked procedure may be assigned to an LR marked variable.
This convention allows easy textual recognition whether the minimum locks are hold. It does not protect from holding locks too often.
The locking requirements are relaxed while creation of a widget because of the restriction of asynchrounous access.
The postfix LX is used for procedures which have special locking rules documented with the procedure. E.g. whether or not invokation of an LX procedure from an unmonitored caller is legal depends on its parameters.
For the case of multiple locks used, watch for the locking order. "rootTQ" should have a order=rootLockingOrder
Termination and cleanup issues
Termination procedures have two phases; the first phase may be called on any thread to stop interactions; the second phase is supposed to run on rootTQ.
Normal termination is supposed to clean up completely and return all resources.
Error termination is considered a bug and should happen only while debugging applications; in the case of error terminations data structures might be left alone and circular references unbroken. X resources won't be returned either.
Termination because of dying connection is considered rude and clean up of internal data structures might be optional. X resources will be claimed back by X and need not be delt with anyway.
Types and procedures public for all clients
Some types are, but some fields and dependent type might be less public
Event: TYPE = Xl.Event;
TQ: TYPE = Xl.TQ;
Widget: TYPE = REF WidgetRep;
dontUse: INT = Xl.dontUse;
rootLockingOrder: INT = 5; --useful if you create your own rootTQ
Mapping:
TYPE = {mapped, unmapped, unconfigured, dontUse, unmapIfMapped, mapIfUnmapped, unmapIfUnconfigured, mapIfUnconfigured};
Class methods will only see
mapping IN [mapped..dontUse],
widget.actualMapping IN [mapped, unmapped, unconfigured]
Client may ask for any value
WidgetSpec:
TYPE =
RECORD [
--Fields useful for initialization of widgets
class: Class ¬ NIL,
geometry: Xl.Geometry ¬ [], --as requested
mapping: Mapping ¬ dontUse, --as requested
instName: ATOM ¬ NIL, --key for database lookup; class might overwrite this
clientData: REF ¬ NIL --reserved for clients
];
FastAccessState:
TYPE = {ok, warned};
Clients and class implementors: please use only =ok or #ok; all other values are private to XTkImpl
WindowState:
TYPE = {realized, warned, screened, existing, dead};
WidgetRep:
TYPE =
MONITORED
RECORD [
--Monitor used for small leaf procedures. The idea is that it this is safer then to have packages use global monitors. This way in case of errors only single widgets wedge and take only a single widgets tree down. This makes debugging easier.
s: WidgetSpec ¬ [], --public read - write
depth: INTEGER ¬ 0, --public read - write
visual: Visual ¬ nullVisual, --public read - write
attributes: Attributes ¬ [], --public read - write
flags: PRIVATE WidgetFlags ¬ ALL[FALSE], --private to prevent unmonitored access
parent: <<READONLY>> Widget ¬ NIL,
matchListX: PRIVATE LIST OF MatchRep ¬ NIL, --permanent
matchList1: PRIVATE MatchList ¬ NIL, --temporary
connection: <<READONLY>> Connection ¬ NIL,
window: <<READONLY>> Window ¬ nullWindow,
screenDepth: <<READONLY>> ScreenDepth ¬ NIL,
fastAccessAllowed: <<
READONLY>> FastAccessState ¬ warned,
-- not monitored.
--When changed, the new value is automatically set by XTkImpl before class procedures are called. Readonly even to class implementors.
state: <<
READONLY>> WindowState ¬ existing,
-- (rootTQ+LX)!
--When changed, the new value is automatically set by XTkImpl before class procedures are called. Readonly even to class implementors.
actual: <<READONLY>> Xl.Geometry ¬ [], --final geometry
actualMapping: <<
READONLY>> Mapping ¬ dontUse,
--final visibility (rootTQ)
--Normally set by class when mapping change is made.
rootTQ: <<READONLY>> TQ ¬ NIL, --initialized on BindScreen
notifiers: PRIVATE REF ¬ NIL,
props: PRIVATE REF ¬ NIL,
wClassData:
PRIVATE SEQUENCE leng:
NAT
OF
REF
--Every layer in class hierarchy can put some class dependent data here
];
CreateWidget:
PROC [widgetSpec: WidgetSpec, class: Class ¬
NIL, arguments: Atom.PropList ¬
NIL]
RETURNS [Widget];
Creates a widget and lets class initialize fields.
Arguments will be seen by all subclasses while the creation.
Warning: Certain classes might not support this procedure.
Efficiency hint: Keep number of arguments small.
DestroyWidget:
PROC [widget: Widget, startReconfigureParent:
BOOL ¬
TRUE];
Destroys widget. Option: friendly asks parent of widget to re-consider its children.
Callable from any thread.
Flags
Flags are a long list of boolean values to store some information faster then with property lists. Flags must be changed only with the proper procedure to make it an atomic operation. Applications must reserve flags explicitly; the documentation says how.
ClassFlags are inherited at sub class creation.
WidgetFlagKey: TYPE = {wf0, wf1, wf2, wf3, wf4, wf5, wf6, wf7, wf8, wf9, wf10, wf11, wf12, wf13, wf14, wf15, wf16, wf17, wf18, wf19, wf20, wf21, wf22, wf23, wf24, wf25, wf26, wf27, wf28, wf29, wf30, wf31};
WidgetFlags: TYPE = PACKED ARRAY WidgetFlagKey OF BOOL ¬ ALL[FALSE];
SetWidgetFlag: PROC [widget: Widget, key: WidgetFlagKey, value: BOOL ¬ TRUE];
GetWidgetFlag:
PROC [widget: Widget, key: WidgetFlagKey]
RETURNS [
BOOL] =
INLINE {
RETURN [widget.flags[key]];
};
mustReConsiderChildren: WidgetFlagKey = wf0; --Set by any child which wants parent to reconsider its children.
preferredSizeFromDB: WidgetFlagKey = wf1; --if this flag is set and the window not realized the database is queried for the preferred size of a widget. Otherwise, and, when the database doesn't provide a value the normal class method is used.
preferredSizeCurrent: WidgetFlagKey = wf2; --if this flag is set and the window already is realized the specified size of the widget is to be used. Otherwise the normal class method is used.
ClassFlagKey: TYPE = {cf0, cf1, cf2, cf3, cf4, cf5, cf6, cf7, cf8, cf9, cf10, cf11, cf12, cf13, cf14, cf15, cf16, cf17, cf18, cf19, cf20, cf21, cf22, cf23, cf24, cf25, cf26, cf27, cf28, cf29, cf30, cf31};
ClassFlags: TYPE = PACKED ARRAY ClassFlagKey OF BOOL ¬ ALL[FALSE];
SetClassFlag: PROC [class: ImplementorClass, key: ClassFlagKey, value: BOOL ¬ TRUE];
GetClassFlag:
PROC [class: Class, key: ClassFlagKey]
RETURNS [
BOOL] =
INLINE {
RETURN [class.flags[key]];
};
Properties
GetWidgetProp:
PROC [widget: Widget, key:
REF]
RETURNS [
REF];
Fetches a value from the widgets property list; NIL if not found.
PutWidgetProp:
PROC [widget: Widget, key:
REF, value:
REF ¬
NIL];
Puts a property key value pair on the widgets property list.
A nil value removes the property.
Notifiers
LOCKING RULES: Notifiers on LR marked keys must not be invoked outside the lock of the root.
Further locking convention: Notifiers on LR marked keys are to be protected from general client invocation (but not registration).
WidgetNotifyProc:
TYPE =
PROC [widget: Widget, registerData, callData:
REF ¬
NIL, event: Event ¬
NIL];
Type for notifier procedure.
registerData from RegisterNotifier.
callData depending on actual caller.
Warning: many built in usages do not specify event.
RegisterNotifier:
PROC [widget: Widget, key:
REF, procLX: WidgetNotifyProc, registerData:
REF ¬
NIL];
Registers a callback notifier for widget. The notifier proc's will be called according to the specification of "key".
LOCKING RULE: procedures with the LR postfix must only be registered with authorized LR keys.
UnRegisterNotifier:
PROC [widget: Widget, key:
REF, procLX: WidgetNotifyProc, registerData:
REF ¬
NIL];
Undo of RegisterNotifier on widget with matching key and identical procLX and registerData
preWindowCreationLRKey: READONLY ATOM; -- ¬ $preWindowCreation
preWindowCreationKey:
READONLY
ATOM;
-- ¬
$preWindowCreation
Notifiers called in realization (configure) before window creation. Called on rootTQ.
Do not expect coordinates to be already set up.
postWindowCreationLRKey: READONLY ATOM; -- ¬ $postWindowCreation
postWindowCreationKey:
READONLY
ATOM;
-- ¬
$postWindowCreation
Notifiers called in realization (configure) after window creation.
Note that the window usually is not yet mapped. Called on rootTQ.
postConfigureLRKey: READONLY ATOM; -- ¬ $postConfigure
postConfigureKey:
READONLY
ATOM;
-- ¬
$postConfigure
Notifiers called after Configure if neither window creation or destruction is involved.
Called on rootTQ.
postWindowDestructionLRKey: READONLY ATOM; -- ¬ $postWindowDestruction
postWindowDestructionKey:
READONLY
ATOM;
-- ¬
$postWindowDestruction
Notifiers called in configure after window destruction.
Called on rootTQ.
preStopFastAccessKey:
READONLY
ATOM;
-- ¬
$preStopFastAccess
Notifiers called in early phase of widget destruction to stop interactions accessing window.
Called on random thread, not monitored. [small window of multiple calls]
postStopFastAccessLRKey: READONLY ATOM; -- ¬ $postStopFastAccess
postStopFastAccessKey:
READONLY
ATOM;
-- ¬
$postStopFastAccess
Notifiers called in late phase of widget destruction (after window destruction) useful to break cycles. Called on rootTQ.
bindScreenLRKey: PUBLIC ATOM; -- ¬ $bindScreen
bindScreenKey:
PUBLIC
ATOM;
-- ¬
$bindScreen
Notifiers called when screen is installed. Called on installed rootTQ.
forgetScreenLRKey: PUBLIC ATOM; -- ¬ $forgetScreen
forgetScreenKey:
PUBLIC
ATOM;
-- ¬
$forgetScreen
Notifiers called when forgetting screen. Called on rootTQ.
postWidgetDestructionKey:
READONLY
ATOM;
-- ¬
$postWidgetDestruction
Notifiers called in late phase of widget destruction (this callback is not invoked by garabage collection).
Called on random thread, not monitored. [small window of multiple calls]
Restrict usage to breaking circular structures, as this notification might be disabled in debugging worlds.
Widget operations
AddPermanentMatch:
PROC [widget: Widget, matchRep: MatchRep, generate: SetOfEvent ¬ unspecifiedEvents];
Adds a match to the permanent match-list of a widget which is used for all realizations.
Catches event if X server generates it; Tells X server to generate event...
If window is already realized then also issues X request.
ORs generate into widget.s.attributes.
A nil tq defaults to the rootTQ.
AddTemporaryMatch:
PROC [widget: Widget, matchRep: MatchRep, generate: SetOfEvent ¬ unspecifiedEvents];
Adds a match to the temporary match-list of a widget to be used on next realization.
Catches event if X server generates it; Tells X server to generate event...
If window is already realized then also issues X request.
ORs generate into widget.s.attributes.
A nil tq defaults to the rootTQ.
G:
PROC [w, h, b:
INT ¬ dontUse]
RETURNS [Geometry] =
INLINE {
RETURN [[pos: [dontUse, dontUse], size: [w, h], borderWidth: b]]
};
RootWidget:
PROC [widget: Widget]
RETURNS [Widget];
Returns root widget of widget
Defined only after widget tree has assembled
BorderWidth:
PROC [widget: Widget]
RETURNS [
INT];
Returns borderWidth of widget; won't return dontUse
ScreenBound:
PROC [widget: Widget]
RETURNS [
BOOL];
Returns whether widget is bound to a screen
SynchronizeFastAccess:
PROC [widget: Widget, protectTQ:
TQ];
On next FullStopFastAccess the widget will try to synchronize with protectTQ.
Please consider this a heavy weight operation.
Orphanization
When a parent widget dies, is destroyed, or, decides to remove and destroy a child, it gives the child widget a chance to save itself. This is useful if a widget contains valuable application state. Orphanization is typically registered by the client of a widget instance.
The default behaviour for destruction is to destroy the widget without notification to the parent.
OrphanProc:
TYPE =
PROC [orphan: Widget];
Will be called on rootTQ.
Asynchronous and environment access is already stopped before the orphan proc is called.
Once an orphan proc is called, old parent widget will not touch orphan anymore.
RegisterOrphanProc:
PROC [self: Widget, orphanProcLR: OrphanProc ¬
NIL];
Registers orphan procedure. An eventual previously registered orphan procedure is removed.
NIL resets default behaviour.
Class access
HasClass:
PROC [widget: Widget, class: Class]
RETURNS [
BOOL] =
Returns whether a widget has a particular class or subclass thereof
INLINE {IF HasProperClass[widget, class] THEN RETURN [TRUE]
ELSE RETURN [HasSubClass[widget, class]]};
HasProperClass:
PROC [widget: Widget, class: Class]
RETURNS [
BOOL] =
Returns whether a widget has a particular class exactly
INLINE {RETURN [widget.s.class=class]};
HasSubClass:
PROC [widget: Widget, class: Class]
RETURNS [
BOOL];
Returns whether a widget has a proper subclass of class
HasClassKey:
PROC [widget: Widget, classKey:
ATOM]
RETURNS [
BOOL] =
Returns whether a widget has a particular class or subclass thereof
INLINE {IF HasProperClassKey[widget, classKey] THEN RETURN [TRUE]
ELSE RETURN [HasSubClassKey[widget, classKey]]};
HasProperClassKey:
PROC [widget: Widget, classKey:
ATOM]
RETURNS [
BOOL] =
Returns whether a widget has a particular class exactly
INLINE {RETURN [widget.s.class.key=classKey]};
HasSubClassKey:
PROC [widget: Widget, classKey:
ATOM]
RETURNS [
BOOL];
Returns whether a widget has a proper subclass of classKey
ClassName:
PROC [widget: Widget]
RETURNS [
ATOM] =
INLINE {
Returns useful key for database lookup
Not unique !
RETURN [widget.s.class.className[widget]]
};
Resizing, Widget Tree operations
NoteChildChange:
PROC [widget: Widget];
Notifies widget that on of its children whishes a change in state.
The note will not be acted upon until the next checking time of widget.
Callable from any thread.
NoteChildChangePropagate:
PROC [widget: Widget, top: Widget ¬
NIL];
Like NoteChildChange but further ancestors are notified too.
Stops propagation at top. (top=NIL is shortcut for root).
NoteGeometryChange:
PROC [widget: Widget, geometry: Geometry ¬ []];
Stores new geometry in widget and notifies direct parent of desired change (if any).
The note will not be acted upon until the next checking time of widget.
The parent will do its best at the next checking time (on next StartReconfigure), but does not give any guarantee.
Callable from any thread. (Monitors structure only, not correctness of geometry)
NoteGeometryChangePropagate:
PROC [widget: Widget, geometry: Geometry ¬ [], top: Widget ¬
NIL];
Stores new geometry in widget and notifies direct parent of desired change (if any).
The note will not be acted upon until the next checking time of widget .
The parent will do its best at the next checking time (on next StartReconfigure), but does not give any guarantee.
Callable from any thread. (Monitors structure only, not correctness of geometry)
NoteMappingChange:
PROC [widget: Widget, mapping: Mapping ¬ dontUse];
Stores new mapping in widget and notifies direct parent of desired change (if any).
The note will not be acted upon until the next checking time of widget.
The parent will do its best at the next checking time (on next StartReconfigure), but does not give any guarantee.
Callable from any thread. (Monitors structure only, not correctness of geometry)
NoteMappingChangePropagate:
PROC [widget: Widget, mapping: Mapping ¬ dontUse, top: Widget ¬
NIL];
Like NoteChildChange but further ancestors are notified too.
Stops propagation at top. (top=NIL is shortcut for root).
StartReconfigureChildren:
PROC [widget: Widget];
Checks size and mapping whishes of widget's children and configure them if appropriate.
Callable from any thread.
NoteAndStartReconfigure:
PROC [widget: Widget, geometry: Geometry ¬ [], mapping: Mapping ¬ dontUse];
Conveniance proc.
Stores new geometry in widget, notifies direct parent, and, StartReconfigureChildren of parent.
Callable from any thread.
ShallowInternalEnumerateChildren:
PROC [widget: Widget, proc: EachChild, data:
REF ¬
NIL];
Shallow enumerates children widgets as used for propagation through widget tree! may include hidden children and therefore is probably not useful for general clients.
Adding or removing children while enumeration might not be considered in time.
Callable from any thread.
Types not used by simple clients
... but by widget sub class implementations
** means: called on rootTQ only
++ means: called on any thread
Class: TYPE = REF READONLY ClassRec;
ImplementorClass: TYPE = REF ClassRec;
ClassRec:
TYPE =
RECORD [
key: ATOM ¬ NIL,
properties: Atom.PropList ¬ NIL, --Do not use if you don't understand the inheritance and locking model.
classNameHint: ATOM ¬ NIL,
super: Class ¬ NIL,
wDataIdx:
NAT ¬ 0,
--Index into wClassData of widget for start of fields
--This field is set automatically at class creation; client values are ignored
wDataNum:
NAT ¬ 0,
--number of subClassData entries in widgets
--This layer in the class hierarchy occupies fields [wDataIdx..wDataIdx+wDataNum)
flags: ClassFlags ¬ ALL[FALSE], --private to prevent unmonitored access
configureLR:
PRIVATE ConfigureProc ¬
NIL,
--**
--Creation of window(realization), change of mapping, geometry
-- If creation: Connection filled in; preRealizers are called before calling class proc
--If a widget is reconfigured, it has no choice but must do it exactly as requested
--It might reconfigure its children in turn...
--It is ok to default this procedure
--If a non-defaulted configureLR proc wants to inherit, it must do so itself.
--Recursion through widget tree must be provided, it is not built in.
--Interactive access is already stopped externally if window needs to be destroyed.
actualCreateWindowLR:
PRIVATE WidgetProc ¬
NIL,
--**
--Used by some ConfigureProc's; especially the default configureLR.
--The actual create window part and eventaul mapping, all widget fields (except widget.window) are already set up by caller.
destroyWindowLR:
PRIVATE TerminateProc ¬
NIL,
--**
--Called instead of configureLR when window destruction is requested.
--Subclass chaining and tree recursion automatically.
removeChildLR:
PRIVATE RemoveChildProc ¬
NIL,
--**
--Called when child widget needs to be removed.
--It is ok if a widget class does NOT recognize and remove its children.
--Subclass chaining automatically.
--Once widget destruction is started removeChildLR might not be called anymore.
--Caller takes care of stopping and forgetting screen.
pleaseResizeChild: WidgetNChildProc ¬
NIL,
--Can be called from any child (unsynchronized) on its parent.
--Might be ignored, children resized, or request propagated up the widget tree
--If the proc decides to resize children it must do so on the rootTQ.
--Defaulting this procedure in a root class means ignoring request.
--If a non-defaulted pleaseResizeChild proc wants to inherit, it must do so itself.
preferredSizeLR: PreferredSizeProc ¬
NIL,
--**
--Returns preferred geometry for itself
--maySkip: dimension is not asked for [but might be returned anyway]
--proposed: proposal for dimension
--preferredSizeLR might or might not take advantage of maySkip and proposed
--but any returned value#dontUse might be used even if maySkip was true.
--If a non-defaulted preferredSizeLR proc wants to inherit, it must do so itself
--Environment (screen, connection) must be available
preStopFastAccess: TerminateProc ¬
NIL,
--++
--If widget is terminated it must stop doing interactions
--Subclass chaining and tree recursion automatically
fullStopFastAccessLR: FullStopFastAccessProc ¬
NIL,
--**
--If widget is terminated it must stop doing interactions
--Subclass chaining and tree recursion automatically
bindScreenLX: BindScreenProc ¬
NIL,
--**
--Subclass chaining and tree recursion automatically
forgetScreenLR: TerminateProc ¬
NIL,
--**
--Subclass chaining and tree recursion automatically
destroyWidget: WidgetProc ¬
NIL,
--Subclass chaining and optional tree recursion automatically
internalEnumerateChildren:
PRIVATE InternalEnumerateChildrenProc ¬
NIL,
--++
--Shallow enumerates children widgets as used for propagation through widget tree! Not thaught for general client usage. Should be fast, not use locking as it is used in terminators. Used for procedures automatically recursing through widget tree.
--Adding or removing children while enumeration might not be considered in time.
--Chained, in unknown order.
superWithIEC:
PRIVATE Class ¬
NIL,
--Allows to fast stop chaining internalEnumerateChildren
initInstPart:
PRIVATE InitInstancePartProc ¬
NIL,
--Called from CreateWidget only
--Chained: super class first, sub class afterwards
cursorKey:
PRIVATE REF ¬
NIL,
--Used if cursor is illegal at realization time; inherits if NIL
backgroundKey:
PRIVATE REF ¬
NIL,
--Used if background is illegal at realization time; inherits if NIL
borderColorKey:
PRIVATE
REF ¬
NIL,
--Used if background is illegal at realization time; inherits if NIL
eventMask:
PRIVATE SetOfEvent ¬ unspecifiedEvents,
--Used for initialization; ors with inherited classes
className:
PRIVATE ClassNameProc ¬
NIL,
--Should return key for database lookup.
--Called anytime any thread.
createSubClass:
PRIVATE CreateSubClassProc ¬
NIL,
--Called in CreateClass only, just before returning
--Chained: Called super class first, sub class afterwards, for every layer in class hierarchy providing this procedure.
cDataIdx:
NAT ¬ 0,
--index into cClassData of class for start of fields
--This field is set automatically at class creation; client values are ignored
cDataNum:
NAT ¬ 0,
--number of cClassData entries in class
--This layer in the class hierarchy occupies fields [cDataIdx..cDataIdx+cDataNum)
cClassData:
SEQUENCE leng:
NAT
OF
REF
--Every layer in class hierarchy can put some data here
];
WidgetProc:
TYPE =
PROC [widget: Widget];
InitInstancePartProc:
TYPE =
PROC [widget: Widget, arguments: Atom.PropList];
InternalEnumerateChildrenProc: TYPE = PROC [self: Widget, classLevel: Class, proc: EachChild, data: REF] RETURNS [stop: BOOL ¬ FALSE];
EachChild:
TYPE =
PROC [parent: Widget, child: Widget, data:
REF]
RETURNS [stop:
BOOL ¬
FALSE];
WidgetNChildProc:
TYPE =
PROC [widget, child: Widget];
--child must be NIL, or, child of widget
RemoveChildProc:
TYPE =
PROC [widget, child: Widget]
RETURNS [done:
BOOL ¬
FALSE];
--Conservative: Returns TRUE when child removed; Returns FALSE when child not removed or not found.
FullStopFastAccessProc:
TYPE =
PROC [widget: Widget, protectTQLR: TQProc, reason: TerminationReason];
TQProc:
TYPE =
PROC [tq:
TQ];
GeometryOption: TYPE = {x, y, w, h, b};
GeometryRequest: TYPE = PACKED ARRAY GeometryOption OF BOOL ¬ ALL[FALSE];
PreferredSizeProc:
TYPE =
PROC [widget: Widget, mode:
ATOM ¬
NIL, proposed: Xl.Geometry ¬ [], maySkip: GeometryRequest ¬
ALL[
FALSE]]
RETURNS [preferred: Xl.Geometry ¬ []];
ConfigureProc:
TYPE =
PROC [widget: Widget, geometry: Xl.Geometry ¬ [], mapping: Mapping ¬ dontUse, reConsiderChildren:
BOOL ¬
FALSE];
TerminateProc:
TYPE =
PROC [widget: Widget, reason: TerminationReason];
TerminationReason: TYPE = {normal, errorWindow, errorConnection};
--Termination should be propagated to children
--Normal termination should destroy the window
--Other termination should not access the connection; it or the window might be broken
BindScreenProc:
TYPE =
PROC [widget: Widget, rootTQ:
TQ, screen: Xl.Screen, screenDepth: Xl.ScreenDepth ¬
NIL];
ClassNameProc:
TYPE =
PROC [widget: Widget]
RETURNS [key:
ATOM ¬
NIL];
--Returns a class name
--this is not unique but handy for class key in database lookup
CreateSubClassProc:
TYPE =
PROC [superClass: Class, newClass: ImplementorClass, bottom:
BOOL];
--Called when a new class or subclass is generated
--Called chained, super class first
--bottom means: createdClass=superClass
Procedures for Widget Class implementors
For real stuff look at the XTkFriends interface
BasicMethodsRec:
TYPE =
RECORD [
--used for class creations
--general fields
key: ATOM,
classNameHint: ATOM ¬ NIL, --useful for className
super: Class ¬ NIL,
wDataNum: NAT ¬ 0,
cDataNum: NAT ¬ 0,
addFlags: ClassFlags ¬ ALL[FALSE],
--basic methods
preferredSizeLR: PreferredSizeProc ¬ NIL,
configureLR: ConfigureProc ¬ NIL,
actualCreateWindowLR: WidgetProc ¬ NIL,
destroyWindowLR: TerminateProc ¬ NIL,
removeChildLR: RemoveChildProc ¬ NIL,
pleaseResizeChild: WidgetNChildProc ¬ NIL,
preStopFastAccess: TerminateProc ¬ NIL,
fullStopFastAccessLR: FullStopFastAccessProc ¬ NIL,
bindScreenLX: BindScreenProc ¬ NIL,
forgetScreenLR: TerminateProc ¬ NIL,
destroyWidget: WidgetProc ¬ NIL,
internalEnumerateChildren: InternalEnumerateChildrenProc ¬ NIL,
initInstPart: InitInstancePartProc ¬ NIL,
--usefull for SimpleRealizeOneLevel
cursorKey: REF ¬ NIL,
backgroundKey: REF ¬ NIL,
borderColorKey: REF ¬ NIL,
eventMask: SetOfEvent ¬ unspecifiedEvents,
className: ClassNameProc ¬ NIL,
createSubClass: CreateSubClassProc ¬ NIL
];
END.