1 ;;; WARNING: lhtml will conflict with any handler which also uses lists.
 2 ;;;          xmls, for instance (though I think that's at least
 3 ;;;          structurally compatible).  Sorry, but that's the way it goes.
 4 (in-package #:oh-ducks.traversal)
 5 
 6 (defvar *lhtml-family-tree* nil)
 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 
32 ;;; general accessors
33 
34 (defmethod element-children ((element list))
35   (remove-if-not (lambda (x) (and (listp x) (keywordp (car x))))
36                  (cddr element)))
37 
38 (defmethod element-parent ((element list))
39   (multiple-value-bind (parent present?)
40       (gethash element *lhtml-family-tree*)
41     (if present?
42         parent
43         (error "unable to determine parent"))))
44 
45 (defmethod element-attribute ((attribute symbol) (element list))
46   (cadr (assoc attribute (cadr element))))
47 (defmethod element-attribute ((attribute string) (element list))
48   (element-attribute (intern (string-upcase attribute) :keyword) element))
49 
50 (defmethod element-type ((element list))
51   (car element))
52 
53 (defmethod element-content ((element list))
54   (cddr element))