Merge pull request #10 from ruricolist/stp

Fixes for STP.

Author: bobbysmith007

src/compile.lisp

@@ -6,22 +6,22 @@
 
 (defun attrib-includes? (node attrib value)
   (member value
-	  (cl-ppcre:split "\\s+" (get-attribute node attrib))
-	  :test #'string-equal))
+          (cl-ppcre:split "\\s+" (get-attribute node attrib))
+          :test #'string-equal))
 
 (defun make-or-matcher (forms)
   (let ((matchers (mapcar (lambda (f) (make-matcher-aux f)) forms)))
     (lambda (%node%)
       "or-matcher"
       (iter (for matcher in matchers)
-	    (thereis (funcall matcher %node%))))))
+            (thereis (funcall matcher %node%))))))
 
 (defun make-and-matcher (forms  )
   (let ((matchers (mapcar (lambda (f) (make-matcher-aux f)) forms)))
     (lambda (%node%)
       "and-matcher"
       (iter (for matcher in matchers)
-	    (always (funcall matcher %node%))))))
+            (always (funcall matcher %node%))))))
 
 (defun make-class-matcher ( class )
   (lambda (%node%)
@@ -31,7 +31,7 @@
 (defun make-hash-matcher ( id )
   (lambda (%node%)
     "hash-matcher"
-    (string-equal (buildnode:get-attribute %node% :id) id)))
+    (string-equal (get-attribute %node% "id") id)))
 
 (defun make-elt-matcher ( tag )
   (lambda (%node%)
@@ -46,35 +46,35 @@
   "attrib-matcher"
   (lambda (%node%)
     (case match-type
-      (:equals (string-equal (buildnode:get-attribute %node% attrib) match-to))
+      (:equals (string-equal (get-attribute %node% attrib) match-to))
       (:includes (attrib-includes? %node% attrib match-to))
       (:dashmatch (member match-to
-			  (cl-ppcre:split "-" (buildnode:get-attribute %node% attrib))
-			  :test #'string-equal))
+                          (cl-ppcre:split "-" (get-attribute %node% attrib))
+                          :test #'string-equal))
       (:begins-with (alexandria:starts-with-subseq
-		     match-to
-		     (buildnode:get-attribute %node% attrib)
-		     :test #'char-equal))
+                     match-to
+                     (get-attribute %node% attrib)
+                     :test #'char-equal))
       (:ends-with (alexandria:ends-with-subseq
-		   match-to
-		   (buildnode:get-attribute %node% attrib)
-		   :test #'char-equal))
-      (:substring (search match-to (buildnode:get-attribute %node% attrib)
-			  :test #'string-equal ))
-      (:exists (buildnode:get-attribute %node% attrib)))))
+                   match-to
+                   (get-attribute %node% attrib)
+                   :test #'char-equal))
+      (:substring (search match-to (get-attribute %node% attrib)
+                          :test #'string-equal ))
+      (:exists (get-attribute %node% attrib)))))
 
 
 
 (defun make-immediate-child-matcher (parent-matcher child-matcher)
   (lambda (%node%)
     (and (funcall child-matcher %node%)
-	 (parent-element %node%)
-	 (funcall parent-matcher (parent-element %node%)))))
+         (parent-element %node%)
+         (funcall parent-matcher (parent-element %node%)))))
 
 (defun make-child-matcher (parent-matcher child-matcher  )
   (lambda (%node%)
     (and (funcall child-matcher %node%)
-	 (iter (for n in (parent-elements %node%))
+         (iter (for n in (parent-elements %node%))
            ;; the root is/could be document node
            ;; we can really only test on elements, so
            ;; this seems pretty valid, solves github issue:5
@@ -84,16 +84,16 @@
 (defun make-immediatly-preceded-by-matcher (this-matcher sibling-matcher  )
   (lambda (%node%)
     (and (funcall this-matcher %node%)
-	 (previous-sibling %node%)
-	 (funcall sibling-matcher (previous-sibling %node%)))))
+         (previous-sibling %node%)
+         (funcall sibling-matcher (previous-sibling %node%)))))
 
 (defun make-preceded-by-matcher (this-matcher sibling-matcher  )
   (lambda (%node%)
     (and (funcall this-matcher %node%)
-	 (iter (for n initially (previous-sibling %node%)
-		    then (previous-sibling n))
-	       (while n)
-	       (thereis (funcall sibling-matcher n))))))
+         (iter (for n initially (previous-sibling %node%)
+                    then (previous-sibling n))
+               (while n)
+               (thereis (funcall sibling-matcher n))))))
 
 (defun make-pseudo-matcher (pseudo submatcher)
   (lambda (%node%) (funcall pseudo %node% submatcher)))
@@ -103,8 +103,8 @@
 
 (defun make-matcher-aux (tree)
   (ecase (typecase tree
-	   (atom tree)
-	   (list (car tree)))
+           (atom tree)
+           (list (car tree)))
     (:or (make-or-matcher (rest tree)  ))
     (:and (make-and-matcher (rest tree)  ))
     (:class (make-class-matcher (second tree)  ))
@@ -113,44 +113,44 @@
     (:everything (lambda (%node%) (declare (ignore %node%)) T))
     (:attribute
        (let ((attrib (second tree)))
-	 (ecase (length tree)
-	   (2 (make-attrib-matcher attrib :exists nil  ))
-	   (3 (destructuring-bind (match-type match-to) (third tree)
-		(make-attrib-matcher attrib match-type match-to  ))))))
+         (ecase (length tree)
+           (2 (make-attrib-matcher attrib :exists nil  ))
+           (3 (destructuring-bind (match-type match-to) (third tree)
+                (make-attrib-matcher attrib match-type match-to  ))))))
     (:immediate-child
        (make-immediate-child-matcher
-	(make-matcher-aux (second tree))
-	(make-matcher-aux (third tree))
-	))
+        (make-matcher-aux (second tree))
+        (make-matcher-aux (third tree))
+        ))
     (:child
        (make-child-matcher
-	(make-matcher-aux (second tree))
-	(make-matcher-aux (third tree))
-	))
+        (make-matcher-aux (second tree))
+        (make-matcher-aux (third tree))
+        ))
     (:immediatly-preceded-by
        (make-immediatly-preceded-by-matcher
-	(make-matcher-aux (third tree))
-	(make-matcher-aux (second tree))
-	))
+        (make-matcher-aux (third tree))
+        (make-matcher-aux (second tree))
+        ))
     (:preceded-by
        (make-preceded-by-matcher
-	(make-matcher-aux (third tree))
-	(make-matcher-aux (second tree))
-	))
+        (make-matcher-aux (third tree))
+        (make-matcher-aux (second tree))
+        ))
     (:pseudo
        (destructuring-bind (pseudo name &optional subselector) tree
-	 (declare (ignore pseudo ))
-	 (make-pseudo-matcher
-	  (fdefinition (intern (string-upcase name) :pseudo))
-	  (when subselector
-	    (make-matcher-aux subselector  ))
-	  )))
+         (declare (ignore pseudo ))
+         (make-pseudo-matcher
+          (fdefinition (intern (string-upcase name) :pseudo))
+          (when subselector
+            (make-matcher-aux subselector  ))
+          )))
     (:nth-pseudo
        (destructuring-bind (pseudo name mul add) tree
-	 (declare (ignore pseudo ))
-	 (make-nth-pseudo-matcher
-	  (fdefinition (intern (string-upcase name) :pseudo))
-	  mul add  )))))
+         (declare (ignore pseudo ))
+         (make-nth-pseudo-matcher
+          (fdefinition (intern (string-upcase name) :pseudo))
+          mul add  )))))
 
 (defun make-node-matcher (expression)
   (make-matcher-aux
@@ -176,8 +176,8 @@
   `(%node-matches?
     ,node
     ,(if (constantp inp e)
-	 `(load-time-value (compile-css-node-matcher ,inp))
-	 inp)))
+         `(load-time-value (compile-css-node-matcher ,inp))
+         inp)))
 
 (defgeneric %do-query (matcher node &key first?)
   (:documentation "matches selector inp against the node
@@ -196,11 +196,8 @@
   (%query inp trees))
 
 (define-compiler-macro query (inp &optional (trees 'buildnode:*document*) &environment e)
-  `(%query 
+  `(%query
     ,(if (constantp inp e)
-	 `(load-time-value (compile-css-node-matcher ,inp))
-	 inp)
+         `(load-time-value (compile-css-node-matcher ,inp))
+         inp)
     ,trees))
-
-
-

src/stp.lisp

@@ -5,18 +5,19 @@
 
 (defmethod get-attribute ((elt stp:element) attr)
   ;; TODO: special case namespace-uri
-  (stp:attribute-value elt attr))
+  (stp:attribute-value elt (string-downcase attr)))
 
 (defmethod element-p ((elt stp:element))
   elt)
 
 (defmethod parent-node ((n stp:node))
   "gets the parent node"
-  (stp:parent-node n))
+  (stp:parent n))
 
 (defmethod previous-sibling ((n stp:element))
   "gets the parent dom:element (rather than ever returning the document node)"
-  (element-p (stp:previous-sibling n)))
+  (unless (eq n (stp:first-child (stp:parent n)))
+    (element-p (stp:previous-sibling n))))
 
 (defmethod child-elements ((n stp:node))
   (iter (for kid in (stp:list-children n))
@@ -28,14 +29,23 @@
 (defmethod document-of ((n stp:node))
   (stp:document n))
 
+(defun stp-do-query (matcher elt first?)
+  (if first?
+      (stp:find-recursively-if
+       (lambda (node)
+         (when (and (element-p node) (funcall matcher node))
+           node))
+       elt)
+      (let ((matches '()))
+        (stp:filter-recursively
+         (lambda (node)
+           (when (and (element-p node) (funcall matcher node))
+             (push node matches)))
+         elt)
+        (nreverse matches))))
+
 (defmethod %do-query (matcher (elt stp:element) &key (first? nil))
-  (stp:filter-children
-   (lambda (node)
-     (let ((res (and (element-p node)
-                     (or (cl:not matcher);; TODO: why would this be nil
-                         (funcall matcher node)))))
-       (if (and first? res)
-           (return-from %do-query node)
-           res)))
-   elt))
+  (stp-do-query matcher elt first?))
 
+(defmethod %do-query (matcher (elt stp:document) &key (first? nil))
+  (stp-do-query matcher elt first?))