GenericToolImpl.mesa
Copyright © 1986 by Xerox Corporation. All rights reserved.
Demers, January 31, 1986 3:42:33 pm PST
Hal Murray, May 5, 1986 11:20:13 pm PDT
DIRECTORY
Abutters USING [Abutter, Create, QuaViewer, Series, SetLayout],
AMTypes USING [UnderType],
GenericTool USING [ButtonProc, Option, OptionList, ROPE, STREAM, ToolHandle, ToolObject],
IO USING [PutF, STREAM],
Loader USING [BCDBuildTime],
Rope USING [Cat, ROPE],
SafeStorage USING [GetReferentType],
TypeScript USING [Create],
ViewerClasses USING [Viewer, ViewerRec],
ViewerEvents USING [EventProc, RegisterEventProc],
ViewerIO USING [CreateViewerStreams],
ViewerOps USING [AddProp, FetchProp],
ViewRec USING [BindAllOfANameInType, BindAllOfATypeFromRefs, Binding, BindingList, BindingListAppend, clearMessagePlace, DisplayMessage, RecordViewer, RVQuaViewer, Type, ViewerQuaRV, ViewRef];
GenericToolImpl: CEDAR PROGRAM
IMPORTS Abutters, AMTypes, IO, Loader, Rope, SafeStorage, TypeScript, ViewerEvents, ViewerIO, ViewerOps, ViewRec
EXPORTS GenericTool
~ BEGIN
OPEN GenericTool;
CreateInstance: PUBLIC PROC [
toolName: ROPE,
control: REF ANY,
options: OptionList ← NIL,
data: REF ANY ← NIL,
preDestroy: ButtonProc ← NIL]
RETURNS [tH: ToolHandle] ~ {
bL: ViewRec.BindingList ← LIST[];
controlType: ViewRec.Type ~ AMTypes.UnderType[SafeStorage.GetReferentType[control]];
tH ← NEW[ToolObject ← [control~control, data~data]];
bL ← ViewRec.BindAllOfATypeFromRefs[
rec~control,
handle~NEW[ToolHandle ← tH],
visible~TRUE];
FOR finger: OptionList ← options, finger.rest WHILE finger # NIL DO
next: ViewRec.BindingList;
WITH finger.first SELECT FROM
ro: readonly Option => {
next ← ViewRec.BindAllOfANameInType[
agType~controlType,
name~ro.name,
b~[
name~NIL,
it~Value[val~NIL, visible~TRUE, editable~FALSE, dontAssign~TRUE]
]
];
};
inv: invisible Option => {
next ← ViewRec.BindAllOfANameInType[
agType~controlType,
name~inv.name,
b~[
name~NIL,
it~Value[val~NIL, visible~FALSE, editable~FALSE, dontAssign~TRUE]
]
];
};
nfy: notify Option => TRUSTED {
next ← ViewRec.BindAllOfANameInType[
agType~controlType,
name~nfy.name,
b~[
name~NIL,
it~Notify[notify~LOOPHOLE[nfy.proc], clientData~tH]
]
];
};
ENDCASE => ERROR;
bL ← ViewRec.BindingListAppend[a~bL, b~next];
ENDLOOP;
tH.abutter ← Abutters.Create[
viewerFlavor~NIL, info~[name~toolName, label~toolName, scrollable~FALSE, caption~TRUE],
paint~FALSE];
tH.logViewer ← TypeScript.Create[
info~[
parent~Abutters.QuaViewer[tH.abutter]],
paint~FALSE
];
{ logName: ROPE ~ Rope.Cat[toolName, ".log"];
[in~tH.in, out~tH.out] ← ViewerIO.CreateViewerStreams[name~logName, viewer~tH.logViewer, backingFile~logName, editedStream~FALSE] };
tH.controlsViewer ← ViewRec.RVQuaViewer[ ViewRec.ViewRef[
agg~control,
specs~bL,
createOptions~[relayoutable~FALSE, doAllRecords~TRUE, exclusiveProcs~FALSE],
viewerInit~[
parent~Abutters.QuaViewer[tH.abutter]],
paint~FALSE
] ];
Abutters.SetLayout[
a~ tH.abutter,
rules~[
left~[
rigid~LIST [],
end~parallel[
p~LIST [
[rigid~LIST [], end~stretch[se~[viewer~tH.controlsViewer]]],
[rigid~LIST [], end~stretch[se~[viewer~tH.logViewer]]]
]
]
],
right~[
rigid~LIST [],
end~parallel[
p~LIST [
[rigid~LIST [], end~stretch[se~[viewer~tH.controlsViewer]]],
[rigid~LIST [], end~stretch[se~[viewer~tH.logViewer]]]
]
]
],
top~[
rigid~LIST [ [viewer~tH.controlsViewer] ],
end~stretch[se~[viewer~tH.logViewer]]
],
bottom~[
rigid~LIST [],
end~stretch[se~[viewer~tH.logViewer]]
]
],
paint~TRUE
];
tH.preDestroy ← preDestroy;
ViewerOps.AddProp[Abutters.QuaViewer[tH.abutter], $ToolHandle, tH];
[] ← ViewerEvents.RegisterEventProc[proc~DestroyEventProc, event~destroy, filter~Abutters.QuaViewer[tH.abutter], before~TRUE];
IO.PutF[tH.out, "%g of %g\n\n",
[rope[toolName]], [time[Loader.BCDBuildTime[CreateInstance]]]
];
};
DestroyEventProc: ViewerEvents.EventProc
[viewer: Viewer, event: ViewerEvent, before: BOOL] RETURNS [abort: BOOL ← FALSE]
~ {
tH: ToolHandle;
IF event # destroy OR before # TRUE THEN ERROR;
IF (tH ← NARROW[ViewerOps.FetchProp[viewer, $ToolHandle]]) = NIL THEN RETURN;
IF tH.preDestroy = NIL THEN RETURN;
tH.preDestroy[tH];
};
PutMsgRope: PUBLIC PROC [tH: ToolHandle, rope: ROPE, clear: BOOL ← FALSE] ~ {
rv: ViewRec.RecordViewer ~ ViewRec.ViewerQuaRV[tH.controlsViewer];
IF clear THEN ViewRec.DisplayMessage[rv~rv, msg~ViewRec.clearMessagePlace];
ViewRec.DisplayMessage[rv~rv, msg~rope];
};
END.