Mon Nov 16 08:14:42 UTC 2009  pix@kepibu.org
  * Status commit
diff -rN -u old-Oh, Ducks!/regexp-template.lisp new-Oh, Ducks!/regexp-template.lisp
--- old-Oh, Ducks!/regexp-template.lisp	2013-08-10 14:54:27.000000000 +0000
+++ new-Oh, Ducks!/regexp-template.lisp	2013-08-10 14:54:27.000000000 +0000
@@ -29,9 +29,12 @@
   (destructuring-bind (re-kwd regexp &optional vars &rest keys)
       spec
     (declare (ignore re-kwd))
+    (format t "rex: ~s, ~s~%"
+            (concatenate 'string "^(.*?)" regexp "$")
+            (append '(?&rest) vars))
     (make-instance 'unify::regular-expression-template
                    :spec (list* 'unify::regexp
-                                (concatenate 'string "^(.*)" regexp "$")
+                                (concatenate 'string "^(.*?)" regexp "$")
                                 (append '(?&rest) vars)
                                 keys))))
 
diff -rN -u old-Oh, Ducks!/selectors.lisp new-Oh, Ducks!/selectors.lisp
--- old-Oh, Ducks!/selectors.lisp	2013-08-10 14:54:27.000000000 +0000
+++ new-Oh, Ducks!/selectors.lisp	2013-08-10 14:54:27.000000000 +0000
@@ -53,13 +53,21 @@
   (:method ((ob selector)) t)
   (:method ((ob t)) nil))
 
-(defclass simple-selector (simple-selector)
+(defclass simple-selector (selector)
   ((arg :reader selector-arg :initarg :arg)))
 
 (defmethod print-object ((selector simple-selector) stream)
   (format stream "#<selector ~s>" (selector-arg selector)))
 
 (defclass combinator (selector) ())
+
+(defgeneric combinator-p (object)
+  (:method ((ob combinator)) t)
+  (:method ((ob t)) nil))
+
+(defmethod print-object ((selector combinator) stream)
+  (format stream "#<combinator>"))
+
 (defclass child-combinator (combinator) ())
 (defclass descendant-combinator (combinator) ())
 (defclass adjacent-combinator (combinator) ())
@@ -69,12 +77,13 @@
 (defclass id-selector    (simple-selector) ())
 (defclass class-selector (simple-selector) ())
 
-(defmethod initialize-instance :after ((template selector) &key)
+(defmethod initialize-instance :after ((template combinator) &key)
   (unless (slot-boundp template 'matcher)
     (let ((selector (template-spec template)))
       (setf (slot-value template 'matcher) (parse-selector (string-trim " " selector))))))
 
 ;; forwards
+#+(or)
 (defun parse-selector (selector)
   (match-case (selector)
     ;; combinators
@@ -86,16 +95,19 @@
     (#T(regexp+ "^[\\.](\\w+)" (?class)) (cons (make-instance 'class-selector :arg class) (parse-selector &rest)))))
 
 ;; backwards
-#+(or)
+;; FIXME: somehow, selector is ending up as "NIL"
 (defun parse-selector (selector)
+  (when (string= "NIL" selector) (error "selector is nil"))
+  (format t "selector: ~s~%" selector)
+  (macrolet ((prest (x) `(format t "rest~s: ~S~%" ,x &rest)))
   (match-case (selector)
     ;; combinators
-    (#T(regexp$ "[ ]*[>][ ]*" ()) (list (make-instance 'child-combinator      :matcher (parse-selector &rest))))
-    (#T(regexp$ "[ ]+"        ()) (list (make-instance 'descendant-combinator :matcher (parse-selector &rest))))
+    (#T(regexp$ "[ ]*[>][ ]*" ()) (prest 'a) (list (make-instance 'child-combinator      :matcher (parse-selector &rest))))
+    (#T(regexp$ "[ ]+"        ()) (prest 'b) (list (make-instance 'descendant-combinator :matcher (parse-selector &rest))))
     ;; simple selector
-    (#T(regexp$ "(\\w+)"      (?type))  (cons (make-instance 'type-selector :arg type)   (parse-selector &rest)))
-    (#T(regexp$ "[#](\\w+)"   (?id))    (cons (make-instance 'id-selector :arg id)       (parse-selector &rest)))
-    (#T(regexp$ "[\\.](\\w+)" (?class)) (cons (make-instance 'class-selector :arg class) (parse-selector &rest)))))
+    (#T(regexp$ "[#](\\w+)"   (?id))    (prest 'c) (cons (make-instance 'id-selector :arg id)       (parse-selector &rest)))
+    (#T(regexp$ "[\\.](\\w+)" (?class)) (prest 'd) (cons (make-instance 'class-selector :arg class) (parse-selector &rest)))
+    (#T(regexp$ "(\\w+)"      (?type))  (prest 'e) (cons (make-instance 'type-selector :arg type)   (parse-selector &rest))))))
 
 
 ;; FIXME: the find/matches split seems to be causing me some mental
@@ -107,58 +119,85 @@
 
 (defgeneric find-matching-elements (selector elements))
 
-(defmethod find-matching-elements ((selector simple-selector) (elements list))
-  (nconc
-   (remove-if-not (lambda (el) (element-matches-p selector el)) elements)
-   (remove-if #'null
-	      (mapcar (lambda (element) (find-matching-elements selector (element-children element)))
-		      elements)))
-  #+(or)
-  (loop :for element :in elements
-        :when (element-matches-p selector element)
-          :collect element))
-
-#+(or) ;; hrm...this doesn't seem right... doesn't handle combinators!
-(defmethod find-matching-elements ((selector list) (elements list))
-  (flet ((all-selectors-match (element)
-	   (every (lambda (s) (element-matches-p s element)) selector)))
-    (remove-if-not #'all-selectors-match elements))
+(defmethod find-matching-elements ((selectors list) element)
+  (call-next-method)
   #+(or)
-  (loop :for element :in elements
-        :when (every (lambda (s) (element-matches-p m element)) selector)
-          :collect element))
-
-(defvar *parent*)
-;; if *parent* is equal to element-parent, we've found a child element.
-;; But, uh, who sets *parent*?
-(defmethod find-matching-elements ((selector child-combinator) (elements list))
-  )
-
-(defvar *ancestor*)
-
+  (prog1
+      (when (element-matches-p selectors element)
+        (when (every (alexandria:rcurry #'find-matching-elements element) selectors)
+          element)
+        (format t "lv fme~%"))))
+
+(defmethod find-matching-elements ((selector selector) (elements list))
+  (call-next-method))
+
+(defmethod find-matching-elements (selector (elements list))
+  (format t "in fme: ~s~%" elements)
+  (prog1
+  (nconc
+   (remove-if-not (lambda (el) (element-matches-p el selector)) elements)
+   (reduce #'nconc
+           (remove-if #'null
+                      (mapcar (lambda (element) (find-matching-elements selector (element-children element)))
+                              elements))))
+    (format t "lv fme~%")))
+
+(defmethod find-matching-elements (selector (elements t))
+  (find-matching-elements selector (list elements)))
+
+;; for lhtml compatibility
+#||
+(defvar *ancestors* nil)
+(defmethod find-matching-elements ((selector selector) (elements cons))
+  (if (keywordp (car elements))
+      (remove-if #'null
+                 (nconc
+                  (when (element-matches-p elements selector) (list elements))
+                  (let ((*ancestors* (cons elements nil)))
+                    (mapcar (lambda (el) (find-matching-elements selector el))
+                            (element-children elements)))))
+      (call-next-method)))
+||#
 
-(defgeneric element-matches-p (selector element))
+(defgeneric element-matches-p (element selector))
 
-(defmethod element-matches-p ((selector selector) (element t))
+(defmethod element-matches-p ((element t) (selector selector))
+  (error "ar?")
   nil)
+(defmethod element-matches-p :around ((element string) (selector selector))
+  (call-next-method))
+
+(defmethod element-matches-p :around ((element t) (selector selector))
+  (call-next-method)
+  #+(or)
+  (format t "c: ~s, ~s, ~s~%"
+          (class-of element)
+          (class-of selector)
+          (find-method #'element-matches-p '() (list (find-class t) (class-of selector)) nil))
+  #+(or)
+  (when (find-method #'element-matches-p '() (mapcar #'class-of (list element selector)) nil)
+    (call-next-method)))
 
-(defmethod element-matches-p ((selector type-selector) element)
+(defmethod element-matches-p (element (selector type-selector))
   (element-type-equal element (selector-arg selector)))
 
-(defmethod element-matches-p ((selector id-selector) element)
+(defmethod element-matches-p (element (selector id-selector))
+  ;(cerror "hrm" element)
+  (format t "id: ~s~%" (element-id element))
   (string= (element-id element) (selector-arg selector)))
 
-(defmethod element-matches-p ((selector class-selector) element)
+(defmethod element-matches-p (element (selector class-selector))
   (member (selector-arg selector)
 	  (element-classes element)
 	  :test #'string=))
 
-(defmethod element-matches-p ((selector child-combinator) element)
+#+(or)
+(defmethod element-matches-p (element (selector child-combinator))
   (plusp (length (find-matching-elements selector (element-children element)))))
 
 #+TODO
-(defmethod element-matches-p ((selector descendant-combinator) element)
-  (flet ((all-match (element) (every (lambda (m) (element-matches-p m element)) (matcher selector))))
+(defmethod element-matches-p (element (selector descendant-combinator))
+  (flet ((all-match (element) (every (lambda (m) (element-matches-p element m)) (matcher selector))))
     #+nil
     (when (all-match element) element)
     (let ((elements (cddr element)))
@@ -168,3 +207,12 @@
                        :when (all-match element)
                          :collect element))
         (t (css-collect-elements selector elements))))))
+
+(defmethod element-matches-p (element (selector list))
+  (every (lambda (s) (element-matches-p element s)) selector))
+
+(defmethod element-matches-p (element (selector child-combinator))
+  (element-matches-p (element-parent element) (matcher selector)))
+
+(defmethod element-matches-p (element (selector descendant-combinator))
+  (some (lambda (a) (element-matches-p a (matcher selector))) (element-ancestors element)))
diff -rN -u old-Oh, Ducks!/tests.lisp new-Oh, Ducks!/tests.lisp
--- old-Oh, Ducks!/tests.lisp	2013-08-10 14:54:27.000000000 +0000
+++ new-Oh, Ducks!/tests.lisp	2013-08-10 14:54:27.000000000 +0000
@@ -1,7 +1,9 @@
 (in-package #:css-selector-unifier)
+;; FIXME: the switch to chtml:pt nodes means our #'equalp no longer
+;; works.
 
 (equalp '(:div ((:id "id")) "I " (:i () "like") " cheese.")
-        (match (#T(lhtml ("#id" . ?div))
+        (match (#T(html ("#id" . ?div))
                   "<div id=\"id\">I <i>like</i> cheese.</div>")
           ;; FIXME: learn to distinguish between when there should only be one
           ;;        result and when there should be many?
@@ -9,28 +11,24 @@
 
 (equalp '((:div ((:class "red fish"))  "one fish")
           (:div ((:class "blue fish")) "two fish"))
-        (match (#T(lhtml (".fish" . ?divs)
-                         (".pig" . ?pig))
+        (match (#T(html (".fish" . ?divs)
+                        (".pig" . ?pig))
                 "<div class='pig'>bricklayer</div><div class='red fish'>one fish</div><div class='blue fish'>two fish</div>")
           ;; pig doesn't affect the equalp...but does show separate things are separate
           (values divs pig)))
 
 (equalp '((:i () "not") (:i () "cheese"))
-        (match (#T(lhtml ("div" ("i" . ?i)))
+        (match (#T(html ("div" ("i" . ?i)))
                   "<div>I do <i>not</i> like cheese.</div><div>I like <i>cheese</i>.</div>")
           i))
 
 (equalp '((:i () "not"))
-        (match (#T(lhtml ("div>i" . ?i))
+        (match (#T(html ("div>i" . ?i))
                   "<div>I do <i>not</i> like cheese.</div><div><span>I like <i>cheese</i>.</span></div>")
           i))
 
-;; FIXME: it seems our options for this are either to return incorrect results
-;;        ((:i not) (:i cheese)) or make ?i fail to acknowledge all available
-;;        items under div>i.  This probably means my strategy of implementation
-;;        is faulty.
 (equalp '((:i () "not"))
-        (match (#T(lhtml ("div" ("> i" . ?i)))
+        (match (#T(html ("div" ("> i" . ?i)))
                   "<div>I do <i>not</i> like cheese.</div><div><span>I like <i>cheese</i>.</span></div>")
           i))
 
diff -rN -u old-Oh, Ducks!/traversal/interface.lisp new-Oh, Ducks!/traversal/interface.lisp
--- old-Oh, Ducks!/traversal/interface.lisp	2013-08-10 14:54:27.000000000 +0000
+++ new-Oh, Ducks!/traversal/interface.lisp	2013-08-10 14:54:27.000000000 +0000
@@ -18,7 +18,7 @@
 
 (defgeneric element-id (element)
   (:documentation "Equivalent in spirit to (element-attribute :element-id element).")
-  (:method (element) (element-attribute :element-id element)))
+  (:method (element) (element-attribute :id element)))
 
 (defgeneric element-classes (element)
   (:documentation "Equivalent in spirit to (element-attribute :class element), except it returns a sequence of individual element-classes.")
@@ -28,3 +28,10 @@
 (defgeneric element-type-equal (element type)
   (:documentation "Equivalent in spirit to (string-equal (element-type element) element-type), but not obligated to work under the assumption of string-designators.")
   (:method (element type) (string-equal type (element-type element))))
+
+(defgeneric element-ancestors (element)
+  (:documentation "The result of calling element-parent repeatedly up the document tree.")
+  (:method (element)
+    (let ((parent (element-parent element)))
+      (when parent
+        (cons parent (element-ancestors parent))))))
diff -rN -u old-Oh, Ducks!/traversal/lhtml.lisp new-Oh, Ducks!/traversal/lhtml.lisp
--- old-Oh, Ducks!/traversal/lhtml.lisp	2013-08-10 14:54:27.000000000 +0000
+++ new-Oh, Ducks!/traversal/lhtml.lisp	2013-08-10 14:54:27.000000000 +0000
@@ -8,11 +8,14 @@
 (defmethod element-children ((element list))
   (cddr element))
 
+;; FIXME: bleh... may not even be worth trying to support this
 (defmethod element-parent ((element list))
-  ;; FIXME: figure out how to do this.  Maybe we can do something involving
-  ;; signals and restart-cases.  Ask "are you my mother?" up the stack, and
-  ;; only error if everybody says no.
-  (error "Unable to locate element-parent or suitable guardian."))
+  (let ((parent (car *ancestors*)))
+    (if (some (alexandria:curry #'eq element) (element-children parent))
+        parent
+        (error "unable to determine parent"))))
+(defmethod element-ancestors ((element list))
+  *ancestors*)
 
 (defmethod element-attribute ((element-attribute symbol) (element list))
   (cadr (assoc element-attribute (cadr element))))
diff -rN -u old-Oh, Ducks!/traversal/pt.lisp new-Oh, Ducks!/traversal/pt.lisp
--- old-Oh, Ducks!/traversal/pt.lisp	2013-08-10 14:54:27.000000000 +0000
+++ new-Oh, Ducks!/traversal/pt.lisp	2013-08-10 14:54:27.000000000 +0000
@@ -9,7 +9,8 @@
   (chtml:pt-parent element))
 
 (defmethod element-attribute ((element-attribute symbol) (element chtml:pt))
-  (getf (chtml:pt-attrs element) element-attribute))
+  (unless (eq :pcdata (chtml:pt-name element))
+    (getf (chtml:pt-attrs element) element-attribute)))
 (defmethod element-attribute ((element-attribute string) (element chtml:pt))
   (element-attribute (intern (string-upcase element-attribute) :keyword) element))
 
diff -rN -u old-Oh, Ducks!/unification-templates.lisp new-Oh, Ducks!/unification-templates.lisp
--- old-Oh, Ducks!/unification-templates.lisp	2013-08-10 14:54:27.000000000 +0000
+++ new-Oh, Ducks!/unification-templates.lisp	2013-08-10 14:54:27.000000000 +0000
@@ -5,8 +5,12 @@
    (parser :reader parser)   ;; subtype determines parser
    (handler :reader handler) ;; cxml/closure-html handler
    (specifiers :reader specifiers) ;; list of (specifier . variable) and (specifier . template)
+   #+(or)
+   (parent :reader parent-template :initarg :parent :initform nil)
    ))
 
+(defmethod parent-template ((template t)) nil)
+
 (defclass xml-template (css-selector-template) ()) ;; parses using closure-xml
 
 (defclass html-template (css-selector-template) ()) ;; parses using closure-html
@@ -25,13 +29,32 @@
     (setf (slot-value template 'specifiers)
           (parse-specifiers specifiers-and-vars 'lhtml-template))))
 
-(defun parse-specifiers (specs template-kind)
+(defmethod initialize-instance :after ((template pt-template) &key css-specifiers parent &allow-other-keys)
+  (let ((specifiers-and-vars (or css-specifiers (rest (template-spec template)))))
+    (setf (slot-value template 'specifiers)
+          (parse-specifiers specifiers-and-vars template parent))))
+
+(defun combine-selectors (selector parent)
+  (format t "sss: ~s~%" selector)
+  (let ((combinator (car (last selector))))
+    (cond
+      ((null parent)
+       selector)
+      ((combinator-p combinator)
+       (format t "ok!~%")
+       (setf (slot-value combinator 'matcher) parent)
+       selector)
+      (t
+       (nconc selector (list (make-instance 'descendant-combinator :matcher parent)))))))
+
+(defun parse-specifiers (specs template parent)
   (loop :for (css-specifier . rest) :in specs
-        :collect (cons (make-instance 'css-specifier :spec css-specifier)
+        :for selector = (combine-selectors (parse-selector css-specifier) parent)
+        :collect (cons selector
                        (cond
                          ((unify::template-p rest) rest)
                          ((unify::variablep rest) rest)
-                         ((consp rest) (make-instance template-kind :css-specifiers rest))))))
+                         ((consp rest) (make-instance (class-of template) :css-specifiers rest :parent selector))))))
 
 (defmethod unify ((a css-selector-template) (b css-selector-template)
                   &optional (env (make-empty-environment))
@@ -47,7 +70,7 @@
   (loop :for (css-specifier . template) :in (specifiers template)
         :do
         (format t "spec: ~s, tpl: ~s~%" css-specifier template)
-        (let ((val (css-select css-specifier document)))
+        (let ((val (find-matching-elements css-specifier document)))
           (format t "val: ~s~%" val)
           (cond
             ((unify::template-p template) (unify template val env))
@@ -59,3 +82,8 @@
                   &optional (env (make-empty-environment))
                   &key &allow-other-keys)
   (unify template (chtml:parse document (chtml:make-lhtml-builder)) env))
+
+(defmethod unify ((template pt-template) (document string)
+                  &optional (env (make-empty-environment))
+                  &key &allow-other-keys)
+  (unify template (chtml:parse document (chtml:make-pt-builder)) env))