1 (in-package #:oh-ducks)
 2 
 3 (defmethod unify ((a css-selector-template) (b css-selector-template)
 4                   &optional (env (make-empty-environment))
 5                   &key)
 6   (declare (ignore env))
 7   (error 'unification-failure
 8          :format-control "Do not know how to unify the two css-selector-templates ~S and ~S."
 9          :format-arguments (list a b)))
10 
11 (defmethod unify ((template css-selector-template) document
12                   &optional (env (make-empty-environment))
13                   &key)
14   (declare (optimize debug))
15   (loop :for (css-specifier . template) :in (specifiers template)
16         :do (typecase template
17               ;; CSS selectors work backwards, not forwards
18               (css-selector-template
19                (unify template document env))
20               (t
21                (let* ((*implicit-element* document)
22                       ;; FIXME: this is UGLY!
23                       (val (cond
24                              ((terminating-implicit-sibling-combinator-p css-specifier)
25                               ;; search remaining siblings
26                               (subjects-in-list
27                                css-specifier
28                                (rest
29                                 (member document
30                                         (when-let* ((parent (element-parent document)))
31                                           (element-children parent))
32                                         :test #'eq))))
33                              ;; search subelements
34 ;;; FIXME: this assumes if someone passes us a node they want to find
35 ;;; subelements of that node.  In the case of nested matches, that's probably
36 ;;; true, but it hardly seems fair to assume it.  Really we want some sort of
37 ;;; descendant combinator to be sure, but the general one (#\Space) doesn't
38 ;;; exactly show up all that well.  Somebody might assume " b" was the same as
39 ;;; "b" and get confused.
40                              ((element-parent document)
41                               (subjects-in-list css-specifier (element-children document)))
42                              ;; root element includes itself
43                              (t (subjects-of css-specifier document)))))
44                  (cond
45                    ((null val)
46                     (error 'unification-failure
47                            :format-control "Unable to unify ~s and ~s"
48                            :format-arguments (list css-specifier template)))
49                    ((unify::template-p template)
50                     (unify template val env))
51                    ((unify::variablep template)
52                     (unify::var-unify template val env))
53                    (t (error "Don't know what to do with selector ~s and template ~s." css-specifier template)))))))
54   env)
55 
56 (defmethod unify (document (template css-selector-template)
57                   &optional (env (make-empty-environment))
58                   &key)
59   (unify template document env))
60 
61 (defmethod unify ((template css-selector-template) (document string)
62                   &optional (env (make-empty-environment))
63                   &key)
64   (unify template (funcall (slot-value template 'parser) document) env))
65 
66 (defmethod unify ((template css-selector-template) (document pathname)
67                   &optional (env (make-empty-environment))
68                   &key)
69   (unify template (funcall (slot-value template 'parser) document) env))