6.5 Examples

This example illustrates "typical" use of action lists. The define-action forms might be scattered across several files ( mail-utilities.lisp , caffeine.lisp , and so on). Each of the functions, such as read-mail , dont-panic , and so on, take one argument: hassled-p .

(define-action-list "On arrival at office"

    :documentation "Things to do in the morning"

    :dummy-actions '("Look busy")

    :default-order '(:before "Look busy"))

(define-action "On arrival at office" "Greet co-workers"

                 'say-hello)

(define-action "On arrival at office" "Drink much coffee"

                 'wake-up:after "Locate coffee machine")

(define-action "On arrival at office" "Locate coffee machine"

                 'dont-panic)

(defun my-morning (hassled-p Monday-p)

   (execute-actions ("On arrival at office"

                     :ignore-errors-p Monday-p)

                 hassled-p)

    <rest of my-morning code goes here
>)

This example illustrates use of execution-functions and post-processing

Here are the implementation details, which are hidden from the "user".

(defstruct (thing (:constructor make-thing (name number)))

  name

  number)

(defvar *things*

  (make-unregistered-action-list :sort-time :define-action

         :execution-function 'act-on-things))

(defun do-things (function &optional post-process)

  (execute-actions (*things* :post-process post-process)

                   function))

(defun act-on-things (things other-args-list &key post-process)

  (with-action-list-mapping

   (things ignore thing post-process)

   (destructuring-bind

    (function) other-args-list

    (funcall function thing))))

The interface is given below. The internals of the mapping mechanism are hidden.

(defmacro define-thing (name number)

  (with-unique-names (thing)

    `(let ((,thing (make-thing ,name ,number)))

       (define-action *things* ',name ,thing))))

(defmacro undefine-thing (name)

  `(undefine-action *things* ,name))

(defun find-thing (name)

  (do-things #'(lambda (thing)

                   (and (equal name (thing-name thing))

                        thing))

               :or))

(defun add-things ()

  (reduce '+ (do-things 'thing-number :collect)))