Ensure book specificity

(defgeneric ensure-book-specific (book specificity)
  (:documentation "Ensures that the book is at least as specific as specificity.
Raises appropriate errors and gives common resolutions.")
  (:method ((book-obj page) specificity)
    (let ((specificity-spec (specificities book-obj))
          (page-number-list (page-numbers book-obj)))

      ;; Catch spec errors.
      (unless (member specificity specificity-spec)
        (restart-case (error 'no-such-specificity
                             :datum specificity :target specificity-spec)
          (use-value (return-value)
            :interactive (lambda ()
                           (format *query-io* "Write the return value: ")
                           (list (read)))
            :report "Specify the return value for this function."
            (return-from ensure-book-specific return-value))))

      ;; Zip through the list to check for discrepancies and allow fixing.
      (loop for test-specificity in specificity-spec
            for test-number = page-number-list then (cdr test-number)
            for list-position from 1
            unless (car test-number)
            do (restart-case (error 'not-specific-enough
                                    :current-specificity test-specificity
                                    :target-specificity specificity)
                 (store-value (new-value)
                   :interactive (lambda ()
                                  (format *query-io*
                                          "Write in a new value for ~a: "
                                          test-specificity)
                                  (list (parse-integer (read-line))))
                   :report "Provide a value for the missing specificity."
                   (setf (page-numbers book-obj)
                         (loop for i from 1 to list-position
                               for j = page-number-list then (cdr j)
                               if (or (cdr j) (car j)) collect (car j)
                               else collect (if (= i list-position) new-value)))
                   (ensure-book-specific book-obj specificity))
                 (store-all-values (new-values)
                   :report "Put in new values of book/page/subpage all at once."
                   :interactive (lambda ()
                                  (format *query-io*
                                          "Write in order the values of ~a: "
                                          specificity-spec)
                                  (list (read)))
                   (setf (page-numbers book-obj) new-values)
                   (ensure-book-specific book-obj test-specificity)))
            when (eql test-specificity specificity)
            do (when (cdr test-number)
                 (warn "~s still remains in page-number list!"
                       (cdr test-number)))
            and return book-obj))))