diff --git a/hooks.lisp b/hooks.lisp index 7b1ece2d..af166d1b 100644 --- a/hooks.lisp +++ b/hooks.lisp @@ -2,64 +2,57 @@ (defvar *hook* nil "The hook currently being run.") -(declaim (type symbol *hook*)) -(declaim (ftype (function (symbol (or function symbol) &key (:append t)) - t) - add-hook)) -(defun add-hook (name fn &key append) - "Add FN to the value of NAME, a hook." - (declare (type (or function symbol) fn)) - (if (not append) - (pushnew fn (symbol-value name)) - (unless (member fn (symbol-value name)) - (appendf (symbol-value name) (list fn))))) - -(declaim (ftype (function (symbol (or function symbol)) - t) - remove-hook)) -(defun remove-hook (name fn) - "Remove fn from the symbol value of NAME." - (removef (symbol-value name) fn)) +(defgeneric add-hook (hook fn &key append) + (:documentation "Add FN to the value of HOOK.") + (:method ((hook symbol) fn &key append) + (declare (type (or function symbol) fn)) + (synchronized (hook) + (if (not append) + (pushnew fn (symbol-value hook)) + (unless (member fn (symbol-value hook)) + (appendf (symbol-value hook) (list fn))))))) + +(defgeneric remove-hook (hook fn) + (:documentation "Remove FN from the symbol value of HOOK.") + (:method ((hook symbol) fn) + (synchronized (hook) + (removef (symbol-value hook) fn)))) (defmacro with-hook-restart (&body body) `(with-simple-restart (continue "Call next function in hook ~s" *hook*) ,@body)) -(declaim (ftype (function (&rest symbol) - null) - run-hooks)) -(defun run-hooks (&rest hookvars) - "Run all the hooks in all the HOOKVARS. +(defun run-hooks (&rest hooks) + "Run all the hooks in HOOKS. The variable `*hook*' is bound to the name of each hook as it is being run." - (dolist (*hook* hookvars) + (dolist (*hook* hooks) + (run-hook *hook*))) + +(defgeneric run-hook (hook) + (:documentation "Run the functions in HOOK.") + (:method ((*hook* symbol)) (dolist (fn (symbol-value *hook*)) (with-hook-restart (funcall fn))))) -(declaim (ftype (function (symbol &rest t) - null) - run-hook-with-args)) -(defun run-hook-with-args (*hook* &rest args) - "Apply each function in the symbol value of HOOK to ARGS." - (dolist (fn (symbol-value *hook*)) - (with-hook-restart - (apply fn args)))) - -(declaim (ftype (function (symbol &rest t) - boolean) - run-hook-with-args-until-failure)) -(defun run-hook-with-args-until-failure (*hook* &rest args) - "Like `run-hook-with-args', but quit once a function returns nil." - (loop for fn in (symbol-value *hook*) - always (apply fn args))) - -(declaim (ftype (function (symbol &rest t) - t) - run-hook-with-args-until-success)) -(defun run-hook-with-args-until-success (*hook* &rest args) - "Like `run-hook-with-args', but quit once a function returns -non-nil." - (loop for fn in (symbol-value *hook*) - thereis (apply fn args))) +(defgeneric run-hook-with-args (hook &rest args) + (:documentation "Apply each function in HOOK to ARGS.") + (:method ((*hook* symbol) &rest args) + (dolist (fn (symbol-value *hook*)) + (with-hook-restart + (apply fn args))))) + +(defgeneric run-hook-with-args-until-failure (hook &rest args) + (:documentation "Like `run-hook-with-args', but quit once a function returns nil.") + (:method ((*hook* symbol) &rest args) + (loop for fn in (symbol-value *hook*) + always (apply fn args)))) + +(defgeneric run-hook-with-args-until-success (hook &rest args) + (:documentation "Like `run-hook-with-args', but quit once a function returns +non-nil.") + (:method ((*hook* symbol) &rest args) + (loop for fn in (symbol-value *hook*) + thereis (apply fn args)))) diff --git a/package.lisp b/package.lisp index 4031d1de..5be7c28b 100644 --- a/package.lisp +++ b/package.lisp @@ -280,6 +280,7 @@ #:add-hook #:remove-hook #:run-hooks + #:run-hook #:run-hook-with-args #:run-hook-with-args-until-failure #:run-hook-with-args-until-success diff --git a/serapeum.asd b/serapeum.asd index 9dd3a1a2..1f84ed2b 100644 --- a/serapeum.asd +++ b/serapeum.asd @@ -62,7 +62,8 @@ (:file "time") (:file "clos" :depends-on ("binding")) - (:file "hooks") + (:file "hooks" + :depends-on ("threads")) (:file "fbind" :depends-on ("binding" "control-flow" "op" "iter")) (:file "reader"