<> <> <> <> 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_0] = 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_count+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_design^.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.