Sun Jul 3 08:25:45 UTC 2011 pix@kepibu.org

* Add support for XMLS-style lists, conflicting with LHTML-style lists

+** Differentiating between LHTML lists and XMLS lists

+While it would, in theory, be possible to inspect lists and determine if they

+are LHTML or XMLS lists, this is not currently done. You can, however, choose

+which type you'd like to work with by pushing =:lists-are-xmls= or

+=:lists-are-lhtml= to =*features*= before loading "Oh, Ducks!".

+Unfortunately, this means you can only expect to use one list type in a single

+lisp image. Patches to either automagically detect the list type, or to provide

+layered functions are welcome.

- :components ((:file "lhtml")

+ :components (#-lists-are-xmls (:file "lhtml")

- :components ((:file "dom")))))

+ :components ((:file "dom")

+ #-lists-are-lhtml (:file "xmls")))))

+

+;; In case you're wondering, we check the inverse of the :lists-are-* keywords

+;; so, in the event you only load cxml (or chtml), and don't specify which

+;; format lists are expected to take, you get the appropriate list operation by

+;; default.

+;;; WARNING: This conflicts with lhtml.

+(in-package #:oh-ducks.traversal)

+

+(defvar *xmls-family-tree* nil)

+

+(defun in-hash (key hash)

+ (multiple-value-bind (val present-p) (gethash key hash)

+ (declare (ignore val))

+ present-p))

+

+(defun %mark-parents (parent children)

+ (dolist (item children)

+ (setf (gethash item *xmls-family-tree*) parent)

+ (%mark-parents item (element-children item))))

+

+;; WARNING: This won't produce sane results for nested (match)es, because we

+;; have no way to bind in a large enough scope.

+(defmethod unify:unify ((template oh-ducks::css-selector-template)

+ (element list)

+ &optional (env (unify:make-empty-environment))

+ &key)

+ (if (and *xmls-family-tree*

+ (in-hash element *xmls-family-tree*))

+ (call-next-method)

+ (let ((*xmls-family-tree* (make-hash-table :test 'eq)))

+ (%mark-parents nil (list element))

+ (%mark-parents element (element-children element))

+ (call-next-method))))

+

+(defmethod unify:unify ((document list) (template oh-ducks::css-selector-template)

+ &optional (env (unify:make-empty-environment))

+ &key)

+ (unify:unify template document env))

+

+;;; general accessors

+

+(defmethod element-children ((element list))

+ (remove-if-not (lambda (x) (and (listp x) (stringp (car x))))

+ (cddr element)))

+

+(defmethod element-parent ((element list))

+ (multiple-value-bind (parent present?)

+ (gethash element *xmls-family-tree*)

+ (if present?

+ parent

+ (error "unable to determine parent"))))

+

+#+(or)

+(defmethod element-attribute ((attribute symbol) (element list))

+ (cadr (assoc attribute (cadr element))))

+(defmethod element-attribute ((attribute string) (element list))

+ (cadr (assoc attribute (cadr element) :test #'string=)))

+

+(defmethod element-type ((element list))

+ (car element))

+

+(defmethod element-content ((element list))

+ (cddr element))

Sun Jul 3 07:55:18 UTC 2011 pix@kepibu.org

* Minimal support for attribute-starts-with selector

+(defclass attribute-starts-with-selector (attribute-selector) ())

+ (#T(regexp$ ("[" $name "^=" $name "]") (?attribute ?value))

+ (cons (make-instance 'attribute-starts-with-selector :arg attribute :value value)

+ (parse-selector &rest)))

+(defmethod subject-p ((selector attribute-starts-with-selector) element)

+ (when-let* ((val (element-attribute (selector-arg selector) element)))

+ (alexandria:starts-with-subseq (string-downcase (attribute-value selector)) (string-downcase val))))

+

Sun Jun 5 21:44:21 UTC 2011 pix@kepibu.org

* Update notes file

+Submitted. Was it ever accepted? Man, I don't remember.

+** Element structure templates

+For instance, sometimes it'd be nice to stuff the value of an attribute into a

+variable, like so:

+: (match #t(attr ("href" ?href) ("name" ?name)) "<a href='url' name='link'></a>"

+: (values href name)) =>

+: "url", "link"

+While it's certainly easy enough to do that using, say, XMLS-style lists, a

+general object-model-agnostic method would seem to be preferrable.

+** Layered functions so LHTML vs. XMLS support can be switched at runtime

Tue Apr 5 00:14:51 UTC 2011 pix@kepibu.org

* depend-on cl-unification-lib to work with stock cl-unification

- :depends-on (:cl-unification :cl-ppcre :split-sequence :alexandria)

+ :depends-on (:cl-unification-lib :cl-unification :cl-ppcre :split-sequence :alexandria)

Wed Feb 10 08:50:16 UTC 2010 pix@kepibu.org

* Add attribute-equal selector

-*** attribute selectors [1/7]

+*** attribute selectors [2/7]

- * [ ] attribute-equal [att=val]

+ * [X] attribute-equal [att=val]

-(defclass attribute-selector (simple-selector) ())

+(defclass attribute-selector (simple-selector)

+ ((val :reader attribute-value :initarg :value)))

+(defclass attribute-equal-selector (attribute-selector) ())

+ (#T(regexp$ ("[" $name "=" $name "]") (?attribute ?value))

+ (cons (make-instance 'attribute-equal-selector :arg attribute :value value)

+ (parse-selector &rest)))

+(defmethod subject-p ((selector attribute-equal-selector) element)

+ (when-let* ((val (element-attribute (selector-arg selector) element)))

+ (string= val (attribute-value selector))))

+

+(serialize-values

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

+ ("[id=foo]" . ?id))

+ "<div><i id='bar'>bar id</i><i>no id</i><i id='foo'>foo id</i></div>")

+ id))

+

Wed Feb 10 08:28:34 UTC 2010 pix@kepibu.org

* Add attribute-present selector

-*** attribute selectors [0/7]

- * [ ] attribute-present [att]

+*** attribute selectors [1/7]

+ * [X] attribute-present [att]

+(defclass attribute-selector (simple-selector) ())

+(defclass attribute-present-selector (attribute-selector) ())

+

+ ;; attribute selectors

+ (#T(regexp$ ("[" $name "]") (?attribute))

+ (cons (make-instance 'attribute-present-selector :arg attribute)

+ (parse-selector &rest)))

+(defmethod subject-p ((selector attribute-present-selector) element)

+ (element-attribute (selector-arg selector) element))

+

+(serialize-values

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

+ ("[id]" . ?ids))

+ "<div><i id=''>blank id</i>foo<b>no id</b>bar<i id='id'>id id</i></div>")

+ ids))

Wed Feb 10 08:27:56 UTC 2010 pix@kepibu.org

* Serialize returned tags so it's easier to see what was returned

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

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

+(defun make-dom-document (child-node)

+ (make-instance 'rune-dom::document :children (rune-dom::make-node-list (list child-node))))

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

- ("div:first-child" . ?div)

- ("i:nth-child(1)" . ?i))

- "<div>I do <i>not</i> <i>like</i> cheese.</div><div><span>I like <i>cheese</i>.</span></div>")

- (values div i))

+(defun serialize (object)

+ (let ((document

+ (etypecase object

+ (rune-dom::document object)

+ (rune-dom::element (make-dom-document object))

+ (chtml:pt object)

+ (list object))))

+ (etypecase document

+ (rune-dom::document

+ (dom:map-document (cxml:make-string-sink :omit-xml-declaration-p t)

+ document))

+ (chtml:pt

+ (chtml:serialize-pt document (chtml:make-string-sink)))

+ (list (mapcar #'serialize document)))))

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

- ("div:nth-last-child(1)" . ?div)

- ("div:last-child" . ?d2))

- "<div>I do <i>not</i> <i>like</i> cheese.</div><div><span>I like <i>cheese</i>.</span></div>")

- (values div d2))

+(defmacro serialize-values (form)

+ `(let ((values (multiple-value-list ,form)))

+ (values-list (mapcar #'serialize values))))

-(match (#t(html (:model dom)

- (":nth-last-of-type(2)" . ?first)

- (":nth-of-type(2)" . ?last))

- "<div><span>1</span><i>i</i><span>2</span><i>i</i></div>")

- (values first last))

+(equal '("<i>cheese</i>" "<i>cheese</i>")

+ (serialize-values

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

+ ("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))))

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

- ("i:only-child" . ?i)

- ("i:only-of-type" . ?i-type))

- "<div>I do <i>not</i> <i>like</i> cheese.</div><div><span>I like <i>cheese</i>.</span></div>")

- (values i i-type))

+(serialize-values

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

+ ("div:first-child" . ?div)

+ ("i:nth-child(1)" . ?i))

+ "<div>I do <i>not</i> <i>like</i> cheese.</div><div><span>I like <i>cheese</i>.</span></div>")

+ (values div i)))

+

+(serialize-values

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

+ ("div:nth-last-child(1)" . ?div)

+ ("div:last-child" . ?d2))

+ "<div>I do <i>not</i> <i>like</i> cheese.</div><div><span>I like <i>cheese</i>.</span></div>")

+ (values div d2)))

+

+(serialize-values

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

+ (":nth-last-of-type(2)" . ?first)

+ (":nth-of-type(2)" . ?last))

+ "<div><span>1</span><i>i</i><span>2</span><i>i</i></div>")

+ (values first last)))

-;; throws 'unification-failure

- "<div>I do <i>not</i> <i>like</i> cheese.</div><div><span>I like <i>cheese</i>.</span></div>")

+ "<div>I do <i>not</i> <i>like</i> cheese.</div><div><span>I like <i>cheese</i>.</span></div>")

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

- ("b + i" . ?i))

- "<div>I <b>really</b> <i>like</i> cheese. Do you not <i>dislike</i> cheese?</div>")

- (values i))

+;; throws 'unification-failure

+(serialize-values

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

+ ("i:only-child" . ?i)

+ ("i:only-of-type" . ?i-type))

+ "<div>I do <i>not</i> <i>like</i> cheese.</div><div><span><i>I</i> like <i>cheese</i>.</span></div>")

+ (values i i-type)))

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

- ("b ~ i" . ?i))

- "<div>I <i>really</i> <b>like</b> cheese. Do you not <i>dislike</i> cheese?</div>")

- (values i))

+(serialize-values

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

+ ("b + i" . ?i))

+ "<div>I <b>really</b> <i>like</i> cheese. Do you not <i>dislike</i> cheese?</div>")

+ (values i)))

+

+(serialize-values

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

+ ("b ~ i" . ?i))

+ "<div>I <i>really</i> <b>like</b> cheese. Do you <i>not</i> <i>dislike</i> cheese?</div>")

+ (values i)))

-(match (#T(html (:model pt)

- ("body :empty" . ?empty))

- "<div><p><br></p><p>testing<i>i</i>testing</p></div>")

- (values empty))

+(serialize-values

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

+ ("body :empty" . ?empty))

+ "<div><p><br></p><p>testing<i>i</i>testing</p></div>")

+ (values empty)))

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

- ("q" . ?q))

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

- (match (#t(html ("> i" . ?i))

- (first q))

- i))

+(serialize-values

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

+ ("q" . ?q))

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

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

+ (first q))

+ i)))

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

- ("q" . ?q))

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

+(serialize-values

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

+ ("q" . ?q))

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

+(serialize-values

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

Wed Feb 10 08:26:34 UTC 2010 pix@kepibu.org

* Formatting.

- "<div id=\"id\">I <i>like</i> cheese.</div>")

+ "<div id=\"id\">I <i>like</i> cheese.</div>")

Wed Feb 10 08:26:25 UTC 2010 pix@kepibu.org

* Use named-readtables instead of set-dispatch-macro-character

+(named-readtables:in-readtable template-readtable)

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

-

Wed Feb 10 08:20:45 UTC 2010 pix@kepibu.org

* Return NIL if attribute was not present

- (dom:get-attribute element attribute))

+ (when-let* ((attribute-node (dom:get-attribute-node element attribute)))

+ (dom:value attribute-node)))

Sun Feb 7 09:21:16 UTC 2010 pix@kepibu.org

* Update notes to reflect updates to cl-unification.

+ * named-readtables

+or

+: (unify:enable-template-reader)

+or

+: (named-readtables:in-readtable unify:template-readtable)

+(The latter two currently only work if you have cl-unification from my

+darcs repo.)

- "<div>I do <i>not</i> like cheese.</div><div><span>I like <i>cheese</i>.</span></div>")

+ "<div>I do <i>not</i> like cheese.</div><div><span>I like <i>cheese</i>.</span></div>")

Mon Jan 4 07:11:36 UTC 2010 pix@kepibu.org

* element-parent now works in lhtml

- (match (#T(html ("div" ("i" . ?i)))

- "<div>I do <i>not</i> like cheese.</div><div>I like <i>cheese</i>.</div>")

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

+ ("div" ("i" . ?i)))

+ "<div>I do <i>not</i> like cheese.</div><div>I like <i>cheese</i>.</div>")

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

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

- "<div>I do <i>not</i> like cheese.</div><div><span>I like <i>cheese</i>.</span></div>")

+ "<div>I do <i>not</i> like cheese.</div><div><span>I like <i>cheese</i>.</span></div>")

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

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

- "<div>I do <i>not</i> like cheese.</div><div><span>I like <i>cheese</i>.</span></div>")

+ "<div>I do <i>not</i> like cheese.</div><div><span>I like <i>cheese</i>.</span></div>")

- ((ignore-errors (element-parent document)) ; bleh. element-parent breaks lhtml nodes

+ ((element-parent document)

Mon Jan 4 07:06:50 UTC 2010 pix@kepibu.org

* Support for asking about ancestors under lhtml

-** working lhtml/xmls support [1/2]

+** working lhtml/xmls support [2/2]

- * [ ] selectors involving descendants

+ * [X] selectors involving descendants

+ CAUTION: Won't produce sane results if the document tree is

+ modified or you use nested (match)es.

+(defvar *lhtml-family-tree* nil)

+

+(defun in-hash (key hash)

+ (multiple-value-bind (val present-p) (gethash key hash)

+ (declare (ignore val))

+ present-p))

+

+(defun %mark-parents (parent children)

+ (dolist (item children)

+ (setf (gethash item *lhtml-family-tree*) parent)

+ (%mark-parents item (element-children item))))

+

+;; WARNING: This won't produce sane results for nested (match)es, because we

+;; have no way to bind in a large enough scope.

+(defmethod unify:unify ((template oh-ducks::css-selector-template)

+ (element list)

+ &optional (env (unify:make-empty-environment))

+ &key)

+ (if (and *lhtml-family-tree*

+ (in-hash element *lhtml-family-tree*))

+ (call-next-method)

+ (let ((*lhtml-family-tree* (make-hash-table :test 'eq)))

+ (%mark-parents nil (list element))

+ (%mark-parents element (element-children element))

+ (call-next-method))))

+

-;; FIXME: bleh... may not even be worth trying to support this

- (error "cannot get parent"))

-

-(defmethod element-ancestors ((element list))

- (error "cannot get ancestors"))

+ (multiple-value-bind (parent present?)

+ (gethash element *lhtml-family-tree*)

+ (if present?

+ parent

+ (error "unable to determine parent"))))

Mon Jan 4 06:58:51 UTC 2010 pix@kepibu.org

* Don't need &allow-other-key here

- &key &allow-other-keys)

+ &key)

-

Mon Jan 4 06:36:34 UTC 2010 pix@kepibu.org

* Don't count an+b|b|odd|even as separate items

-*** positional selectors [19/19]

- * [X] :nth-child(an+b)

- * [X] :nth-child(b)

- * [X] :nth-child(odd|even)

- * [X] :nth-last-child(an+b)

- * [X] :nth-last-child(b)

- * [X] :nth-last-child(odd|even)

+*** positional selectors [11/11]

+ * [X] :nth-child

+ * [X] :nth-last-child

- * [X] :nth-of-type(an+b)

- * [X] :nth-of-type(b)

- * [X] :nth-of-type(odd|even)

- * [X] :nth-last-of-type(an+b)

- * [X] :nth-last-of-type(b)

- * [X] :nth-last-of-type(odd|even)

+ * [X] :nth-of-type

+ * [X] :nth-last-of-type

Mon Jan 4 06:32:27 UTC 2010 pix@kepibu.org

* :empty selector

-*** positional selectors [18/19]

+*** positional selectors [19/19]

- * [ ] :empty

+ * [X] :empty

+(defclass empty-selector (simple-selector) ())

+ (#T(regexp$ (":empty") ())

+ (cons (make-instance 'empty-selector) (parse-selector &rest)))

+(defmethod subject-p ((selector empty-selector) element)

+ (= 0 (length (element-children element))))

+

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

+ ("body :empty" . ?empty))

+ "<div><p><br></p><p>testing<i>i</i>testing</p></div>")

+ (values empty))

+

Mon Jan 4 06:32:07 UTC 2010 pix@kepibu.org

* Add *of-type selectors

-*** positional selectors [9/19]

+*** positional selectors [18/19]

- * [ ] :nth-of-type(an+b)

- * [ ] :nth-of-type(b)

- * [ ] :nth-of-type(odd|even)

- * [ ] :nth-last-of-type(an+b)

- * [ ] :nth-last-of-type(b)

- * [ ] :nth-last-of-type(odd|even)

- * [ ] :first-of-type

- * [ ] :last-of-type

+ * [X] :nth-of-type(an+b)

+ * [X] :nth-of-type(b)

+ * [X] :nth-of-type(odd|even)

+ * [X] :nth-last-of-type(an+b)

+ * [X] :nth-last-of-type(b)

+ * [X] :nth-last-of-type(odd|even)

+ * [X] :first-of-type

+ * [X] :last-of-type

- * [ ] :only-of-type

+ * [X] :only-of-type

+(defclass nth-of-type-selector (nth-child-selector) ())

+(defclass nth-last-of-type-selector (nth-of-type-selector) ())

+ (#T(regexp$ (":nth-of-type(" \s* an+b \s* ")")

+ (?asign ?a ?bsign ?b))

+ (cons (make-instance 'nth-of-type-selector

+ :asign asign :a a

+ :bsign bsign :b b)

+ (parse-selector &rest)))

+ (#T(regexp$ (":nth-last-of-type(" \s* an+b \s* ")")

+ (?asign ?a ?bsign ?b))

+ (cons (make-instance 'nth-last-of-type-selector

+ :asign asign :a a

+ :bsign bsign :b b)

+ (parse-selector &rest)))

+ (#T(regexp$ (":nth-of-type(" \s* b \s* ")")

+ (?b))

+ (cons (make-instance 'nth-of-type-selector :a 0 :b b)

+ (parse-selector &rest)))

+ (#T(regexp$ (":nth-last-of-type(" \s* b \s* ")")

+ (?b))

+ (cons (make-instance 'nth-last-of-type-selector :a 0 :b b)

+ (parse-selector &rest)))

+ (#T(regexp$ (":nth-of-type(" \s* odd/even \s* ")")

+ (?which))

+ (cons (make-instance 'nth-of-type-selector :namedp t :b which)

+ (parse-selector &rest)))

+ (#T(regexp$ (":nth-last-of-type(" \s* odd/even \s* ")")

+ (?which))

+ (cons (make-instance 'nth-last-of-type-selector :namedp t :b which)

+ (parse-selector &rest)))

+ (#T(regexp$ (":first-of-type") ())

+ (cons (make-instance 'nth-of-type-selector :a 0 :b 1)

+ (parse-selector &rest)))

+ (#T(regexp$ (":last-of-type") ())

+ (cons (make-instance 'nth-last-of-type-selector :a 0 :b 1)

+ (parse-selector &rest)))

+ (#T(regexp$ (":only-of-type") ())

+ (list* (make-instance 'nth-of-type-selector :a 0 :b 1)

+ (make-instance 'nth-last-of-type-selector :a 0 :b 1)

+ (parse-selector &rest)))

+(defmethod subject-p ((selector nth-of-type-selector) element)

+ (when-let* ((arg (selector-arg selector))

+ (parent (element-parent element)))

+ (an+b? (car arg) (cdr arg) element

+ (remove-if-not (rcurry #'element-type-equal (element-type element))

+ (element-children parent)))))

+

+(defmethod subject-p ((selector nth-last-of-type-selector) element)

+ (when-let* ((arg (selector-arg selector))

+ (parent (element-parent element)))

+ (an+b? (car arg) (cdr arg) element

+ (reverse

+ (remove-if-not (rcurry #'element-type-equal (element-type element))

+ (element-children parent))))))

+

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

+ (":nth-last-of-type(2)" . ?first)

+ (":nth-of-type(2)" . ?last))

+ "<div><span>1</span><i>i</i><span>2</span><i>i</i></div>")

+ (values first last))

+

- ("i:only-child" . ?i))

+ ("i:only-child" . ?i)

+ ("i:only-of-type" . ?i-type))

- (values i))

+ (values i i-type))

Mon Jan 4 05:59:48 UTC 2010 pix@kepibu.org

* "lispier" regexps, l*last-child stuff

Probably against best practices to commit monolithic patches, but this

is still an unreleased library, so I don't care.

Not really sure I care for the sexp-based regexps, but they do make it

easy to use the same regexp bits across several places, and I don't

have a lexer/parser handy, so they'll have to do for now.

-*** positional selectors [3/13]

- * [X] :nth-child(n)

- * [X] :nth-child(xn+y)

- * [ ] :nth-last-child

- * [ ] :nth-last-child(xn+y)

+*** positional selectors [9/19]

+ * [X] :nth-child(an+b)

+ * [X] :nth-child(b)

+ * [X] :nth-child(odd|even)

+ * [X] :nth-last-child(an+b)

+ * [X] :nth-last-child(b)

+ * [X] :nth-last-child(odd|even)

- * [ ] :last-child

- * [ ] :nth-of-type

- * [ ] :nth-last-of-type

+ * [X] :last-child

+ * [ ] :nth-of-type(an+b)

+ * [ ] :nth-of-type(b)

+ * [ ] :nth-of-type(odd|even)

+ * [ ] :nth-last-of-type(an+b)

+ * [ ] :nth-last-of-type(b)

+ * [ ] :nth-last-of-type(odd|even)

- * [ ] :only-child

+ * [X] :only-child

- (concatenate 'string "^(.*?)" regexp "$")

+ (cond

+ ((stringp regexp)

+ (concatenate 'string "^(.*?)" regexp "$"))

+ ((listp regexp)

+ `(:sequence :start-anchor

+ (:register (:non-greedy-repetition 0 nil :everything))

+ ,@regexp

+ :end-anchor))

+ (t (error "Unknown regexp format.")))

-

+(defmethod initialize-instance :after ((selector nth-child-selector)

+ &key (asign "+") a

+ (bsign "+") b

+ namedp)

+ (setf (slot-value selector 'arg)

+ (if namedp

+ (cons 2 (if (string-equal "odd" b) 1 0))

+ (cons (parse-integer (format nil "~a~a" asign (or a 1)))

+ (parse-integer (format nil "~a~a" bsign (or b 0)))))))

+

+(cl-ppcre:define-parse-tree-synonym \s*

+ (:non-greedy-repetition 0 nil :whitespace-char-class))

+(cl-ppcre:define-parse-tree-synonym \s+

+ (:greedy-repetition 1 nil :whitespace-char-class))

+(cl-ppcre:define-parse-tree-synonym sign

+ (:char-class #\+ #\-))

+(cl-ppcre:define-parse-tree-synonym sign?

+ (:greedy-repetition 0 1 sign))

+(cl-ppcre:define-parse-tree-synonym integer

+ (:greedy-repetition 1 nil :digit-class))

+(cl-ppcre:define-parse-tree-synonym name

+ (:greedy-repetition 1 nil (:char-class :word-char-class #\-)))

+(cl-ppcre:define-parse-tree-synonym $name

+ (:register name))

+(cl-ppcre:define-parse-tree-synonym an+b

+ (:sequence

+ (:register sign?) (:greedy-repetition 0 1 (:register integer))

+ #\n \s*

+ (:register sign?) \s* (:greedy-repetition 0 1 (:register integer))))

+(cl-ppcre:define-parse-tree-synonym b

+ (:register (:sequence sign? integer)))

+(cl-ppcre:define-parse-tree-synonym odd/even

+ (:register (:alternation "odd" "even")))

+

- (#T(regexp$ "[ ]*[~][ ]*" ())

+ (#T(regexp$ (\s* #\~ \s*) ())

- (#T(regexp$ "[ ]*[+][ ]*" ())

+ (#T(regexp$ (\s* #\+ \s*) ())

- (#T(regexp$ "[ ]*[>][ ]*" ())

+ (#T(regexp$ (\s* #\> \s*) ())

- (#T(regexp$ "[ ]+" ())

+ (#T(regexp$ (\s+) ())

- (#T(regexp$ ":nth-child\\([ ]*([+-]?)([0-9]+)?n[ ]*([+-])[ ]*([0-9]+)?[ ]*\\)" (?asign ?a ?bsign ?b))

+ (#T(regexp$ (":nth-child(" \s* an+b \s* ")")

+ (?asign ?a ?bsign ?b))

- :arg (cons (funcall (if (string= "-" asign) #'- #'+)

- (if (stringp a) (parse-integer a) 1))

- (funcall (if (string= "-" bsign) #'- #'+)

- (if (stringp b) (parse-integer b) 0))))

+ :asign asign :a a

+ :bsign bsign :b b)

+ (parse-selector &rest)))

+ (#T(regexp$ (":nth-last-child(" \s* an+b \s* ")")

+ (?asign ?a ?bsign ?b))

+ (cons (make-instance 'nth-last-child-selector

+ :asign asign :a a

+ :bsign bsign :b b)

- (#T(regexp$ ":nth-child\\([ ]*([+-]?[0-9]+)[ ]*\\)" (?b))

- (cons (make-instance 'nth-child-selector :arg (cons 0 (parse-integer b))) (parse-selector &rest)))

+ (#T(regexp$ (":nth-child(" \s* b \s* ")")

+ (?b))

+ (cons (make-instance 'nth-child-selector :a 0 :b b)

+ (parse-selector &rest)))

+ (#T(regexp$ (":nth-last-child(" \s* b \s* ")")

+ (?b))

+ (cons (make-instance 'nth-last-child-selector :a 0 :b b)

+ (parse-selector &rest)))

- (#T(regexp$ ":nth-child\\([ ]*(odd|even)[ ]*\\)" (?which))

- (cons (make-instance 'nth-child-selector :arg (cons 2 (if (string-equal "odd" which) 1 0)))

+ (#T(regexp$ (":nth-child(" \s* odd/even \s* ")")

+ (?which))

+ (cons (make-instance 'nth-child-selector :namedp t :b which)

+ (parse-selector &rest)))

+ (#T(regexp$ (":nth-last-child(" \s* odd/even \s* ")")

+ (?which))

+ (cons (make-instance 'nth-last-child-selector :namedp t :b which)

- (#T(regexp$ ":first-child" ())

- (cons (make-instance 'nth-child-selector :arg (cons 0 1)) (parse-selector &rest)))

- (#T(regexp$ "[#](\\w+)" (?id))

+ ;; Everybody else

+ (#T(regexp$ (":first-child") ())

+ (cons (make-instance 'nth-child-selector :a 0 :b 1)

+ (parse-selector &rest)))

+ (#T(regexp$ (":last-child") ())

+ (cons (make-instance 'nth-last-child-selector :a 0 :b 1)

+ (parse-selector &rest)))

+ (#T(regexp$ (":only-child") ())

+ (list* (make-instance 'nth-child-selector :a 0 :b 1)

+ (make-instance 'nth-last-child-selector :a 0 :b 1)

+ (parse-selector &rest)))

+ (#T(regexp$ (#\# $name) (?id))

- (#T(regexp$ "[\\.](\\w+)" (?class))

+ (#T(regexp$ (#\. $name) (?class))

- (#T(regexp$ "(\\w+)" (?type))

+ (#T(regexp$ ($name) (?type))

- (#T(regexp$ "\\*" ())

+ (#T(regexp$ (#\*) ())

-;; Hrm... would something like this make things more or less clear?

-;#t(lex$ (":nth-child(" :s? (?a :int) "n" :s? (or #\+ #\-) :s? (?b :int) :s? ")"))

-;#t(lex$ ("#" (?id :identifier)))

-;#t(lex$ (?type :identifier))

-

- (when (subject-p element selector) (list element))

+ (when (subject-p selector element) (list element))

+(defun an+b? (a b element siblings)

+ (when-let* ((pos (1+ (position element siblings :test #'eq))))

+ ;; pos = An + B

+ (cond

+ ;; pos = 0n + B

+ ((= 0 a) (= b pos))

+ ;; (pos - B)/A = n

+ (t (and (zerop (mod (- pos b) a))

+ (not (minusp (/ (- pos b) a))))))))

+

- (when-let* ((parent (element-parent element))

- (pos (position element (funcall (typecase selector

- (nth-last-child-selector #'reverse)

- (nth-child-selector #'identity))

- (element-children parent)) :test #'eq)))

- (let ((pos (1+ pos))

- (a (car (selector-arg selector)))

- (b (cdr (selector-arg selector))))

- ;; pos = An + B

- (cond

- ;; pos = 0n + B

- ((= 0 a) (= b pos))

- ;; (pos - B)/A = n

- (t (and (zerop (mod (- pos b) a))

- (not (minusp (/ (- pos b) a)))))))))

+ (when-let* ((arg (selector-arg selector))

+ (parent (element-parent element)))

+ (an+b? (car arg) (cdr arg) element (element-children parent))))

+

+(defmethod subject-p ((selector nth-last-child-selector) element)

+ (when-let* ((arg (selector-arg selector))

+ (parent (element-parent element)))

+ (an+b? (car arg) (cdr arg) element (reverse (element-children parent)))))

- (element-classes element)

- :test #'string=))

+ (element-classes element)

+ :test #'string=))

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

+ ("div:nth-last-child(1)" . ?div)

+ ("div:last-child" . ?d2))

+ "<div>I do <i>not</i> <i>like</i> cheese.</div><div><span>I like <i>cheese</i>.</span></div>")

+ (values div d2))

+

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

+ ("i:only-child" . ?i))

+ "<div>I do <i>not</i> <i>like</i> cheese.</div><div><span>I like <i>cheese</i>.</span></div>")

+ (values i))

+

Mon Jan 4 01:07:02 UTC 2010 pix@kepibu.org

* subject-p makes more sense as (selector, element)

For future reference, I used the following code to do this automatically, plus a

few minor manual edits (e.g., swapping rcurry and curry):

(defun seek-forward (term)

(defun swap-args ()

-(defgeneric subject-p (element selector))

+(defgeneric subject-p (selector element))

-(defmethod subject-p (element (selector type-selector))

+(defmethod subject-p ((selector type-selector) element)

-(defmethod subject-p (element (selector id-selector))

+(defmethod subject-p ((selector id-selector) element)

-(defmethod subject-p (element (selector nth-child-selector))

+(defmethod subject-p ((selector nth-child-selector) element)

-(defmethod subject-p (element (selector class-selector))

+(defmethod subject-p ((selector class-selector) element)

-(defmethod subject-p (element (selector universal-selector))

+(defmethod subject-p ((selector universal-selector) element)

-(defmethod subject-p (element (selector %implicit-element-selector))

+(defmethod subject-p ((selector %implicit-element-selector) element)

-(defmethod subject-p (element (selector list))

- (every (curry #'subject-p element) selector))

+(defmethod subject-p ((selector list) element)

+ (every (rcurry #'subject-p element) selector))

-(defmethod subject-p (element (selector child-combinator))

- (subject-p (element-parent element) (matcher selector)))

+(defmethod subject-p ((selector child-combinator) element)

+ (subject-p (matcher selector) (element-parent element)))

-(defmethod subject-p (element (selector descendant-combinator))

- (some (rcurry #'subject-p (matcher selector)) (element-ancestors element)))

+(defmethod subject-p ((selector descendant-combinator) element)

+ (some (curry #'subject-p (matcher selector)) (element-ancestors element)))

-(defmethod subject-p (element (selector adjacent-combinator))

+(defmethod subject-p ((selector adjacent-combinator) element)

- (subject-p (elt siblings (1- ourpos)) (matcher selector)))))

+ (subject-p (matcher selector) (elt siblings (1- ourpos))))))

-(defmethod subject-p (element (selector sibling-combinator))

+(defmethod subject-p ((selector sibling-combinator) element)

- (find-if (rcurry #'subject-p (matcher selector)) siblings :end ourpos))))

+ (find-if (curry #'subject-p (matcher selector)) siblings :end ourpos))))

Mon Jan 4 01:04:12 UTC 2010 pix@kepibu.org

* Bring element-matches-p more in line with CSS terms as subject-p

Mon Jan 4 01:03:10 UTC 2010 pix@kepibu.org

* Make subjects-of use subjects-in-list

-(defgeneric subjects-of (selector element)

- (:method (selector (element t))

- (flet ((find-in-list (elements)

- (mapcar (curry #'subjects-of selector)

- elements)))

- (nconc

- (when (element-matches-p element selector) (list element))

- (reduce #'nconc

- (find-in-list (element-children element)))))))

+(defun subjects-of (selector element)

+ (nconc

+ (when (element-matches-p element selector) (list element))

+ (subjects-in-list selector (element-children element))))

Mon Jan 4 00:11:25 UTC 2010 pix@kepibu.org

* Rename some functions to better match CSS terminology

Sat Jan 2 09:45:37 UTC 2010 pix@kepibu.org

* Add fixme

+;; FIXME: proper parsing (e.g., by using the W3C's provided FLEX and YACC bits).

Sat Jan 2 08:38:38 UTC 2010 pix@kepibu.org

* &allow-other-keys is not actually necessary

-(defmethod initialize-instance :after ((template css-selector-template) &key css-specifiers parent &allow-other-keys)

+(defmethod initialize-instance :after ((template css-selector-template) &key css-specifiers parent)

- &key &allow-other-keys)

+ &key)

- &key &allow-other-keys)

+ &key)

- &key &allow-other-keys)

+ &key)

- &key &allow-other-keys)

+ &key)

- &key &allow-other-keys)

+ &key)

Fri Jan 1 05:06:19 UTC 2010 pix@kepibu.org

* Patch went in to cl-unification, so no longer need warning

-(warn "parse-selector currently relies on a patch which has not yet made ~

- it in to cl-unification. Be sure to apply the patch from ~

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

- to ensure proper functioning of the \"Oh, Ducks!\" library.")

-

Mon Dec 28 10:00:30 UTC 2009 pix@kepibu.org

* Another nth-last-child

-*** positional selectors [3/12]

+*** positional selectors [3/13]

+ * [ ] :nth-last-child(xn+y)

Mon Dec 28 09:59:18 UTC 2009 pix@kepibu.org

* Minor syntactic changes

To make more modern org-modes happy. Woo.

- :(asdf:oos 'asdf:load-op :oh-ducks)

+: (asdf:oos 'asdf:load-op :oh-ducks)

- :(asdf:oos 'asdf:load-op :closure-html)

+: (asdf:oos 'asdf:load-op :closure-html)

- :(asdf:oos 'asdf:load-op :cxml)

+: (asdf:oos 'asdf:load-op :cxml)

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

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

- :depends-on (:oh-ducks :closure-html :cxml)

+: :depends-on (:oh-ducks :closure-html :cxml)

- #t(html ("div" (#t(regexp "f(o+)bar") . ?div)))

+: #t(html ("div" (#t(regexp "f(o+)bar") . ?div)))

- #t(html ("div" . #t(regexp "f(o+)bar" (?o))))

+: #t(html ("div" . #t(regexp "f(o+)bar" (?o))))

Sun Dec 20 08:23:57 UTC 2009 pix@kepibu.org

* Update notes

-

+** Depending Upon in ASDF Systems

+It doesn't take long before managing your dependencies upon ASDF

+systems becomes easiest by creating an ASDF system for whatever

+project you're currently engaged in. It's important to note that, in

+addition to depending upon oh-ducks, you'll also want to depend upon

+whichever library provides your desired object model and parser.

+

+For example,

+ :depends-on (:oh-ducks :closure-html :cxml)

+

-

-The goal is to support all CSS-level-3 selectors. See the below

-section "To Do > Improve Selector Support" for a list of currently

-unsupported simple selectors and combinators.

+The goal is to support all CSS-level-3 selectors. See the section

+[[*improve selector support][To Do > Improve Selector Support]] for a list of currently unsupported

+simple selectors and combinators.

Sun Dec 13 07:28:56 UTC 2009 pix@kepibu.org

* Export xml, too

- (export 'dom))

+ (export 'dom)

+ (export 'xml))

Sun Dec 13 05:32:46 UTC 2009 pix@kepibu.org

* Add some notes

-it does not generally become useful until you have also loading an

+it does not generally become useful until you have also loaded an

- #id => elements with id of "id".

+ #id => elements with id of "id"

+NOTE: selectors are currently bound in parallel. That is, given

+ #t(html (<selector-1> ...)

+ (<selector-2> ...))

+selector-1 and selector-2 do not interact. If they are both "foo", they'll

+return identical results. I often find myself wanting to also say something

+like:

+ #t(html (<selector-1> ...)

+ (<element-after-selector-1> ...))

+Ideas for a syntax to distinguish between the two cases are welcome (:mode

+parallel) vs (:mode sequential), perhaps? (Or even adjacent, sibling?)

+

+Maybe special-case string/regexp-templates, so for example

+ #t(html ("div" (#t(regexp "f(o+)bar") . ?div)))

+would match [<div>foooobar</div>]?

+

+ #t(html ("div" . #t(regexp "f(o+)bar" (?o))))

+might cause some difficulty, however--we should get a list of matched elements

+for the div selector, but the regexp variable (?o) can only match once (without

+some wacky environment merging, anyway).

Sun Dec 13 05:24:52 UTC 2009 pix@kepibu.org

* Add element-content as a prereq to matching on an element's textual content

+ #:element-content

+(defmethod element-content ((element dom:element))

+ (mapcar (lambda (node)

+ (typecase node

+ (dom:element node)

+ (dom:text (dom:data node))

+ (t (error "Unsure what to do."))))

+ (coerce (dom:child-nodes element) 'list)))

+

+(defgeneric element-content (element)

+ (:documentation "Returns a string containing the contents of the element, if it contains only textual nodes, or a sequence containing all of the element's child nodes (textual nodes as strings, tag nodes as whatever they'd be under #'element-children).")

+ (:method :around ((element t))

+ (let ((val (call-next-method)))

+ (if (every #'stringp val)

+ (reduce (curry #'concatenate 'string) val)

+ val))))

+(defmethod element-content ((element list))

+ (cddr element))

+

+(defmethod element-content ((element chtml:pt))

+ (mapcar (lambda (node)

+ (cond

+ ((eq :pcdata (chtml:pt-name node))

+ (chtml:pt-attrs node))

+ (t node)))

+ (remove-if (curry #'eq :comment)

+ (chtml:pt-children element)

+ :key #'chtml:pt-name)))

+

Sun Dec 13 05:23:23 UTC 2009 pix@kepibu.org

* Ugly unbreaking of lhtml--man I hate this bit

- ((element-parent document)

+ ((ignore-errors (element-parent document)) ; bleh. element-parent breaks lhtml nodes

Sat Dec 5 07:23:38 UTC 2009 pix@kepibu.org

* Better method to do this in

-(defmethod oh-ducks::find-matching-elements (selector (element dom:document))

- (oh-ducks::find-matching-elements selector (dom:document-element element)))

+(defmethod unify:unify ((template oh-ducks::css-selector-template)

+ (document dom:document)

+ &optional (env (unify:make-empty-environment))

+ &key &allow-other-keys)

+ (unify:unify template (dom:document-element document) env))

+

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

-(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*.")

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

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

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

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

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

+(defun find-matching-elements-in-list (selector element-list)

+ (reduce #'nconc

+ (mapcar (curry #'find-matching-elements selector)

+ element-list)))

+

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

+

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

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

- "<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 (: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))

+

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

Fri Dec 4 05:16:28 UTC 2009 pix@kepibu.org

* Fix an odd clisp compile issue

+;; Don't bother trying to save :parser when compiling

+(defmethod make-load-form ((object css-selector-template) &optional env)

+ (declare (ignore env))

+ `(make-template ',(first (template-spec object)) ',(template-spec object)))

+

Fri Dec 4 04:47:58 UTC 2009 pix@kepibu.org

* Make descendant combinators work with an implicit parent

+(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*.")

+

+(defclass %root-selector (simple-selector) ())

+(defparameter %root-selector (make-instance '%root-selector))

+

+(defmethod print-object ((selector %root-selector) stream)

+ (print-unreadable-object (selector stream :type t)))

+

- (list (make-instance 'sibling-combinator :matcher (parse-selector &rest))))

+ (list (make-instance 'sibling-combinator :matcher (or (parse-selector &rest) %root-selector))))

- (list (make-instance 'adjacent-combinator :matcher (parse-selector &rest))))

+ (list (make-instance 'adjacent-combinator :matcher (or (parse-selector &rest) %root-selector))))

- (list (make-instance 'child-combinator :matcher (parse-selector &rest))))

+ (list (make-instance 'child-combinator :matcher (or (parse-selector &rest) %root-selector))))

- (list (make-instance 'descendant-combinator :matcher (parse-selector &rest))))

+ (list (make-instance 'descendant-combinator :matcher (or (parse-selector &rest) %root-selector))))

+(defmethod element-matches-p (element (selector %root-selector))

+ (eq element *effective-root*))

+

+;; Sometimes, you want to match a thing inside a thing, in which case

+;; combinators should implicitly assume an unspecified right side means

+;; "whatever element I gave you".

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

+ ("q" . ?q))

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

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

+ (first q))

+ i))

+

+;; Note, however, that searches are strictly recursive. So a sibling

+;; combinator won't match.

+;; FIXME: should it?

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

+ ("q" . ?q))

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

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

+ (first q))

+ i))

+

- (let ((val (find-matching-elements css-specifier document)))

+ (let* ((*effective-root* document)

+ (val (find-matching-elements css-specifier document)))

Thu Dec 3 03:26:59 UTC 2009 pix@kepibu.org

* declare ignored variables

+ (declare (ignore element selector))

+ (declare (ignore var pat env))

+ (declare (ignore var pat env))

Thu Dec 3 02:41:36 UTC 2009 pix@kepibu.org

* Better messages

-(warn "parse-selector currently relies on a patch which has not only ~

- not been submitted to cl-unification-devel, it has not yet ~

- been copied to penguin.")

+(warn "parse-selector currently relies on a patch which has not yet made ~

+ it in to cl-unification. Be sure to apply the patch from ~

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

+ to ensure proper functioning of the \"Oh, Ducks!\" library.")

- (t (error "Don't know what to do with ~s and ~s." css-specifier template)))))))

+ (t (error "Don't know what to do with selector ~s and template ~s." css-specifier template)))))))

Thu Dec 3 00:12:02 UTC 2009 pix@kepibu.org

* Add sibling and adjacent combinators

- #+TODO (#T(regexp$ "[ ]*[~][ ]*" ()) (list (make-instance 'sibling-combinator :matcher (parse-selector &rest))))

- #+TODO (#T(regexp$ "[ ]*[+][ ]*" ()) (list (make-instance 'adjacent-combinator :matcher (parse-selector &rest))))

+ (#T(regexp$ "[ ]*[~][ ]*" ())

+ (list (make-instance 'sibling-combinator :matcher (parse-selector &rest))))

+ (#T(regexp$ "[ ]*[+][ ]*" ())

+ (list (make-instance 'adjacent-combinator :matcher (parse-selector &rest))))

-#+TODO

- ...)

+ (let* ((parent (element-parent element))

+ (siblings (element-children parent))

+ (ourpos (position element siblings :test #'eq)))

+ (and ourpos

+ (> ourpos 0)

+ (element-matches-p (elt siblings (1- ourpos)) (matcher selector)))))

-#+TODO

- ...)

+ (let* ((parent (element-parent element))

+ (siblings (element-children parent))

+ (ourpos (position element siblings :test #'eq)))

+ (and ourpos

+ (> ourpos 0)

+ (find-if (rcurry #'element-matches-p (matcher selector)) siblings :end ourpos))))

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

+ ("b + i" . ?i))

+ "<div>I <b>really</b> <i>like</i> cheese. Do you not <i>dislike</i> cheese?</div>")

+ (values i))

+

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

+ ("b ~ i" . ?i))

+ "<div>I <i>really</i> <b>like</b> cheese. Do you not <i>dislike</i> cheese?</div>")

+ (values i))

+

+

Thu Dec 3 00:07:44 UTC 2009 pix@kepibu.org

* Fix copy-paste issue.

- (list :model 'pt))

+ (list :model 'dom))

Mon Nov 30 05:04:24 UTC 2009 pix@kepibu.org

* Record idea

+;; Hrm... would something like this make things more or less clear?

+;#t(lex$ (":nth-child(" :s? (?a :int) "n" :s? (or #\+ #\-) :s? (?b :int) :s? ")"))

+;#t(lex$ ("#" (?id :identifier)))

+;#t(lex$ (?type :identifier))

+

Mon Nov 30 05:04:06 UTC 2009 pix@kepibu.org

* Work for spaces between [+-] and B

- (#T(regexp$ ":nth-child\\([ ]*([+-]?)([0-9]+)?n[ ]*([+-]?[0-9]+)?[ ]*\\)" (?asign ?a ?b))

+ (#T(regexp$ ":nth-child\\([ ]*([+-]?)([0-9]+)?n[ ]*([+-])[ ]*([0-9]+)?[ ]*\\)" (?asign ?a ?bsign ?b))

- (if (stringp b) (parse-integer b) 0)))

+ (funcall (if (string= "-" bsign) #'- #'+)

+ (if (stringp b) (parse-integer b) 0))))

Mon Nov 30 04:48:22 UTC 2009 pix@kepibu.org

* Combine nth-child variants

+(warn "parse-selector currently relies on a patch which has not only ~

+ not been submitted to cl-unification-devel, it has not yet ~

+ been copied to penguin.")

+

- ;; FIXME: fix cl-unification so it can handle non-matching groups,

- ;; so we can merge all these nth-child-selector variants

- ;; into one or two

- (#T(regexp$ ":nth-child\\([ ]*([+-]?[0-9]+)n[ ]*([+-]?[0-9]+)[ ]*\\)" (?a ?b))

- (cons (make-instance 'nth-child-selector :arg (cons (parse-integer a) (parse-integer b))) (parse-selector &rest)))

- (#T(regexp$ ":nth-child\\([ ]*([+-]?[0-9]+)n[ ]*\\)" (?a))

- (cons (make-instance 'nth-child-selector :arg (cons (parse-integer a) 0)) (parse-selector &rest)))

- (#T(regexp$ ":nth-child\\([ ]*n[ ]*([+-]?[0-9]+)[ ]*\\)" (?b))

- (cons (make-instance 'nth-child-selector :arg (cons 1 (parse-integer b))) (parse-selector &rest)))

- (#T(regexp$ ":nth-child\\([ ]*-n[ ]*([+-]?[0-9]+)[ ]*\\)" (?b))

- (cons (make-instance 'nth-child-selector :arg (cons -1 (parse-integer b))) (parse-selector &rest)))

+ ;; cyclic (An+B, n+B)

+ (#T(regexp$ ":nth-child\\([ ]*([+-]?)([0-9]+)?n[ ]*([+-]?[0-9]+)?[ ]*\\)" (?asign ?a ?b))

+ (cons (make-instance 'nth-child-selector

+ :arg (cons (funcall (if (string= "-" asign) #'- #'+)

+ (if (stringp a) (parse-integer a) 1))

+ (if (stringp b) (parse-integer b) 0)))

+ (parse-selector &rest)))

+ ;; absolute (B)

- (#T(regexp$ ":nth-child\\([ ]*odd[ ]*\\)" ())

- (cons (make-instance 'nth-child-selector :arg (cons 2 1)) (parse-selector &rest)))

- (#T(regexp$ ":nth-child\\([ ]*even[ ]*\\)" ())

- (cons (make-instance 'nth-child-selector :arg (cons 2 0)) (parse-selector &rest)))

+ ;; named (odd, even)

+ (#T(regexp$ ":nth-child\\([ ]*(odd|even)[ ]*\\)" (?which))

+ (cons (make-instance 'nth-child-selector :arg (cons 2 (if (string-equal "odd" which) 1 0)))

+ (parse-selector &rest)))

Mon Nov 30 04:10:09 UTC 2009 pix@kepibu.org

* Fix bug in element-children for sgml:pt model

- (remove-if (rcurry #'member '(:pcdata :comment) :test #'eq)

+ (remove-if (compose (rcurry #'member '(:pcdata :comment) :test #'eq) #'chtml:pt-name)

- (unless (eq :pcdata (chtml:pt-name element))

- (getf (chtml:pt-attrs element) element-attribute)))

+ (getf (chtml:pt-attrs element) element-attribute))

Mon Nov 30 04:09:10 UTC 2009 pix@kepibu.org

* Add :nth-child selector

-*** positional selectors [2/12]

+*** positional selectors [3/12]

- * [ ] :nth-child(xn+y)

+ * [X] :nth-child(xn+y)

+(defclass nth-last-child-selector (nth-child-selector) ())

- (#T(regexp$ ":nth-child\\([ ]*([0-9]+)[ ]*\\)" (?n))

- (cons (make-instance 'nth-child-selector :arg (parse-integer n)) (parse-selector &rest)))

+ ;; FIXME: fix cl-unification so it can handle non-matching groups,

+ ;; so we can merge all these nth-child-selector variants

+ ;; into one or two

+ (#T(regexp$ ":nth-child\\([ ]*([+-]?[0-9]+)n[ ]*([+-]?[0-9]+)[ ]*\\)" (?a ?b))

+ (cons (make-instance 'nth-child-selector :arg (cons (parse-integer a) (parse-integer b))) (parse-selector &rest)))

+ (#T(regexp$ ":nth-child\\([ ]*([+-]?[0-9]+)n[ ]*\\)" (?a))

+ (cons (make-instance 'nth-child-selector :arg (cons (parse-integer a) 0)) (parse-selector &rest)))

+ (#T(regexp$ ":nth-child\\([ ]*n[ ]*([+-]?[0-9]+)[ ]*\\)" (?b))

+ (cons (make-instance 'nth-child-selector :arg (cons 1 (parse-integer b))) (parse-selector &rest)))

+ (#T(regexp$ ":nth-child\\([ ]*-n[ ]*([+-]?[0-9]+)[ ]*\\)" (?b))

+ (cons (make-instance 'nth-child-selector :arg (cons -1 (parse-integer b))) (parse-selector &rest)))

+ (#T(regexp$ ":nth-child\\([ ]*([+-]?[0-9]+)[ ]*\\)" (?b))

+ (cons (make-instance 'nth-child-selector :arg (cons 0 (parse-integer b))) (parse-selector &rest)))

+ (#T(regexp$ ":nth-child\\([ ]*odd[ ]*\\)" ())

+ (cons (make-instance 'nth-child-selector :arg (cons 2 1)) (parse-selector &rest)))

+ (#T(regexp$ ":nth-child\\([ ]*even[ ]*\\)" ())

+ (cons (make-instance 'nth-child-selector :arg (cons 2 0)) (parse-selector &rest)))

- (cons (make-instance 'nth-child-selector :arg 1) (parse-selector &rest)))

+ (cons (make-instance 'nth-child-selector :arg (cons 0 1)) (parse-selector &rest)))

- (pos (position element (element-children parent) :test #'eq)))

- (= (selector-arg selector) (1+ pos))))

+ (pos (position element (funcall (typecase selector

+ (nth-last-child-selector #'reverse)

+ (nth-child-selector #'identity))

+ (element-children parent)) :test #'eq)))

+ (let ((pos (1+ pos))

+ (a (car (selector-arg selector)))

+ (b (cdr (selector-arg selector))))

+ ;; pos = An + B

+ (cond

+ ;; pos = 0n + B

+ ((= 0 a) (= b pos))

+ ;; (pos - B)/A = n

+ (t (and (zerop (mod (- pos b) a))

+ (not (minusp (/ (- pos b) a)))))))))

Mon Nov 23 13:25:26 UTC 2009 pix@kepibu.org

* Whoops

-(defmethod element-classes (element)

+(defmethod element-classes ((element dom:element))

Mon Nov 23 13:19:59 UTC 2009 pix@kepibu.org

* Fail unification if no match for a selector

-* Known Bugs

-** Failure to match results in NIL, rather than a unification-failure

-#+FIXME ;; should throw 'unification-failure

+;; throws 'unification-failure

+ ((null val)

+ (error 'unification-failure

+ :format-control "Unable to unify ~s and ~s"

+ :format-arguments (list css-specifier template)))

Mon Nov 23 13:14:45 UTC 2009 pix@kepibu.org

* add FIXME test

-#+LATER

+#+FIXME ;; should throw 'unification-failure

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

+ ("q" . ?div))

+ "<div>I do <i>not</i> <i>like</i> cheese.</div><div><span>I like <i>cheese</i>.</span></div>")

+ (values div))

+

+#+LATER?

Mon Nov 23 13:14:00 UTC 2009 pix@kepibu.org

* Error when unable to parse CSS selector

-** Does not error on unknown CSS selectors

- (cons (make-instance 'universal-selector) (parse-selector &rest)))))

+ (cons (make-instance 'universal-selector) (parse-selector &rest)))

+ (t (unless (string= selector "")

+ (error "Unable to to parse selector: ~s" selector)))))

Mon Nov 23 13:13:22 UTC 2009 pix@kepibu.org

* Start documentation

+* Purpose

+"Oh, Ducks!" is an extension to cl-unification to make parsing

+structured documents easy, using CSS selectors.

+* Installation

+** Prerequisites

+ + cl-unification

+ + cl-ppcre

+ + split-sequence

+ + alexandria

+ + asdf-system-connections

+ * closure-html

+ * cxml

+[+] Mandatory [*] Optional

+** Loading

+Loading "Oh, Ducks!" is just like loading any other ASDF system.

+However, because it does not mandate a particular HTML or XML parser,

+it does not generally become useful until you have also loading an

+HTML/XML parsing library such as cxml or closure-html.

+

+Start with:

+ :(asdf:oos 'asdf:load-op :oh-ducks)

+If you would like to use the built-in support for parsing via

+closure-html (which you almost certainly do), you'll also want to load

+closure-html:

+ :(asdf:oos 'asdf:load-op :closure-html)

+And, if you want to use DOM objects provided by cxml:

+ :(asdf:oos 'asdf:load-op :cxml)

+

+** Load-order Caveats

+closure-html and cl-unification each define competing readers on #t.

+To avoid load-order issues resulting in an indeterminate reader on #t,

+you'll probably want to add

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

+to the top of any file which uses cl-unification's reader templates.

+

+Please feel free to submit patches to closure-html and cl-unification

+to fix this problem.

+* Usage

+The combination of oh-ducks and closure-html provides an HTML template

+for use with cl-unification, and has the following syntax:

+

+ (match (#t(html [(:model <model>)]

+ <selectors>+)

+ <document>)

+ &body)

+ selectors := (<selector> . <binding>) |

+ (<selector> . <template>) |

+ (<selector> <selectors>+)

+ document := <parsed-document> | <document-to-be-parsed>

+

+:model is only necessary for unparsed documents (e.g., a pathname or string).

+

+** Examples

+

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

+ ("#id" . ?div))

+ "<div id=\"id\">I <i>like</i> cheese.</div>")

+ (car div)) =>

+ (:div ((:id "id")) "I " (:i () "like") " cheese.")

+

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

+ ("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)) =>

+ #<ELEMENT i "not">,

+ (#<ELEMENT i "cheese">)

+

+** Selectors

+

+The goal is to support all CSS-level-3 selectors. See the below

+section "To Do > Improve Selector Support" for a list of currently

+unsupported simple selectors and combinators.

+

+Each selector should result in the same elements which would be

+affected by the same CSS selector. That is,

+ #id => elements with id of "id".

+ .foo.bar => elements with both "foo" and "bar" classes

+ div => all <div>s

+and so forth.

+

+*** Limitations

+

+Currently, selector terms are limited to alphanumeric characters, and

+do not support CSS-style character escapes. Patches welcome!

+

+** Included Object Models

+*** LHTML (closure-html)

+A list-based structure provided by closure-html. Cannot be used by

+selectors which require asking about parent or sibling objects.

+*** PT (closure-html)

+A structure-based structure provided by closure-html.

+*** DOM (cxml)

+DOM objects as provided by cxml and defined by the W3C.

+* Extending

+** Adding an object model

+While the supported models should generally be sufficient, you can add

+your own fairly easily. All models are expected to implement the

+generic functions in <traversal/interface.lisp>. See the other files

+under the traversal/ directory for examples.

+

+You might also want to see chtml.lisp and cxml.lisp.

+** Adding a selector or combinator

+see <selectors.lisp>. Generally, you should add a class which is a

+subclass of combinator or simple-selector, augment parse-selector with

+an appropriate regular expression, and define a method on

+element-matches-p.

+

+I also recommend submitting a patch. Other people might want to use

+that selector, too!

+* Known Bugs

+** Does not error on unknown CSS selectors

+** Failure to match results in NIL, rather than a unification-failure

+** Submit patch to cl-unification to add (enable/disable-template-reader) functions

+** Submit patch to closure-html to add (enable/disable-reader) functions

+** non-css templates (e.g., for matching on text of element)?

Mon Nov 23 13:02:12 UTC 2009 pix@kepibu.org

* Import when-let*, too

- #:rcurry))

+ #:rcurry

+ #:when-let*))

- (alexandria:when-let* ((parent (element-parent element))

- (pos (position element (element-children parent) :test #'eq)))

+ (when-let* ((parent (element-parent element))

+ (pos (position element (element-children parent) :test #'eq)))

Mon Nov 23 13:01:50 UTC 2009 pix@kepibu.org

* Indentation

- :components ((:file "lhtml")

- (:file "pt")))))

+ :components ((:file "lhtml")

+ (:file "pt")))))

- :components ((:file "dom")))))

+ :components ((:file "dom")))))

Mon Nov 23 11:54:01 UTC 2009 pix@kepibu.org

* Cut out a few warnings from cl-unification

+(defmethod unify::occurs-in-p ((var symbol) (pat dom:element) env)

+ nil)

+

+(defmethod unify::occurs-in-p ((var symbol) (pat chtml:pt) env)

+ nil)

+

Mon Nov 23 11:38:12 UTC 2009 pix@kepibu.org

* No longer needed

- (format t "cc:: el: ~s, s: ~s~%" (element-parent element) selector)

-(defun merge-environments (env1 env2)

- (assert (or (unify::empty-environment-p env1)

- (equal (unify::environment-variables env1)

- (unify::environment-variables env2))))

- (format t "ev1: ~s, ev2: ~s~%" (unify::environment-values env1) (unify::environment-values env2))

- (format t "q: ~s~%" (unify::find-variable-value '?i env1))

- (unify::fill-environment (unify::environment-variables env1)

- (mapcar (lambda (a b) (format t "a: ~s, b: ~s~%" a b) (append a b))

- (unify::environment-values env1)

- (unify::environment-values env2))

- (make-empty-environment)))

-

Mon Nov 23 11:36:20 UTC 2009 pix@kepibu.org

* Don't return a dom:document as parent

-(defmethod element-parent ((element dom:document))

- nil)

- (dom:parent-node element))

+ (let ((parent (dom:parent-node element)))

+ (unless (typep parent 'dom:document)

+ parent)))

Mon Nov 23 11:33:15 UTC 2009 pix@kepibu.org

* :first-child and :nth-child(n) selectors

-*** positional selectors

- * [ ] :nth-child

+*** positional selectors [2/12]

+ * [X] :nth-child(n)

+ * [ ] :nth-child(xn+y)

- * [ ] :first-child

+ * [X] :first-child

-*** attribute selectors

+*** attribute selectors [0/7]

+(defclass nth-child-selector (simple-selector) ())

+

+(defmethod print-object ((selector universal-selector) stream)

+ (format stream "#<universal-selector>"))

- (#T(regexp$ "[ ]*[>][ ]*" ()) (list (make-instance 'child-combinator :matcher (parse-selector &rest))))

- (#T(regexp$ "[ ]+" ()) (list (make-instance 'descendant-combinator :matcher (parse-selector &rest))))

- ;; simple selector

- (#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+)" (?type)) (cons (make-instance 'type-selector :arg type) (parse-selector &rest)))

- (#T(regexp$ "\\*" ()) (cons (make-instance 'universal-selector) (parse-selector &rest)))))

+ (#T(regexp$ "[ ]*[>][ ]*" ())

+ (list (make-instance 'child-combinator :matcher (parse-selector &rest))))

+ (#T(regexp$ "[ ]+" ())

+ (list (make-instance 'descendant-combinator :matcher (parse-selector &rest))))

+ ;; simple selectors

+ (#T(regexp$ ":nth-child\\([ ]*([0-9]+)[ ]*\\)" (?n))

+ (cons (make-instance 'nth-child-selector :arg (parse-integer n)) (parse-selector &rest)))

+ (#T(regexp$ ":first-child" ())

+ (cons (make-instance 'nth-child-selector :arg 1) (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+)" (?type))

+ (cons (make-instance 'type-selector :arg type) (parse-selector &rest)))

+ (#T(regexp$ "\\*" ())

+ (cons (make-instance 'universal-selector) (parse-selector &rest)))))

+(defmethod element-matches-p (element (selector nth-child-selector))

+ (alexandria:when-let* ((parent (element-parent element))

+ (pos (position element (element-children parent) :test #'eq)))

+ (= (selector-arg selector) (1+ pos))))

+

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

+ ("div:first-child" . ?div)

+ ("i:nth-child(1)" . ?i))

+ "<div>I do <i>not</i> <i>like</i> cheese.</div><div><span>I like <i>cheese</i>.</span></div>")

+ (values div i))

+