Generate scheme code for a SRFI-35 "define-condition-type" definition.  Asks for the name of the condition, name of the parent and a list of fields.

-Eric

 ;; generate SRFI-35 condition definitions
 (defun read-field-names ()
   ""
   (let ((field (read-string "Field: ")))
     (if (string= field "")
         '()
         (cons field (read-field-names)))))

 (defun prepend-ampersand (str)
   (cond 
    ((= (length str) 0) str)
    ((char-equal ?& (aref str 0)) str)
    (t (concat "&" str))))

 (defun strip-ampersand (str)
   (cond
    ((= (length str) 0) str)
    ((char-equal ?& (aref str 0))
     (apply 'string (cdr (string-to-list str))))
    (t str)))

 (defun make-condition-field-accessor-name (condition field)
   (concat condition "-" field))

 (defun build-define-condition-type (name parent fields)
   (concat
    "(define-condition-type " 
    (prepend-ampersand name) " " (prepend-ampersand parent) "\n"
    (strip-ampersand name) "?"
    (apply 'concat
 	  (mapcar 
  	   (lambda (field)
	      (concat
	       "\n(" field " " 
	       (make-condition-field-accessor-name (strip-ampersand name) field) ")"))
	    fields))
    ")\n"))

 (defun insert-condition-definition (name)
   "Insert a Scheme code for a SRFI-35 condition definition"
   (interactive "sCondition name: ")

   (let* ((parent (read-string "Parent: ")))
     (let ((parent (if (string= parent "") nil parent))
 	  (fields (read-field-names)))
       (save-excursion
 	(insert-string
 	 (build-define-condition-type name parent fields))))))