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-04-10 16:15:43.000000000 +0000
+++ new-Oh, Ducks!/tests.lisp 2015-04-10 16:15:43.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))
"<div>I do <i>not</i> like cheese.</div><div><span>I like <i>cheese</i>.</span></div>")
(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-04-10 16:15:43.000000000 +0000
+++ new-Oh, Ducks!/traversal/dom.lisp 2015-04-10 16:15:43.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-04-10 16:15:43.000000000 +0000
+++ new-Oh, Ducks!/traversal/lhtml.lisp 2015-04-10 16:15:43.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-04-10 16:15:43.000000000 +0000
+++ new-Oh, Ducks!/unify.lisp 2015-04-10 16:15:43.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)