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: BOOL←TRUE, removeMe: BOOL←FALSE, include: CD.ApplicationList←NIL,
repaintMe: BOOL←FALSE, repaintInclude: BOOL←FALSE];
--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:
BOOL←
FALSE, removeMe:
BOOL←
FALSE, include:
CD.ApplicationList←
NIL,
repaintMe: BOOL←FALSE, repaintInclude: BOOL←FALSE] =
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: BOOL←FALSE;
done: BOOL;
include: CD.ApplicationList←NIL;
incall: CD.ApplicationList←NIL;
removeList: CD.ApplicationList←NIL;
repaintMe: BOOL←FALSE;
repaintInclude: BOOL←FALSE;
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: REF←NIL, whatElse: CallProc←NIL, x: REF←NIL]
RETURNS [NAT] =
BEGIN
RETURN CallForX[design, objectSpecific, whatElse, x, this, aptr]
END;
CallForAll:
PUBLIC
PROC [design:
CD.Design,
objectSpecific: REF←NIL, whatElse: CallProc←NIL, x: REF←NIL]
RETURNS [NAT] =
BEGIN
RETURN CallForX[design, objectSpecific, whatElse, x, all]
END;
CallForSelected:
PUBLIC
PROC [design:
CD.Design,
objectSpecific: REF←NIL, whatElse: CallProc←NIL, x: REF←NIL]
RETURNS [NAT] =
BEGIN
RETURN CallForX[design, objectSpecific, whatElse, x, selected]
END;
CallForOneSelected:
PUBLIC
PROC [design:
CD.Design,
objectSpecific: REF←NIL, whatElse: CallProc←NIL, x: REF←NIL]
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: REF←NIL, whatElse: CallProc←NIL, x: REF←NIL]
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: REF←NIL, whatElse: CallProc←NIL, x: REF←NIL]
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.