Support for asking about ancestors under lhtml
Annotate for file traversal/lhtml.lisp
2009-11-13 pix 1 ;;; WARNING: lhtml will conflict with any handler which also uses lists.
04:19:11 ' 2 ;;; xmls, for instance (though I think that's at least
' 3 ;;; structurally compatible). Sorry, but that's the way it goes.
2009-11-18 pix 4 (in-package #:oh-ducks.traversal)
2009-11-13 pix 5
2010-01-04 pix 6 (defvar *lhtml-family-tree* nil)
07:06:50 ' 7
' 8 (defun in-hash (key hash)
' 9 (multiple-value-bind (val present-p) (gethash key hash)
' 10 (declare (ignore val))
' 11 present-p))
' 12
' 13 (defun %mark-parents (parent children)
' 14 (dolist (item children)
' 15 (setf (gethash item *lhtml-family-tree*) parent)
' 16 (%mark-parents item (element-children item))))
' 17
' 18 ;; WARNING: This won't produce sane results for nested (match)es, because we
' 19 ;; have no way to bind in a large enough scope.
' 20 (defmethod unify:unify ((template oh-ducks::css-selector-template)
' 21 (element list)
' 22 &optional (env (unify:make-empty-environment))
' 23 &key)
' 24 (if (and *lhtml-family-tree*
' 25 (in-hash element *lhtml-family-tree*))
' 26 (call-next-method)
' 27 (let ((*lhtml-family-tree* (make-hash-table :test 'eq)))
' 28 (%mark-parents nil (list element))
' 29 (%mark-parents element (element-children element))
' 30 (call-next-method))))
' 31
2009-11-13 pix 32 ;;; general accessors
04:19:11 ' 33
2009-11-13 pix 34 (defmethod element-children ((element list))
2009-11-21 pix 35 (remove-if-not (lambda (x) (and (listp x) (keywordp (car x))))
16:12:13 ' 36 (cddr element)))
2009-11-13 pix 37
2009-11-16 pix 38 (defmethod element-parent ((element list))
2010-01-04 pix 39 (multiple-value-bind (parent present?)
07:06:50 ' 40 (gethash element *lhtml-family-tree*)
' 41 (if present?
' 42 parent
' 43 (error "unable to determine parent"))))
2009-11-13 pix 44
2009-11-21 pix 45 (defmethod element-attribute ((attribute symbol) (element list))
16:12:13 ' 46 (cadr (assoc attribute (cadr element))))
' 47 (defmethod element-attribute ((attribute string) (element list))
' 48 (element-attribute (intern (string-upcase attribute) :keyword) element))
2009-11-13 pix 49
2009-11-13 pix 50 (defmethod element-type ((element list))
2009-11-13 pix 51 (car element))
2009-12-13 pix 52 (defmethod element-content ((element list))
05:24:52 ' 53 (cddr element))
' 54