Mon Nov 23 10:24:02 UTC 2009 pix@kepibu.org * Status commit; fix unification diff -rN -u old-Oh, Ducks!/tests.lisp new-Oh, Ducks!/tests.lisp --- old-Oh, Ducks!/tests.lisp 2015-11-11 19:30:18.000000000 +0000 +++ new-Oh, Ducks!/tests.lisp 2015-11-11 19:30:18.000000000 +0000 @@ -42,7 +42,7 @@ (values i span))) (match (#T(html (:model dom) - ("i" . ?i);#t(list ?j ?i)) + ("i" . #t(list ?j ?i)) ("span>i" . ?span)) "
I do not like cheese.
I like cheese.
") (values i span)) diff -rN -u old-Oh, Ducks!/traversal/dom.lisp new-Oh, Ducks!/traversal/dom.lisp --- old-Oh, Ducks!/traversal/dom.lisp 2015-11-11 19:30:18.000000000 +0000 +++ new-Oh, Ducks!/traversal/dom.lisp 2015-11-11 19:30:18.000000000 +0000 @@ -7,30 +7,21 @@ (defmethod element-children ((element dom:element)) (remove-if-not #'dom:element-p (coerce (dom:child-nodes element) 'list))) + (defmethod element-parent ((element dom:document)) nil) (defmethod element-parent ((element dom:element)) (dom:parent-node element)) -#+(or) -(defmethod element-attribute (attribute (element dom:node)) - (declare (ignore attribute element)) - nil) + (defmethod element-attribute ((attribute symbol) (element dom:element)) (element-attribute (string-downcase (symbol-name attribute)) element)) (defmethod element-attribute ((attribute string) (element dom:element)) (dom:get-attribute element attribute)) -#+(or) -(defmethod element-type ((element dom:node)) - (declare (ignore element)) - nil) + (defmethod element-type ((element dom:element)) (dom:tag-name element)) ;;; special accessors in case something special needs to happen -#+(or) -(defmethod element-id ((element dom:node)) - (declare (ignore element)) - nil) (defmethod element-id ((element dom:element)) (element-attribute "id" element)) diff -rN -u old-Oh, Ducks!/traversal/lhtml.lisp new-Oh, Ducks!/traversal/lhtml.lisp --- old-Oh, Ducks!/traversal/lhtml.lisp 2015-11-11 19:30:18.000000000 +0000 +++ new-Oh, Ducks!/traversal/lhtml.lisp 2015-11-11 19:30:18.000000000 +0000 @@ -10,17 +10,9 @@ (cddr element))) ;; FIXME: bleh... may not even be worth trying to support this -#+FIXME -(defmethod element-parent ((element list)) - (let ((parent (car *ancestors*))) - (if (some (alexandria:curry #'eq element) (element-children parent)) - parent - (error "unable to determine parent")))) (defmethod element-parent ((element list)) (error "cannot get parent")) -#+FIXME -(defmethod element-ancestors ((element list)) - *ancestors*) + (defmethod element-ancestors ((element list)) (error "cannot get ancestors")) diff -rN -u old-Oh, Ducks!/unify.lisp new-Oh, Ducks!/unify.lisp --- old-Oh, Ducks!/unify.lisp 2015-11-11 19:30:18.000000000 +0000 +++ new-Oh, Ducks!/unify.lisp 2015-11-11 19:30:18.000000000 +0000 @@ -25,41 +25,18 @@ &key &allow-other-keys) (declare (optimize debug)) (loop :for (css-specifier . template) :in (specifiers template) - :do - (let ((val (find-matching-elements css-specifier document))) - (cond - ;; FIXME: make possible to say things like ("div" . #t(list ?first-div &rest)) - #+(or) - ((typep template 'css-selector-template) - (format t "hey! ~s~%" template) - (let ((menv (reduce #'merge-environments - (mapcar (curry #'unify template) - val)))) - (unify::fill-environment (unify::environment-variables menv) - (unify::environment-values menv) - env))) - ((unify::template-p template) - (let ((menv (reduce #'merge-environments - (mapcar (curry #'unify template) - val)))) - (unify::fill-environment (unify::environment-variables menv) - (unify::environment-values menv) - env)) - #+(or) - (unify template val env) - #+(or) - (loop :for element :in val - :do (unify template element env))) - ((unify::variablep template) - ;; *ahem* FIXME: this makes ("a" ("b" . ?b)) possible, - ;; but will cause the wrong thing to happen for - ;; ("a" ("b" . ?b) ("#b" . ?b)) - ;(alexandria:if-let ((varval (find-variable-value template env))) - ; (nconc varval val) - (unify::var-unify template val env) - #+(or) - (unify::extend-environment template val env));) - (t (error "whoops: ~s, ~s" css-specifier template))))) + :do (typecase template + ;; CSS selectors work backwards, not forwards + (css-selector-template + (unify template document env)) + (t + (let ((val (find-matching-elements css-specifier document))) + (cond + ((unify::template-p template) + (unify template val env)) + ((unify::variablep template) + (unify::var-unify template val env)) + (t (error "Don't know what to do with ~s and ~s." css-specifier template))))))) env) (defmethod unify (document (template css-selector-template)