(chapter-start ‘nydp/hooks “event management - execute a piece of code when something happens”)

(let hooks {}

;; return the list of hook-names
(def hook-names ()
  (hash-keys hooks))

;; return the list of hooks for 'hook-name
(def hooks-for (hook-name)
  hooks.,hook-name)

;; add a function 'f to execute when 'hook-name is fired
(def add-hook (hook-name f)
  (hash-cons hooks hook-name f))

;; remove all hooks for 'hook-name
(def clear-hooks (hook-name)
  (= hooks.,hook-name nil))

;; temporarily remove all hooks for 'hook-name, restoring them after running 'f
(def without-hooks (hook-name f)
  (let previous-hooks (hooks-for hook-name)
    (ensure (= hooks.,hook-name previous-hooks)
            (clear-hooks hook-name)
            (f))))

;; only works if you have a reference to the original function
(def remove-hook (hook-name f)
  (= hooks.,hook-name
     (collect (curry !eq? f)
             hooks.,hook-name)))

;; apply all functions attached to 'hook-name to given 'args
(def run-hooks (hook-name . args)
  (each hook (hooks-for hook-name)
        (apply hook args))))

;; install a hook for a particular kind of event ;; ;; example ;; (on transaction (account amount) (update account total (+ account.total amount))) ;; ;; same as (add-hook ‘transaction (fn (account amount) (update account total (+ account.total amount)))) ;; ;; if ’body is a symbol and ‘args is nil, for example ;; ;; (on transaction () notify) ;; ;; ’notify must be a predefined function accepting any arguments to the ‘transaction event ; the example is equivalent to ;; ;; (add-hook ’transaction (fn args (apply notify args))) ;; ;; or more simply ;; ;; (add-hook ‘transaction (fn (account amount) (notify account amount))) ;; (mac on (event args . body)

(let hookfn (if (isa 'symbol (car body))
                (car body)
                `(fn ,args ,@body))
  (w/uniq dox-item
    `(let ,dox-item (or (car:dox-lookup ',event)
                        (dox-add-doc ',event 'hook))
       (add-hook ',event ,hookfn)
       (hash-cons ,dox-item 'hooks
          { src      ',hookfn
            args     ',args
            chapter  (chapter-current)
            file     this-script
            plugin   this-plugin })))))

(let super warnings/new

(def warnings/new (kind . info)
  ; enhance original warnings/new to run the 'warnings/new hook
  (chapter nydp/warnings)
  (apply super kind info)
  (run-hooks 'warnings/new (cons kind info))))

(on warnings/new w (apply p w))