traversal/lhtml.lisp
Mon Jan 4 07:06:50 UTC 2010 pix@kepibu.org
* Support for asking about ancestors under lhtml
--- old-Oh, Ducks!/traversal/lhtml.lisp 2015-04-10 05:31:41.000000000 +0000
+++ new-Oh, Ducks!/traversal/lhtml.lisp 2015-04-10 05:31:41.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))))