CDCallSpecificImpl.mesa a Chipndale module
by Ch. Jacobi September 20, 1983 12:35 pm
last edited Christian Jacobi May 8, 1984 9:58:52 am PDT
DIRECTORY
CD,
CDApplications,
CDCallSpecific,
CDObjectProcs,
CDOps;
CDCallSpecificImpl: CEDAR PROGRAM
IMPORTS CDApplications, CDObjectProcs, CDOps
EXPORTS CDCallSpecific =
BEGIN
CallProc: TYPE = PROC [design: CD.Design, aptr: CD.ApplicationPtr, x: REF]
RETURNS [done: BOOLTRUE, removeMe: BOOLFALSE, include: CD.ApplicationList←NIL,
repaintMe: BOOLFALSE, repaintInclude: BOOLFALSE];
--x: passed through
--done: if not done, this call will not be counted
--removeMe: aptr is removed from the design
--include: this list is included into the design
--repaintMe: aptr's rect is to be repainted
--repaintInclude: the rect of the included list is to be repainted
Call: PROC [design: CD.Design, aptr: CD.ApplicationPtr, x: REF,
objectSpecific: REF, whatElse: CallProc]
RETURNS [done: BOOLFALSE, removeMe: BOOLFALSE, include: CD.ApplicationList←NIL,
repaintMe: BOOLFALSE, repaintInclude: BOOLFALSE] =
BEGIN
IF objectSpecific#NIL THEN
BEGIN
p: REF = CDObjectProcs.FetchFurther [aptr.ob.p, objectSpecific];
IF p#NIL AND ISTYPE[p, REF CallProc] THEN
BEGIN
[done: done,
removeMe: removeMe,
include: include,
repaintMe: repaintMe,
repaintInclude: repaintInclude] ← NARROW[p, REF CallProc]^[design, aptr, x]
END;
END;
IF NOT done AND whatElse#NIL THEN
[done: done,
removeMe: removeMe,
include: include,
repaintMe: repaintMe,
repaintInclude: repaintInclude] ← whatElse[design, aptr, x];
END;
Mode: TYPE = {all, selected, this};
CallForX: PROC [design: CD.Design,
objectSpecific: REF, whatElse: CallProc, x: REF, mode: Mode, aptr: CD.ApplicationPtr←NIL]
RETURNS [count: NAT𡤀] =
BEGIN
repaintList: LIST OF CD.DesignRect←NIL;
r: CD.DesignRect;
removeMe: BOOLFALSE;
done: BOOL;
include: CD.ApplicationList←NIL;
incall: CD.ApplicationList←NIL;
removeList: CD.ApplicationList←NIL;
repaintMe: BOOLFALSE;
repaintInclude: BOOLFALSE;
DoIt: PROC [a: CD.ApplicationPtr] =
BEGIN
r ← CDApplications.ARectO[a]; -- save size
[done, removeMe, include, repaintMe, repaintInclude] ←
Call[design, a, x, objectSpecific, whatElse];
IF done THEN count𡤌ount+1;
IF removeMe THEN removeList ← CONS[a, removeList];
IF repaintMe THEN
BEGIN -- may have changed size
repaintList ← CONS[r, repaintList];
IF ~removeMe THEN
repaintList ← CONS[CDApplications.ARectO[a], repaintList]
END;
IF include#NIL THEN
DO
app: CD.ApplicationPtr;
IF include=NIL THEN EXIT;
app ← include.first;
include ← include.rest;
incall ← CONS[app, incall];
IF repaintInclude THEN
repaintList ← CONS[CDApplications.ARectO[app], repaintList];
ENDLOOP;
END;
IF mode = this THEN {
IF aptr#NIL THEN DoIt[aptr];
}
ELSE
FOR l: CD.ApplicationList�sign^.actual.first.specific.contents, l.rest WHILE l#NIL DO
SELECT mode FROM
all => DoIt[l.first];
selected => IF l.first.selected THEN DoIt[l.first];
ENDCASE
ENDLOOP;
RemoveFrom[design, removeList];
design^.actual.first.specific.contents ←
CDApplications.AppendToList[incall, design^.actual.first.specific.contents];
RepaintList[design, repaintList]
END;
RepaintList: PROC [design: CD.Design, l: LIST OF CD.DesignRect] =
BEGIN
--assumes all nice optimizations done inside RedrawRectArea
FOR rl: LIST OF CD.DesignRect ← l, rl.rest WHILE rl#NIL DO
CDOps.DelayedRedraw[design, rl.first];
ENDLOOP
END;
RemoveFrom: PROC [design: CD.Design, remove: CD.ApplicationList] =
--slow (n square)
--remove all aplications from design which are in remove
BEGIN
FOR ll: CD.ApplicationList ← remove, ll.rest WHILE ll#NIL DO
CDOps.RemoveApplication[design, ll.first, FALSE];
ENDLOOP
END;
CallForThis: PUBLIC PROC [design: CD.Design, aptr: CD.ApplicationPtr,
objectSpecific: REFNIL, whatElse: CallProc←NIL, x: REFNIL]
RETURNS [NAT] =
BEGIN
RETURN CallForX[design, objectSpecific, whatElse, x, this, aptr]
END;
CallForAll: PUBLIC PROC [design: CD.Design,
objectSpecific: REFNIL, whatElse: CallProc←NIL, x: REFNIL]
RETURNS [NAT] =
BEGIN
RETURN CallForX[design, objectSpecific, whatElse, x, all]
END;
CallForSelected: PUBLIC PROC [design: CD.Design,
objectSpecific: REFNIL, whatElse: CallProc←NIL, x: REFNIL]
RETURNS [NAT] =
BEGIN
RETURN CallForX[design, objectSpecific, whatElse, x, selected]
END;
CallForOneSelected: PUBLIC PROC [design: CD.Design,
objectSpecific: REFNIL, whatElse: CallProc←NIL, x: REFNIL]
RETURNS [NAT] =
BEGIN
first: CD.ApplicationPtr;
multiple: BOOL;
[first, multiple] ← CDOps.SelectedApplication[design];
IF first#NIL THEN
RETURN CallForX[design, objectSpecific, whatElse, x, this, first]
ELSE RETURN [0]
END;
CallIfOneSelected: PUBLIC PROC [design: CD.Design,
objectSpecific: REFNIL, whatElse: CallProc←NIL, x: REFNIL]
RETURNS [NAT] =
BEGIN
first: CD.ApplicationPtr;
multiple: BOOL;
[first, multiple] ← CDOps.SelectedApplication[design];
IF first#NIL AND ~multiple THEN
RETURN CallForX[design, objectSpecific, whatElse, x, this, first]
ELSE RETURN [0]
END;
CallForPointed: PUBLIC PROC [design: CD.Design, point: CD.DesignPosition,
objectSpecific: REFNIL, whatElse: CallProc←NIL, x: REFNIL]
RETURNS [NAT] =
BEGIN
aptr: CD.ApplicationPtr = CDOps.PointedApplication[design, point];
IF aptr#NIL THEN
RETURN CallForX[design, objectSpecific, whatElse, x, this, aptr]
ELSE RETURN [0]
END;
--the Call.. procedures loop over all applications of the most pushed in cell, or what
--ever their name suggests and:
--first check if the object has a objectSpecific furtherProc and calls it,
--if there is no objectSpecific furtherProc, or it returns NOT done, it calls whatElse.
--objectSpecific=NIL means no search
--whatElse=NIL means nothing else to call.
--using removeMe is a slow method for deleting
--usually setting removeMe demands setting repaintMe to remove it from screen
Register: PUBLIC PROC [key: REF, objectType: REF CD.ObjectProcs, proc: CallProc] =
--registers proc to be called for an objectType, if key=objectSpecific
--key must have been registered with CDObjectProcs.RegisterFurther
--[internally uses CDObjectProcs.StoreFurther; this procedure is for conveniance only]
BEGIN
callProcRef: REF CallProc = NEW[CallProc←proc];
CDObjectProcs.StoreFurther[objectType, key, callProcRef]; -- errors are propagated
END;
END.