(asdf:oos 'asdf:load-op :cldoc)

(defpackage :gol.doc
  (:use :cl :cldoc))

(in-package :gol.doc)

(defclass defgeneric/cc-descriptor (cldoc::defgeneric-descriptor)
  ())

(defclass defmethod/cc-descriptor (cldoc::defmethod-descriptor)
  ())

(defclass defaction-descriptor (defmethod/cc-descriptor)
  ())

(defclass defcomponent-descriptor (cldoc::defclass-descriptor)
  ())

(defclass deftag-descriptor (cldoc::defmacro-descriptor)
  ())

(define-descriptor-handler DEFACTION (form)
  "ucw action"
  ;; name arglist documentation-string
  ;; (defmethod name {qualifiers}* lambda-list [ {decl}* || doc ] body)
  (multiple-value-bind (qualifiers lambda-list) 
      (cldoc::find-qualifiers-and-lambda-list (cddr form))
    (make-instance 'defaction-descriptor
      :type (format nil "~s" (first form))
      :name (format nil "~s" (second form))
      :qualifiers qualifiers
      :lambda-list lambda-list		       
      :doc (cldoc::extract-doc (if qualifiers (cddddr form) (cdddr form))))))

(define-descriptor-handler DEFMETHOD/CC (form)
    "continuation rewritten method"
  ;; name arglist documentation-string
  ;; (defmethod name {qualifiers}* lambda-list [ {decl}* || doc ] body)
  (multiple-value-bind (qualifiers lambda-list) 
      (cldoc::find-qualifiers-and-lambda-list (cddr form))
    (make-instance 'defmethod/cc-descriptor
		   :type (format nil "~s" (first form))
		   :name (format nil "~s" (second form))
		   :qualifiers qualifiers
		   :lambda-list lambda-list		       
		   :doc (cldoc::extract-doc (if qualifiers (cddddr form) (cdddr form))))))

(define-descriptor-handler DEFGENERIC/CC (form)
  "continue rewritten generic function"
  (make-instance 'defgeneric/cc-descriptor
    :type (format nil "~s" (first form))
    :name (format nil "~s" (second form))
    :lambda-list (third  form)
    :doc (second (find :documentation (cdddr form) :key #'car))))

(define-descriptor-handler DEFCOMPONENT (form)
    "component"
  (let ((class
	 (make-instance 'defcomponent-descriptor
	   :type (format nil "~s" (first form))
	   :name (format nil "~s" (second form))
	   :inheritence (third form)
	   :slots (cldoc::handle-slots
		   (format nil "~s" (second form)) (fourth form))
	   :doc (second (find :documentation (nthcdr 4 form) :key #'car)))))
    (cldoc::make-slot-lambdas class (list (second form)))
    class))

(define-descriptor-handler IT.BESE.YACLML:DEFTAG-MACRO (form)
    "yaclml tag"
  (make-instance 'deftag-descriptor
		 :type (format nil "~s" (first form))
		 :name (format nil "~s" (second form))
		 :lambda-list (third form)
		 :doc (if (stringp (fourth form)) (fourth form) "")))

(define-descriptor-handler DEF-SMIL-TAG (form)
    "yaclml tag"
  (make-instance 'deftag-descriptor
		 :type (format nil "~s" (first form))
		 :name (format nil "~s" (second form))
		 :lambda-list (cons '&key (cddr form))
		 :doc ""))

(define-descriptor-handler DEF-EMPTY-SMIL-TAG (form)
    "yaclml tag"
  (make-instance 'deftag-descriptor
		 :type (format nil "~s" (first form))
		 :name (format nil "~s" (second form))
		 :lambda-list (cons '&key (cddr form))
		 :doc ""))


(defmacro defptype (dsc str)
  `(defmethod cldoc::html-printable-type ((sd ,dsc))
     (declare (ignore sd))
     ,str))

(defptype defcomponent-descriptor "Component")
(defptype defgeneric/cc-descriptor "Call/CC Generic")
(defptype defmethod/cc-descriptor "Call/CC Method")
(defptype defaction-descriptor "UCW Action")
(defptype deftag-descriptor "YACLML Tag")

(let ((*default-pathname-defaults*
       (asdf:system-relative-pathname :golgonooza "src/")))
  (extract-documentation 'html "documentation"
			 '("packages.lisp"
			   "ucw-compat.lisp"
			   "query-view.lisp"
			   "simple-form.lisp"
			   "site-control.lisp"
			   "smil-tags.lisp"
			   "elephant/elephant-packages.lisp"
			   "elephant/elephant-query-view.lisp"
			   "elephant/elephant-site.lisp"
			   "elephant/elephant-utils.lisp")))