Sat Dec 5 07:18:05 UTC 2009 pix@kepibu.org * implicit-element is a better name than root Also add a bit of support for sibling combinators when dealing with the implicit element, and note a problem that crops up when dealing with selections on a non-root element (should a simple-selector select the element, or is there an implicit descendant combinator?). diff -rN -u old-Oh, Ducks!/selectors.lisp new-Oh, Ducks!/selectors.lisp --- old-Oh, Ducks!/selectors.lisp 2015-11-24 08:42:00.000000000 +0000 +++ new-Oh, Ducks!/selectors.lisp 2015-11-24 08:42:00.000000000 +0000 @@ -1,7 +1,7 @@ (in-package #:oh-ducks) -(defvar *effective-root* nil - "The element to be considered as the root element during unification. Is the implicit element to be matched by combinators without a leading qualifier. E.g., \"> a\" will match tags directly under *effective-root*.") +(defvar *implicit-element* nil + "The element to be considered as an implicit element to be matched by combinators without a leading qualifier. E.g., \"> a\" will match tags directly under *implicit-element*, and \"+ a\" will match tags directly following *implicit-element*.") #.(set-dispatch-macro-character #\# #\T 'unify::|sharp-T-reader|) @@ -52,23 +52,23 @@ ~ to ensure proper functioning of the \"Oh, Ducks!\" library.") -(defclass %root-selector (simple-selector) ()) -(defparameter %root-selector (make-instance '%root-selector)) +(defclass %implicit-element-selector (selector) ()) +(defparameter %implicit-element-selector (make-instance '%implicit-element-selector)) -(defmethod print-object ((selector %root-selector) stream) +(defmethod print-object ((selector %implicit-element-selector) stream) (print-unreadable-object (selector stream :type t))) (defun parse-selector (selector) (match-case (selector) ;; combinators (#T(regexp$ "[ ]*[~][ ]*" ()) - (list (make-instance 'sibling-combinator :matcher (or (parse-selector &rest) %root-selector)))) + (list (make-instance 'sibling-combinator :matcher (or (parse-selector &rest) %implicit-element-selector)))) (#T(regexp$ "[ ]*[+][ ]*" ()) - (list (make-instance 'adjacent-combinator :matcher (or (parse-selector &rest) %root-selector)))) + (list (make-instance 'adjacent-combinator :matcher (or (parse-selector &rest) %implicit-element-selector)))) (#T(regexp$ "[ ]*[>][ ]*" ()) - (list (make-instance 'child-combinator :matcher (or (parse-selector &rest) %root-selector)))) + (list (make-instance 'child-combinator :matcher (or (parse-selector &rest) %implicit-element-selector)))) (#T(regexp$ "[ ]+" ()) - (list (make-instance 'descendant-combinator :matcher (or (parse-selector &rest) %root-selector)))) + (list (make-instance 'descendant-combinator :matcher (or (parse-selector &rest) %implicit-element-selector)))) ;; simple selectors ;; cyclic (An+B, n+B) (#T(regexp$ ":nth-child\\([ ]*([+-]?)([0-9]+)?n[ ]*([+-])[ ]*([0-9]+)?[ ]*\\)" (?asign ?a ?bsign ?b)) @@ -103,6 +103,11 @@ ;#t(lex$ ("#" (?id :identifier))) ;#t(lex$ (?type :identifier)) +(defun find-matching-elements-in-list (selector element-list) + (reduce #'nconc + (mapcar (curry #'find-matching-elements selector) + element-list))) + (defgeneric find-matching-elements (selector element) (:method (selector (element t)) (flet ((find-in-list (elements) @@ -147,8 +152,8 @@ (declare (ignore element selector)) t) -(defmethod element-matches-p (element (selector %root-selector)) - (eq element *effective-root*)) +(defmethod element-matches-p (element (selector %implicit-element-selector)) + (eq element *implicit-element*)) (defmethod element-matches-p (element (selector list)) (every (curry #'element-matches-p element) selector)) @@ -174,3 +179,16 @@ (and ourpos (> ourpos 0) (find-if (rcurry #'element-matches-p (matcher selector)) siblings :end ourpos)))) + +;; Hello excessively long name +(defun terminating-implicit-sibling-combinator-p (selector) + (typecase selector + ((or sibling-combinator adjacent-combinator) + (typecase (matcher selector) + (%implicit-element-selector t) + (list (terminating-implicit-sibling-combinator-p (car (last (matcher selector))))))) + (combinator (terminating-implicit-sibling-combinator-p (matcher selector))) + (selector nil) + (null nil) + (list (terminating-implicit-sibling-combinator-p (car (last selector)))) + (t nil))) diff -rN -u old-Oh, Ducks!/tests.lisp new-Oh, Ducks!/tests.lisp --- old-Oh, Ducks!/tests.lisp 2015-11-24 08:42:00.000000000 +0000 +++ new-Oh, Ducks!/tests.lisp 2015-11-24 08:42:00.000000000 +0000 @@ -79,16 +79,21 @@ (first q)) i)) -;; Note, however, that searches are strictly recursive. So a sibling -;; combinator won't match. -;; FIXME: should it? +;; siblings will also match, thanks to a bit of ugly code (match (#T(html (:model dom) ("q" . ?q)) - "
ham foo bar baz quuz spam
") + "
ham foo bar baz quuz spamnot match
") (match (#t(html ("+ i" . ?i)) (first q)) i)) +(match (#T(html (:model dom) + ("q" . ?q)) + "
foo outer q baz inner q quuz
") + (match (#t(html ("q" . ?i)) + (first q)) + i)) + #+LATER? (match (#t(html ("div::content" . #t(regexp+ "^f(o+)" (?o)))) diff -rN -u old-Oh, Ducks!/unify.lisp new-Oh, Ducks!/unify.lisp --- old-Oh, Ducks!/unify.lisp 2015-11-24 08:42:00.000000000 +0000 +++ new-Oh, Ducks!/unify.lisp 2015-11-24 08:42:00.000000000 +0000 @@ -18,8 +18,29 @@ (css-selector-template (unify template document env)) (t - (let* ((*effective-root* document) - (val (find-matching-elements css-specifier document))) + (let* ((*implicit-element* document) + ;; FIXME: this is UGLY! + (val (cond + ((terminating-implicit-sibling-combinator-p css-specifier) + ;; search remaining siblings + (find-matching-elements-in-list + css-specifier + (rest + (member document + (when-let* ((parent (element-parent document))) + (element-children parent)) + :test #'eq)))) + ;; search subelements +;;; FIXME: this assumes if someone passes us a node they want to find +;;; subelements of that node. In the case of nested matches, that's probably +;;; true, but it hardly seems fair to assume it. Really we want some sort of +;;; descendant combinator to be sure, but the general one (#\Space) doesn't +;;; exactly show up all that well. Somebody might assume " b" was the same as +;;; "b" and get confused. + ((element-parent document) + (find-matching-elements-in-list css-specifier (element-children document))) + ;; root element includes itself + (t (find-matching-elements css-specifier document))))) (cond ((null val) (error 'unification-failure