<> <> <> <> DIRECTORY AMBridge, AMTypes, CD, CDDrawQueue, CDVFurtherPainters, CDVPrivate, RefTab, RuntimeError; CDVFurtherPaintersImpl: CEDAR PROGRAM IMPORTS AMBridge, AMTypes, CDVPrivate, RefTab, RuntimeError EXPORTS CDVFurtherPainters = BEGIN FurtherPaintProc: TYPE = CDVFurtherPainters.FurtherPaintProc; <<--PROC [me: CDVPrivate.VRef, key: REF];>> valueTable: RefTab.Ref = RefTab.Create[mod: 13]; MyRec: TYPE = RECORD[type: AMTypes.Type, proc: FurtherPaintProc]; TypeList: TYPE = LIST OF REF MyRec; typeList: TypeList; InstallFurtherPaint: PUBLIC PROC[ keyReferentType: AMTypes.Type_AMTypes.nullType, --default means check value only keyValue: REF_NIL, --default means check type only; you can not install a proc for NIL proc: FurtherPaintProc ] = <<--All errors and signals from proc will be catched.>> <<--Sometimes calls proc with; sometimes without locks, depending on key.>> <<--It is ok to call the viewers-PaintProc recursively, but please>> <<--do not cause wedges, there is no protection.>> <<--Manual registration of key is requested.>> <<--May or may not check if keyValue is of type keyType, if both non NIL>> BEGIN IF proc=NIL THEN ERROR ELSE { IF keyValue#NIL THEN [] _ RefTab.Store[valueTable, keyValue, NEW[FurtherPaintProc_proc]] ELSE IF keyReferentType=CODE[CDDrawQueue.Request] OR keyReferentType=AMTypes.nullType THEN ERROR ELSE typeList _ CONS[NEW[MyRec_[type: keyReferentType, proc: proc]], typeList] } END; CallFurther: PUBLIC PROC[me: CDVPrivate.VRef, key: REF] = <<--Catches all errors and signals!>> <<--Called by the viewer paintproc of ChipNDale-design viewers only.>> BEGIN ENABLE RuntimeError.UNCAUGHT => IF CDVPrivate.ShallContinue[me, TRUE, "CDVDraw.back"] THEN GOTO oops; transmitt: REF _ key; WITH key SELECT FROM req: REF CDDrawQueue.Request => key _ req.key ENDCASE => NULL; WITH RefTab.Fetch[valueTable, key].val SELECT FROM p: REF FurtherPaintProc => p^[me, transmitt] ENDCASE => TRUSTED { <<--then check if we know the type of key>> type: AMTypes.Type _ AMTypes.TVType[AMBridge.TVForReferent[key]]; FOR list: TypeList _ typeList, list.rest WHILE list#NIL DO IF list.first.type=type THEN { list.first.proc[me, transmitt]; EXIT } ENDLOOP; } EXITS oops => NULL END; END.