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