Mon Jan 4 07:06:50 UTC 2010 pix@kepibu.org * Support for asking about ancestors under lhtml diff -rN -u old-Oh, Ducks!/notes new-Oh, Ducks!/notes --- old-Oh, Ducks!/notes 2015-10-13 02:13:20.000000000 +0000 +++ new-Oh, Ducks!/notes 2015-10-13 02:13:20.000000000 +0000 @@ -129,9 +129,11 @@ I also recommend submitting a patch. Other people might want to use that selector, too! * To Do -** working lhtml/xmls support [1/2] +** working lhtml/xmls support [2/2] * [X] non-descendant cases (class, id, etc.) - * [ ] selectors involving descendants + * [X] selectors involving descendants + CAUTION: Won't produce sane results if the document tree is + modified or you use nested (match)es. ** write documentation ** improve selector support *** positional selectors [11/11] diff -rN -u old-Oh, Ducks!/traversal/lhtml.lisp new-Oh, Ducks!/traversal/lhtml.lisp --- old-Oh, Ducks!/traversal/lhtml.lisp 2015-10-13 02:13:20.000000000 +0000 +++ new-Oh, Ducks!/traversal/lhtml.lisp 2015-10-13 02:13:20.000000000 +0000 @@ -3,18 +3,44 @@ ;;; structurally compatible). Sorry, but that's the way it goes. (in-package #:oh-ducks.traversal) +(defvar *lhtml-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 *lhtml-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 *lhtml-family-tree* + (in-hash element *lhtml-family-tree*)) + (call-next-method) + (let ((*lhtml-family-tree* (make-hash-table :test 'eq))) + (%mark-parents nil (list element)) + (%mark-parents element (element-children element)) + (call-next-method)))) + ;;; general accessors (defmethod element-children ((element list)) (remove-if-not (lambda (x) (and (listp x) (keywordp (car x)))) (cddr element))) -;; FIXME: bleh... may not even be worth trying to support this (defmethod element-parent ((element list)) - (error "cannot get parent")) - -(defmethod element-ancestors ((element list)) - (error "cannot get ancestors")) + (multiple-value-bind (parent present?) + (gethash element *lhtml-family-tree*) + (if present? + parent + (error "unable to determine parent")))) (defmethod element-attribute ((attribute symbol) (element list)) (cadr (assoc attribute (cadr element))))