anchor.diff:         :documentation (split-string docstring (string #\newline))))))
   
   
  -(defgeneric call-option-function (option arguments &optional undefined-argument)
  +
  +
  +;;; ---
  +
  +;;; The public API is:
  +;;; (register-option option warn-on-conflicts)
  +;;; (get-option key case-sensitive)
  +
  +
  +(defparameter *options* '()
  +  "A list of all registered options.")
  +
  +(defparameter *case-sensitive-options-map* nil
  +  "A cached dictionary of options.")
  +(defparameter *case-insensitive-options-map* nil
  +  "A cached dictionary of options.")
  +
  +(defun find-option (keys)
  +  (let* ((options (loop
  +                    :for option :in *options*
  +                    :append (loop
  +                              :for key :in keys
  +                              :if (member key (option-keys option))
  +                                :collect (list option "case sensitive" key)
  +                              :else
  +                                :if (member key (option-keys option) :test (function equalp))
  +                                  :collect (list option "case insensitive" key))))
  +         (option (remove-duplicates (mapcar (function first) options))))
  +    (values option options)))
  +
  +(defun fill-option-map (table)
  +  (loop
  +    :for option :in *options*
  +    :do (loop :for key :in (option-keys option)
  +              :do (setf (gethash key table) option)))
  +  table)
  +
  +(defun register-option (option warn-on-conflicts)
  +  (when warn-on-conflicts
  +    (multiple-value-bind (old-option conflicts) (find-option (option-keys option))
  +      (when old-option
  +        (let ((*print-circle* nil) (*print-escape* nil))
  +         (warn "There are already options for ~:{the ~A key ~A~^, ~}."
  +               (print (mapcar (function rest) conflicts)))))))
  +  (push option *options*))
  +
  +(defun get-option (key case-sensitive)
  +  (let ((table (if case-sensitive
  +                   *case-sensitive-options-map*
  +                   *case-insensitive-options-map*)))
  +    (gethash key
  +             (or table
  +                 (fill-option-map 
  +                  (if case-sensitive
  +                      (setf *case-sensitive-options-map*   (make-hash-table :test (function equal)))
  +                      (setf *case-insensitive-options-map* (make-hash-table :test (function equalp)))))))))
  +
  +
  +
  +
  +;;; ---
  +
  +(defgeneric call-option-function (option arguments undefined-argument case-sensitive)
     (:documentation  "
   DO:                  Call the option function with the ARGUMENTS.
   RETURN:              The remaining list of arguments.
  
positive.code:                     :while arguments
                      :do (setf arguments (call-option-function (pop arguments)
                                                                arguments
                                                                undefined-argument)))
                    nil)
                   (default
                    (funcall default)))))
  
negative.code:   "
  RETURN: The list of options defined.
  "
    (copy-list *options*))
  
  
  (define-option ("help" "-h" "--help") ()
  