src/lib/observer.slate

   1 globals Observers ::= IdentityDictionary new.
   2 "Maps observed objects to {Observer. SlotName} pairs."
   3
   4 obj@(Root traits) whenSlot: slotName changesNotify: observer &mutatorName
   5 "Register an Observer dependency between the object and the observer for the
   6 give slot name, and then overwrite the mutator for the slot."
   7 [
   8   mutatorName `defaultsTo: (obj mutatorNameFor: slotName).
   9   "Check that there is both a slot and a mutator for it on the object."
  10   (obj hasSlotNamed: slotName)
  11     \/ [mutatorName isFoundOn: {obj. NoRole}]
  12     ifTrue:
  13       [(Observers at: obj ifAbsentPut: [Set new])
  14          include: {observer. slotName}.
  15        "Define the mtutator to eventually notify all the observers."
  16        obj addMutator:
  17          [| :obj :newValue | here %notifyThat: obj changed: slotName to: newValue.
  18           obj atSlotNamed: slotName put: newValue]
  19            for: slotName &mutatorName: mutatorName.
  20        "Send an initial notification to give the observer an initial record."
  21        observer %noticeThat: obj changed: slotName to:
  22          (obj atSlotNamed: slotName). ]
  23 ].
  24
  25 obj@(Root traits) removeObserver: observer
  26 "Remove any notification pairs with the observer object specified. Then delete
  27 the object's entry if there are no remaining Observers for the object."
  28 [
  29   observerEntries ::= Set new.
  30   "Remove all observation entries for that observer, and remember them."
  31   (Observers at: obj ifPresent:
  32     [| :entries |
  33      entries select: [| :each | each first == observer] into: observerEntries.
  34      entries removeAll: observerEntries]).
  35   "Reset the mutator if no other object is watching that slot."
  36   observerEntries do:
  37     [| :obs :slot |
  38      (entries noneSatisfy: [| :each | each second == slot])
  39        /\ [(obj mutatorNameFor: slot) isFoundOn: {obj. NoRole}]
  40        ifTrue: [obj addMutatorFor: slot]] applier.
  41   "Remove the observer set if no other object is watching the observed."
  42   (Observers at: obj ifAbsent: [^ Nil])
  43     isEmpty ifTrue: [Observers removeKey: obj].
  44 ].
  45
  46 n@(Namespace traits) notifyThat: obj changed: slotName to: newValue
  47 [
  48   n Observers at: obj ifPresent:
  49     [| :observerEntries | observerEntries do:
  50       [| :obs :slot | slot == slotName ifTrue:
  51         [obs %noticeThat: obj changed: slotName to: newValue]] applier]
  52 ].
  53
  54 obj@(Root traits) noticeThat: obj changed: slotName to: newValue
  55 "This is the hook to override for Observing objects; by default, do nothing."
  56 [warn: 'Unhandled observation.'].