(in-package :xmlisp2)

(defun make-xmlns (xmlns-string)
  (when xmlns-string
    (intern xmlns-string :xmlisp2.ns)))

(defun make-lname (lname-string)
  (intern lname-string :xmlisp2.lname))

(defun xmlns->package (xmlns)
  (cdr (assoc xmlns *xmlns-to-package*)))

(defun normalize-symbol-case (name)
 (ecase (readtable-case *readtable*)
   (:upcase (string-upcase name))
   (:downcase (string-downcase name))
   (:preserve name)
   (:invert
    (cond
     ((every #'upper-case-p name) (string-downcase name))
     ((every #'lower-case-p name) (string-upcase name))
     (t name)))))

(defun xml-name->symbol (uri lname)
  (let ((normal (normalize-symbol-case lname))
	(package (if uri (xmlns->package uri) *package*)))
    #+nil(break "xn-s: (~A ~A) [~A] p=~A" uri lname normal package)
    (let ((sym (find-symbol normal package)))
      #+nil(break "found symbol: ~A" sym)
      sym)))

(defun find-xml-class (uri lname)
  (let ((class
	 (find-class (xml-name->symbol uri lname))))
    #+nil(break "found class: ~A" class)
    class))

(defmethod parse-instance ((source klacks:source) (parent null) uri lname)
  (let ((instance (make-xml-tag-instance parent uri lname)))
      (map-attributes (lambda (uri lname qname value defaultp)
			(declare (ignore qname defaultp))
			(let ((uri (make-xmlns uri))
			      (lname (make-xmlns lname)))
			  #+nil(break "MAP-ATTRIBUTES (~A ~A)=~A" uri lname value)
			  (unless (eq uri
				      'xmlisp2.ns:|http://www.w3.org/2000/xmlns/|)
			    (handle-attribute-value instance
						    (xml-name->symbol uri lname)
						    value))))
		      source)
      #+nil(break "scanning children")
      (loop
	 :until (eq (let ((ev (peek-next source)))
		      #+nil(break "... event = ~A" ev)
		      ev)
		    :end-element)
	 :do (ecase (peek source)
	       ((:start-element)
		(multiple-value-bind (key uri lname qname) (peek source)
		  (declare (ignore qname key))
		  (let ((uri (make-xmlns uri))
			(lname (make-xmlns lname)))
		    #+nil(break "subobject: (~A ~A) / ev ~A" uri lname key)
		    (finished-parsing
		     (parse-instance source instance uri lname)))))
	       ((:characters)
		#+nil(break "chars: ~S" (current-characters source))
		(handle-character-data instance
				       (current-characters source)
				       (current-cdata-section-p source)))
	       ((:processing-instruction)
		(multiple-value-bind (target data) (peek-value source)
		  (handle-processing-instruction instance target data)))
	       ((:comment)
		(handle-comment instance (peek-value source)))))
      instance
      #+nil(break "created instance ~A" instance)))

(defun parse-and-make-instance (stream)
  (with-open-source (source (cxml:make-source stream))
    (multiple-value-bind (key uri lname qname)
	(find-event source :start-element)
      (declare (ignore key qname))
      (finished-parsing (parse-instance source nil uri lname)))))