Support for asking about ancestors under lhtml
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 2013-07-24 10:35:07.000000000 +0000
+++ new-Oh, Ducks!/notes 2013-07-24 10:35:07.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 2013-07-24 10:35:07.000000000 +0000
+++ new-Oh, Ducks!/traversal/lhtml.lisp 2013-07-24 10:35:07.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))))