;;; WARNING: This conflicts with lhtml.
(in-package #:oh-ducks.traversal)

(defvar *xmls-family-tree* nil)

(defun in-hash (key hash)
  (multiple-value-bind (val present-p) (gethash key hash)
    (declare (ignore val))
    present-p))

(defun %mark-parents (parent children)
  (dolist (item children)
    (setf (gethash item *xmls-family-tree*) parent)
    (%mark-parents item (element-children item))))

;; WARNING: This won't produce sane results for nested (match)es, because we
;;          have no way to bind in a large enough scope.
(defmethod unify:unify ((template oh-ducks::css-selector-template)
                        (element list)
                        &optional (env (unify:make-empty-environment))
                        &key)
  (if (and *xmls-family-tree*
	   (in-hash element *xmls-family-tree*))
      (call-next-method)
      (let ((*xmls-family-tree* (make-hash-table :test 'eq)))
        (%mark-parents nil (list element))
        (%mark-parents element (element-children element))
        (call-next-method))))

(defmethod unify:unify ((document list) (template oh-ducks::css-selector-template)
                        &optional (env (unify:make-empty-environment))
                        &key)
  (unify:unify template document env))

;;; general accessors

(defmethod element-children ((element list))
  (remove-if-not (lambda (x) (and (listp x) (stringp (car x))))
                 (cddr element)))

(defmethod element-parent ((element list))
  (multiple-value-bind (parent present?)
      (gethash element *xmls-family-tree*)
    (if present?
        parent
        (error "unable to determine parent"))))

#+(or)
(defmethod element-attribute ((attribute symbol) (element list))
  (cadr (assoc attribute (cadr element))))
(defmethod element-attribute ((attribute string) (element list))
  (cadr (assoc attribute (cadr element) :test #'string=)))

(defmethod element-type ((element list))
  (car element))

(defmethod element-content ((element list))
  (cddr element))