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?).

--- old-Oh, Ducks!/selectors.lisp 2013-07-24 10:33:07.000000000 +0000

+++ new-Oh, Ducks!/selectors.lisp 2013-07-24 10:33:07.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 <a> 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 <a> tags directly under *implicit-element*, and \"+ a\" will match <a> tags directly following *implicit-element*.")

#.(set-dispatch-macro-character #\# #\T 'unify::|sharp-T-reader|)

@@ -52,23 +52,23 @@

<http://common-lisp.net/pipermail/cl-unification-devel/attachments/20091201/d5021e15/attachment.obj> ~

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)))

--- old-Oh, Ducks!/tests.lisp 2013-07-24 10:33:07.000000000 +0000

+++ new-Oh, Ducks!/tests.lisp 2013-07-24 10:33:07.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))

- "<div><i>ham</i> foo <q>bar <i>baz</i></q> quuz <i>spam</i></div>")

+ "<div><i>ham</i> foo <q>bar <i>baz</i></q> quuz <i>spam</i><q></q><i>not match</i></div>")

(match (#t(html ("+ i" . ?i))

(first q))

i))

+(match (#T(html (:model dom)

+ ("q" . ?q))

+ "<div> foo <q>outer q <i>baz <q>inner q</q></i></q> quuz</div>")

+ (match (#t(html ("q" . ?i))

+ (first q))

+ i))

+

#+LATER?

(match (#t(html ("div::content" . #t(regexp+ "^f(o+)" (?o))))

--- old-Oh, Ducks!/unify.lisp 2013-07-24 10:33:07.000000000 +0000

+++ new-Oh, Ducks!/unify.lisp 2013-07-24 10:33:07.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