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