;;; 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))