1 ;;; WARNING: This conflicts with lhtml.
 2 (in-package #:oh-ducks.traversal)
 3 
 4 (defvar *xmls-family-tree* nil)
 5 
 6 (defun in-hash (key hash)
 7   (multiple-value-bind (val present-p) (gethash key hash)
 8     (declare (ignore val))
 9     present-p))
10 
11 (defun %mark-parents (parent children)
12   (dolist (item children)
13     (setf (gethash item *xmls-family-tree*) parent)
14     (%mark-parents item (element-children item))))
15 
16 ;; WARNING: This won't produce sane results for nested (match)es, because we
17 ;;          have no way to bind in a large enough scope.
18 (defmethod unify:unify ((template oh-ducks::css-selector-template)
19                         (element list)
20                         &optional (env (unify:make-empty-environment))
21                         &key)
22   (if (and *xmls-family-tree*
23 	   (in-hash element *xmls-family-tree*))
24       (call-next-method)
25       (let ((*xmls-family-tree* (make-hash-table :test 'eq)))
26         (%mark-parents nil (list element))
27         (%mark-parents element (element-children element))
28         (call-next-method))))
29 
30 (defmethod unify:unify ((document list) (template oh-ducks::css-selector-template)
31                         &optional (env (unify:make-empty-environment))
32                         &key)
33   (unify:unify template document env))
34 
35 ;;; general accessors
36 
37 (defmethod element-children ((element list))
38   (remove-if-not (lambda (x) (and (listp x) (stringp (car x))))
39                  (cddr element)))
40 
41 (defmethod element-parent ((element list))
42   (multiple-value-bind (parent present?)
43       (gethash element *xmls-family-tree*)
44     (if present?
45         parent
46         (error "unable to determine parent"))))
47 
48 #+(or)
49 (defmethod element-attribute ((attribute symbol) (element list))
50   (cadr (assoc attribute (cadr element))))
51 (defmethod element-attribute ((attribute string) (element list))
52   (cadr (assoc attribute (cadr element) :test #'string=)))
53 
54 (defmethod element-type ((element list))
55   (car element))
56 
57 (defmethod element-content ((element list))
58   (cddr element))