Sun Jul 3 08:25:45 UTC 2011 pix@kepibu.org
* Add support for XMLS-style lists, conflicting with LHTML-style lists
hunk ./notes 54
+** 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!".
hunk ./notes 60
+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.
hunk ./oh-ducks.asd 35
- :components ((:file "lhtml")
+ :components (#-lists-are-xmls (:file "lhtml")
hunk ./oh-ducks.asd 42
- :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.
addfile ./traversal/xmls.lisp
hunk ./traversal/xmls.lisp 1
+;;; 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
hunk ./selectors.lisp 49
+(defclass attribute-starts-with-selector (attribute-selector) ())
hunk ./selectors.lisp 119
+ (#T(regexp$ ("[" $name "^=" $name "]") (?attribute ?value))
+ (cons (make-instance 'attribute-starts-with-selector :arg attribute :value value)
+ (parse-selector &rest)))
hunk ./selectors.lisp 287
+(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
hunk ./notes 170
+Submitted. Was it ever accepted? Man, I don't remember.
hunk ./notes 181
+** 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
hunk ./oh-ducks.asd 20
- :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
hunk ./notes 158
-*** attribute selectors [1/7]
+*** attribute selectors [2/7]
hunk ./notes 160
- * [ ] attribute-equal [att=val]
+ * [X] attribute-equal [att=val]
hunk ./selectors.lisp 45
-(defclass attribute-selector (simple-selector) ())
+(defclass attribute-selector (simple-selector)
+ ((val :reader attribute-value :initarg :value)))
hunk ./selectors.lisp 48
+(defclass attribute-equal-selector (attribute-selector) ())
hunk ./selectors.lisp 115
+ (#T(regexp$ ("[" $name "=" $name "]") (?attribute ?value))
+ (cons (make-instance 'attribute-equal-selector :arg attribute :value value)
+ (parse-selector &rest)))
hunk ./selectors.lisp 279
+(defmethod subject-p ((selector attribute-equal-selector) element)
+ (when-let* ((val (element-attribute (selector-arg selector) element)))
+ (string= val (attribute-value selector))))
+
hunk ./tests.lisp 160
+(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
hunk ./notes 158
-*** attribute selectors [0/7]
- * [ ] attribute-present [att]
+*** attribute selectors [1/7]
+ * [X] attribute-present [att]
hunk ./selectors.lisp 45
+(defclass attribute-selector (simple-selector) ())
+(defclass attribute-present-selector (attribute-selector) ())
+
hunk ./selectors.lisp 109
+ ;; attribute selectors
+ (#T(regexp$ ("[" $name "]") (?attribute))
+ (cons (make-instance 'attribute-present-selector :arg attribute)
+ (parse-selector &rest)))
hunk ./selectors.lisp 271
+(defmethod subject-p ((selector attribute-present-selector) element)
+ (element-attribute (selector-arg selector) element))
+
hunk ./tests.lisp 154
+(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
hunk ./tests.lisp 44
-(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))))
hunk ./tests.lisp 47
-(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)))))
hunk ./tests.lisp 62
-(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))))
hunk ./tests.lisp 66
-(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))))
hunk ./tests.lisp 74
-(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)))
hunk ./tests.lisp 95
-;; throws 'unification-failure
hunk ./tests.lisp 97
- "<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>")
hunk ./tests.lisp 100
-(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)))
hunk ./tests.lisp 108
-(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)))
hunk ./tests.lisp 120
-(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)))
hunk ./tests.lisp 129
-(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)))
hunk ./tests.lisp 138
-(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)))
hunk ./tests.lisp 146
-(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.
hunk ./tests.lisp 10
- "<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
hunk ./tests.lisp 2
+(named-readtables:in-readtable template-readtable)
hunk ./tests.lisp 6
-#.(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
hunk ./traversal/dom.lisp 26
- (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.
hunk ./notes 14
+ * named-readtables
hunk ./notes 35
+or
+: (unify:enable-template-reader)
+or
+: (named-readtables:in-readtable unify:template-readtable)
hunk ./notes 40
+(The latter two currently only work if you have cl-unification from my
+darcs repo.)
hunk ./notes 81
- "<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
hunk ./tests.lisp 26
- (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>")
hunk ./tests.lisp 32
- (match (#T(html (:model dom)
+ (match (#T(html (:model lhtml)
hunk ./tests.lisp 34
- "<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>")
hunk ./tests.lisp 38
- (match (#T(html (:model dom)
+ (match (#T(html (:model lhtml)
hunk ./tests.lisp 42
- "<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>")
hunk ./unify.lisp 40
- ((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
hunk ./notes 132
-** working lhtml/xmls support [1/2]
+** working lhtml/xmls support [2/2]
hunk ./notes 134
- * [ ] 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.
hunk ./traversal/lhtml.lisp 6
+(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))))
+
hunk ./traversal/lhtml.lisp 38
-;; FIXME: bleh... may not even be worth trying to support this
hunk ./traversal/lhtml.lisp 39
- (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
hunk ./traversal/dom.lisp 10
- &key &allow-other-keys)
+ &key)
hunk ./traversal/dom.lisp 13
-
Mon Jan 4 06:36:34 UTC 2010 pix@kepibu.org
* Don't count an+b|b|odd|even as separate items
hunk ./notes 137
-*** 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
hunk ./notes 142
- * [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
hunk ./notes 137
-*** positional selectors [18/19]
+*** positional selectors [19/19]
hunk ./notes 156
- * [ ] :empty
+ * [X] :empty
hunk ./selectors.lisp 43
+(defclass empty-selector (simple-selector) ())
hunk ./selectors.lisp 186
+ (#T(regexp$ (":empty") ())
+ (cons (make-instance 'empty-selector) (parse-selector &rest)))
hunk ./selectors.lisp 252
+(defmethod subject-p ((selector empty-selector) element)
+ (= 0 (length (element-children element))))
+
hunk ./tests.lisp 90
+(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
hunk ./notes 137
-*** positional selectors [9/19]
+*** positional selectors [18/19]
hunk ./notes 146
- * [ ] :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
hunk ./notes 155
- * [ ] :only-of-type
+ * [X] :only-of-type
hunk ./selectors.lisp 41
+(defclass nth-of-type-selector (nth-child-selector) ())
+(defclass nth-last-of-type-selector (nth-of-type-selector) ())
hunk ./selectors.lisp 118
+ (#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)))
hunk ./selectors.lisp 139
+ (#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)))
hunk ./selectors.lisp 156
+ (#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)))
hunk ./selectors.lisp 175
+ (#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)))
hunk ./selectors.lisp 234
+(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))))))
+
hunk ./tests.lisp 62
+(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))
+
hunk ./tests.lisp 69
- ("i:only-child" . ?i))
+ ("i:only-child" . ?i)
+ ("i:only-of-type" . ?i-type))
hunk ./tests.lisp 72
- (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.
hunk ./notes 137
-*** 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)
hunk ./notes 145
- * [ ] :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)
hunk ./notes 154
- * [ ] :only-child
+ * [X] :only-child
hunk ./regexp-template.lisp 34
- (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.")))
hunk ./regexp-template.lisp 46
-
hunk ./selectors.lisp 42
+(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)))))))
+
hunk ./selectors.lisp 66
+(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")))
+
hunk ./selectors.lisp 94
- (#T(regexp$ "[ ]*[~][ ]*" ())
+ (#T(regexp$ (\s* #\~ \s*) ())
hunk ./selectors.lisp 96
- (#T(regexp$ "[ ]*[+][ ]*" ())
+ (#T(regexp$ (\s* #\+ \s*) ())
hunk ./selectors.lisp 98
- (#T(regexp$ "[ ]*[>][ ]*" ())
+ (#T(regexp$ (\s* #\> \s*) ())
hunk ./selectors.lisp 100
- (#T(regexp$ "[ ]+" ())
+ (#T(regexp$ (\s+) ())
hunk ./selectors.lisp 104
- (#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))
hunk ./selectors.lisp 107
- :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)
hunk ./selectors.lisp 117
- (#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)))
hunk ./selectors.lisp 126
- (#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)
hunk ./selectors.lisp 134
- (#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))
hunk ./selectors.lisp 147
- (#T(regexp$ "[\\.](\\w+)" (?class))
+ (#T(regexp$ (#\. $name) (?class))
hunk ./selectors.lisp 149
- (#T(regexp$ "(\\w+)" (?type))
+ (#T(regexp$ ($name) (?type))
hunk ./selectors.lisp 151
- (#T(regexp$ "\\*" ())
+ (#T(regexp$ (#\*) ())
hunk ./selectors.lisp 156
-;; 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))
-
hunk ./selectors.lisp 163
- (when (subject-p element selector) (list element))
+ (when (subject-p selector element) (list element))
hunk ./selectors.lisp 174
+(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))))))))
+
hunk ./selectors.lisp 185
- (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)))))
hunk ./selectors.lisp 196
- (element-classes element)
- :test #'string=))
+ (element-classes element)
+ :test #'string=))
hunk ./tests.lisp 56
+(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)
(let ((p (search-forward term nil t)))
(when p
(goto-char p))))
(defun swap-args ()
(interactive)
(save-excursion
(while (seek-forward "defmethod subject-p (")
(forward-sexp)
(transpose-sexps 1)))
(save-excursion
(while (seek-forward "(subject-p")
(forward-sexp)
(transpose-sexps 1))))
hunk ./selectors.lisp 112
-(defgeneric subject-p (element selector))
+(defgeneric subject-p (selector element))
hunk ./selectors.lisp 114
-(defmethod subject-p (element (selector type-selector))
+(defmethod subject-p ((selector type-selector) element)
hunk ./selectors.lisp 117
-(defmethod subject-p (element (selector id-selector))
+(defmethod subject-p ((selector id-selector) element)
hunk ./selectors.lisp 120
-(defmethod subject-p (element (selector nth-child-selector))
+(defmethod subject-p ((selector nth-child-selector) element)
hunk ./selectors.lisp 137
-(defmethod subject-p (element (selector class-selector))
+(defmethod subject-p ((selector class-selector) element)
hunk ./selectors.lisp 142
-(defmethod subject-p (element (selector universal-selector))
+(defmethod subject-p ((selector universal-selector) element)
hunk ./selectors.lisp 146
-(defmethod subject-p (element (selector %implicit-element-selector))
+(defmethod subject-p ((selector %implicit-element-selector) element)
hunk ./selectors.lisp 149
-(defmethod subject-p (element (selector list))
- (every (curry #'subject-p element) selector))
+(defmethod subject-p ((selector list) element)
+ (every (rcurry #'subject-p element) selector))
hunk ./selectors.lisp 152
-(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)))
hunk ./selectors.lisp 155
-(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)))
hunk ./selectors.lisp 158
-(defmethod subject-p (element (selector adjacent-combinator))
+(defmethod subject-p ((selector adjacent-combinator) element)
hunk ./selectors.lisp 164
- (subject-p (elt siblings (1- ourpos)) (matcher selector)))))
+ (subject-p (matcher selector) (elt siblings (1- ourpos))))))
hunk ./selectors.lisp 166
-(defmethod subject-p (element (selector sibling-combinator))
+(defmethod subject-p ((selector sibling-combinator) element)
hunk ./selectors.lisp 172
- (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
replace ./notes [A-Za-z0-9+-] element-matches-p subject-p
replace ./selectors.lisp [A-Za-z0-9+-] element-matches-p subject-p
Mon Jan 4 01:03:10 UTC 2010 pix@kepibu.org
* Make subjects-of use subjects-in-list
hunk ./selectors.lisp 107
-(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
replace ./selectors.lisp [A-Za-z0-9+-] find-matching-elements subjects-of
replace ./selectors.lisp [A-Za-z0-9+-] find-matching-elements-in-list subjects-in-list
replace ./unify.lisp [A-Za-z0-9+-] find-matching-elements subjects-of
replace ./unify.lisp [A-Za-z0-9+-] find-matching-elements-in-list subjects-in-list
Sat Jan 2 09:45:37 UTC 2010 pix@kepibu.org
* Add fixme
hunk ./selectors.lisp 56
+;; 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
hunk ./templates.lisp 48
-(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)
hunk ./unify.lisp 5
- &key &allow-other-keys)
+ &key)
hunk ./unify.lisp 13
- &key &allow-other-keys)
+ &key)
hunk ./unify.lisp 58
- &key &allow-other-keys)
+ &key)
hunk ./unify.lisp 63
- &key &allow-other-keys)
+ &key)
hunk ./unify.lisp 68
- &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
hunk ./selectors.lisp 50
-(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
hunk ./notes 137
-*** positional selectors [3/12]
+*** positional selectors [3/13]
hunk ./notes 141
+ * [ ] :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.
hunk ./notes 22
- :(asdf:oos 'asdf:load-op :oh-ducks)
+: (asdf:oos 'asdf:load-op :oh-ducks)
hunk ./notes 26
- :(asdf:oos 'asdf:load-op :closure-html)
+: (asdf:oos 'asdf:load-op :closure-html)
hunk ./notes 28
- :(asdf:oos 'asdf:load-op :cxml)
+: (asdf:oos 'asdf:load-op :cxml)
hunk ./notes 33
- :#.(set-dispatch-macro-character #\# #\T 'unify::|sharp-T-reader|)
+: #.(set-dispatch-macro-character #\# #\T 'unify::|sharp-T-reader|)
hunk ./notes 46
- :depends-on (:oh-ducks :closure-html :cxml)
+: :depends-on (:oh-ducks :closure-html :cxml)
hunk ./notes 165
- #t(html ("div" (#t(regexp "f(o+)bar") . ?div)))
+: #t(html ("div" (#t(regexp "f(o+)bar") . ?div)))
hunk ./notes 168
- #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
hunk ./notes 29
-
hunk ./notes 38
+** 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)
+
hunk ./notes 80
-
-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
hunk ./cxml.lisp 4
- (export 'dom))
+ (export 'dom)
+ (export 'xml))
Sun Dec 13 05:32:46 UTC 2009 pix@kepibu.org
* Add some notes
hunk ./notes 18
-it does not generally become useful until you have also loading an
+it does not generally become useful until you have also loaded an
hunk ./notes 78
- #id => elements with id of "id".
+ #id => elements with id of "id"
hunk ./notes 83
+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?)
+
hunk ./notes 156
+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
hunk ./package.lisp 15
+ #:element-content
hunk ./traversal/dom.lisp 32
+(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)))
+
hunk ./traversal/interface.lisp 16
+(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))))
hunk ./traversal/lhtml.lisp 27
+(defmethod element-content ((element list))
+ (cddr element))
+
hunk ./traversal/pt.lisp 24
+(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
hunk ./unify.lisp 40
- ((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
hunk ./traversal/dom.lisp 7
-(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?).
hunk ./selectors.lisp 3
-(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*.")
hunk ./selectors.lisp 55
-(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))
hunk ./selectors.lisp 58
-(defmethod print-object ((selector %root-selector) stream)
+(defmethod print-object ((selector %implicit-element-selector) stream)
hunk ./selectors.lisp 65
- (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))))
hunk ./selectors.lisp 67
- (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))))
hunk ./selectors.lisp 69
- (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))))
hunk ./selectors.lisp 71
- (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))))
hunk ./selectors.lisp 106
+(defun find-matching-elements-in-list (selector element-list)
+ (reduce #'nconc
+ (mapcar (curry #'find-matching-elements selector)
+ element-list)))
+
hunk ./selectors.lisp 155
-(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*))
hunk ./selectors.lisp 182
+
+;; 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)))
hunk ./tests.lisp 82
-;; 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
hunk ./tests.lisp 85
- "<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>")
hunk ./tests.lisp 90
+(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))
+
hunk ./unify.lisp 21
- (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
hunk ./templates.lisp 56
+;; 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
hunk ./selectors.lisp 3
+(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*.")
+
hunk ./selectors.lisp 55
+(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)))
+
hunk ./selectors.lisp 65
- (list (make-instance 'sibling-combinator :matcher (parse-selector &rest))))
+ (list (make-instance 'sibling-combinator :matcher (or (parse-selector &rest) %root-selector))))
hunk ./selectors.lisp 67
- (list (make-instance 'adjacent-combinator :matcher (parse-selector &rest))))
+ (list (make-instance 'adjacent-combinator :matcher (or (parse-selector &rest) %root-selector))))
hunk ./selectors.lisp 69
- (list (make-instance 'child-combinator :matcher (parse-selector &rest))))
+ (list (make-instance 'child-combinator :matcher (or (parse-selector &rest) %root-selector))))
hunk ./selectors.lisp 71
- (list (make-instance 'descendant-combinator :matcher (parse-selector &rest))))
+ (list (make-instance 'descendant-combinator :matcher (or (parse-selector &rest) %root-selector))))
hunk ./selectors.lisp 150
+(defmethod element-matches-p (element (selector %root-selector))
+ (eq element *effective-root*))
+
hunk ./tests.lisp 72
+;; 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))
+
hunk ./unify.lisp 21
- (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
hunk ./selectors.lisp 138
+ (declare (ignore element selector))
hunk ./traversal/dom.lisp 4
+ (declare (ignore var pat env))
hunk ./traversal/pt.lisp 4
+ (declare (ignore var pat env))
Thu Dec 3 02:41:36 UTC 2009 pix@kepibu.org
* Better messages
hunk ./selectors.lisp 47
-(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.")
hunk ./unify.lisp 31
- (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
hunk ./selectors.lisp 54
- #+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))))
hunk ./selectors.lisp 148
-#+TODO
hunk ./selectors.lisp 149
- ...)
+ (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)))))
hunk ./selectors.lisp 156
-#+TODO
hunk ./selectors.lisp 157
- ...)
+ (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))))
hunk ./tests.lisp 62
+(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.
hunk ./cxml.lisp 16
- (list :model 'pt))
+ (list :model 'dom))
Mon Nov 30 05:04:24 UTC 2009 pix@kepibu.org
* Record idea
hunk ./selectors.lisp 89
+;; 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
hunk ./selectors.lisp 62
- (#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))
hunk ./selectors.lisp 66
- (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
hunk ./selectors.lisp 47
+(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.")
+
hunk ./selectors.lisp 61
- ;; 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)
hunk ./selectors.lisp 71
- (#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
hunk ./traversal/pt.lisp 9
- (remove-if (rcurry #'member '(:pcdata :comment) :test #'eq)
+ (remove-if (compose (rcurry #'member '(:pcdata :comment) :test #'eq) #'chtml:pt-name)
hunk ./traversal/pt.lisp 16
- (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
hunk ./notes 118
-*** positional selectors [2/12]
+*** positional selectors [3/12]
hunk ./notes 120
- * [ ] :nth-child(xn+y)
+ * [X] :nth-child(xn+y)
hunk ./selectors.lisp 37
+(defclass nth-last-child-selector (nth-child-selector) ())
hunk ./selectors.lisp 57
- (#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)))
hunk ./selectors.lisp 75
- (cons (make-instance 'nth-child-selector :arg 1) (parse-selector &rest)))
+ (cons (make-instance 'nth-child-selector :arg (cons 0 1)) (parse-selector &rest)))
hunk ./selectors.lisp 107
- (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
hunk ./traversal/dom.lisp 31
-(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
hunk ./notes 112
-* Known Bugs
-** Failure to match results in NIL, rather than a unification-failure
hunk ./tests.lisp 56
-#+FIXME ;; should throw 'unification-failure
+;; throws 'unification-failure
hunk ./unify.lisp 23
+ ((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
hunk ./tests.lisp 56
-#+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
hunk ./notes 113
-** Does not error on unknown CSS selectors
hunk ./selectors.lisp 67
- (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
hunk ./notes 2
+* 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
hunk ./notes 145
+** 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
hunk ./package.lisp 5
- #:rcurry))
+ #:rcurry
+ #:when-let*))
hunk ./selectors.lisp 88
- (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
hunk ./oh-ducks.asd 35
- :components ((:file "lhtml")
- (:file "pt")))))
+ :components ((:file "lhtml")
+ (:file "pt")))))
hunk ./oh-ducks.asd 42
- :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
hunk ./traversal/dom.lisp 3
+(defmethod unify::occurs-in-p ((var symbol) (pat dom:element) env)
+ nil)
+
hunk ./traversal/pt.lisp 3
+(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
hunk ./selectors.lisp 104
- (format t "cc:: el: ~s, s: ~s~%" (element-parent element) selector)
hunk ./unify.lisp 11
-(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
hunk ./traversal/dom.lisp 11
-(defmethod element-parent ((element dom:document))
- nil)
hunk ./traversal/dom.lisp 12
- (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
hunk ./notes 8
-*** positional selectors
- * [ ] :nth-child
+*** positional selectors [2/12]
+ * [X] :nth-child(n)
+ * [ ] :nth-child(xn+y)
hunk ./notes 12
- * [ ] :first-child
+ * [X] :first-child
hunk ./notes 21
-*** attribute selectors
+*** attribute selectors [0/7]
hunk ./selectors.lisp 36
+(defclass nth-child-selector (simple-selector) ())
+
+(defmethod print-object ((selector universal-selector) stream)
+ (format stream "#<universal-selector>"))
hunk ./selectors.lisp 51
- (#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)))))
hunk ./selectors.lisp 87
+(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))))
+
hunk ./tests.lisp 50
+(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))
+
Mon Nov 23 10:24:02 UTC 2009 pix@kepibu.org
* Status commit; fix unification
hunk ./tests.lisp 45
- ("i" . ?i);#t(list ?j ?i))
+ ("i" . #t(list ?j ?i))
hunk ./traversal/dom.lisp 10
+
hunk ./traversal/dom.lisp 15
-#+(or)
-(defmethod element-attribute (attribute (element dom:node))
- (declare (ignore attribute element))
- nil)
+
hunk ./traversal/dom.lisp 20
-#+(or)
-(defmethod element-type ((element dom:node))
- (declare (ignore element))
- nil)
+
hunk ./traversal/dom.lisp 25
-#+(or)
-(defmethod element-id ((element dom:node))
- (declare (ignore element))
- nil)
hunk ./traversal/lhtml.lisp 13
-#+FIXME
-(defmethod element-parent ((element list))
- (let ((parent (car *ancestors*)))
- (if (some (alexandria:curry #'eq element) (element-children parent))
- parent
- (error "unable to determine parent"))))
hunk ./traversal/lhtml.lisp 15
-#+FIXME
-(defmethod element-ancestors ((element list))
- *ancestors*)
+
hunk ./unify.lisp 28
- :do
- (let ((val (find-matching-elements css-specifier document)))
- (cond
- ;; FIXME: make possible to say things like ("div" . #t(list ?first-div &rest))
- #+(or)
- ((typep template 'css-selector-template)
- (format t "hey! ~s~%" template)
- (let ((menv (reduce #'merge-environments
- (mapcar (curry #'unify template)
- val))))
- (unify::fill-environment (unify::environment-variables menv)
- (unify::environment-values menv)
- env)))
- ((unify::template-p template)
- (let ((menv (reduce #'merge-environments
- (mapcar (curry #'unify template)
- val))))
- (unify::fill-environment (unify::environment-variables menv)
- (unify::environment-values menv)
- env))
- #+(or)
- (unify template val env)
- #+(or)
- (loop :for element :in val
- :do (unify template element env)))
- ((unify::variablep template)
- ;; *ahem* FIXME: this makes ("a" ("b" . ?b)) possible,
- ;; but will cause the wrong thing to happen for [_$_]
- ;; ("a" ("b" . ?b) ("#b" . ?b))
- ;(alexandria:if-let ((varval (find-variable-value template env)))
- ; (nconc varval val)
- (unify::var-unify template val env)
- #+(or)
- (unify::extend-environment template val env));)
- (t (error "whoops: ~s, ~s" css-specifier template)))))
+ :do (typecase template
+ ;; CSS selectors work backwards, not forwards
+ (css-selector-template
+ (unify template document env))
+ (t
+ (let ((val (find-matching-elements css-specifier document)))
+ (cond
+ ((unify::template-p template)
+ (unify template val env))
+ ((unify::variablep template)
+ (unify::var-unify template val env))
+ (t (error "Don't know what to do with ~s and ~s." css-specifier template)))))))
Sat Nov 21 18:31:09 UTC 2009 pix@kepibu.org
* Tired, probably doing stupid things
hunk ./tests.lisp 38
- ("div" ("i" . ?i)
- ("span" . ?span)))
+ ("div" (">i" . ?i)
+ ;("i" . #t(list ?j ?i))
+ ("span>i" . ?span)))
hunk ./tests.lisp 44
+(match (#T(html (:model dom)
+ ("i" . ?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))
+
hunk ./tests.lisp 51
-(match (#t(lhtml ("div::content" . #t(regexp+ "^f(o+)" (?o))))
+(match (#t(html ("div::content" . #t(regexp+ "^f(o+)" (?o))))
hunk ./unify.lisp 11
+(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)))
+
hunk ./unify.lisp 26
+ (declare (optimize debug))
hunk ./unify.lisp 29
- (setf
- env
hunk ./unify.lisp 30
- #+(or) (if (null val) (cerror "continue" "null!"))
- (format t "mel: ~s, css: ~s, tpl: ~s~%" val css-specifier template)
hunk ./unify.lisp 31
+ ;; FIXME: make possible to say things like ("div" . #t(list ?first-div &rest))
+ #+(or)
+ ((typep template 'css-selector-template)
+ (format t "hey! ~s~%" template)
+ (let ((menv (reduce #'merge-environments
+ (mapcar (curry #'unify template)
+ val))))
+ (unify::fill-environment (unify::environment-variables menv)
+ (unify::environment-values menv)
+ env)))
hunk ./unify.lisp 42
- #+(or) (format t "template-p~%")
+ (let ((menv (reduce #'merge-environments
+ (mapcar (curry #'unify template)
+ val))))
+ (unify::fill-environment (unify::environment-variables menv)
+ (unify::environment-values menv)
+ env))
+ #+(or)
hunk ./unify.lisp 50
- #+(or) ;; FIXME: in the case of multiple items in val, this will only return one.
+ #+(or)
hunk ./unify.lisp 52
- :do (setf env (unify template element env))
- :finally (return env)))
+ :do (unify template element env)))
hunk ./unify.lisp 54
- #+(or) (format t "variable-p~%")
- (unify::extend-environment template val env))
- (t (error "whoops: ~s, ~s" css-specifier template))))))
+ ;; *ahem* FIXME: this makes ("a" ("b" . ?b)) possible,
+ ;; but will cause the wrong thing to happen for [_$_]
+ ;; ("a" ("b" . ?b) ("#b" . ?b))
+ ;(alexandria:if-let ((varval (find-variable-value template env)))
+ ; (nconc varval val)
+ (unify::var-unify template val env)
+ #+(or)
+ (unify::extend-environment template val env));)
+ (t (error "whoops: ~s, ~s" css-specifier template)))))
Sat Nov 21 16:12:13 UTC 2009 pix@kepibu.org
* Status commit
hunk ./chtml.lisp 10
-(defclass lhtml-template (html-template) ())
-(defclass pt-template (html-template) ())
+(defclass html-template (css-selector-template) ())
hunk ./chtml.lisp 12
-(defmethod document-parser ((template lhtml-template))
- (lambda (document) (chtml:parse document (chtml:make-lhtml-builder))))
-(defmethod document-parser ((template pt-template))
- (lambda (document) (chtml:parse document (chtml:make-pt-builder))))
+(add-handler 'pt 'chtml:make-pt-builder)
+(add-handler 'lhtml 'chtml:make-lhtml-builder)
hunk ./chtml.lisp 15
-(defmethod make-template-for-parser ((parser (eql 'lhtml)) spec)
- (make-instance 'lhtml-template :spec spec))
-(defmethod make-template-for-parser ((parser (eql :lhtml)) spec)
- (make-template-for-parser 'lhtml spec))
+(unless *default-parser*
+ (setf *default-parser* (rcurry #'chtml:parse (get-handler-for-model 'pt))))
hunk ./chtml.lisp 18
-(defmethod make-template-for-parser ((parser (eql 'pt)) spec)
- (make-instance 'pt-template :spec spec))
-(defmethod make-template-for-parser ((parser (eql :pt)) spec)
- (make-template-for-parser 'pt spec))
-
-(unless *default-parser* (setf *default-parser* 'pt))
+(defmethod make-template ((kind (eql 'html)) (spec cons))
+ (destructuring-bind (&key parser model)
+ (append (when (%spec-includes-opts spec) (second spec))
+ (list :model 'pt))
+ (make-instance 'html-template
+ :parser (or parser (rcurry #'chtml:parse (get-handler-for-model model)))
+ :spec spec)))
hunk ./cxml.lisp 6
-(defclass dom-template (xml-template) ())
+(defclass xml-template (css-selector-template) ())
hunk ./cxml.lisp 8
-(defmethod document-parser ((template dom-template))
- (lambda (document) (cxml:parse document (cxml-dom:make-dom-builder))))
+(add-handler 'dom 'cxml-dom:make-dom-builder)
hunk ./cxml.lisp 10
-(defmethod make-template-for-parser ((parser (eql 'dom)) spec)
- (make-instance 'dom-template :spec spec))
-(defmethod make-template-for-parser ((parser (eql :dom)) spec)
- (make-template-for-parser 'dom spec))
+(unless *default-parser*
+ (setf *default-parser* (rcurry #'cxml:parse (get-handler-for-model 'dom))))
hunk ./cxml.lisp 13
-(unless *default-parser* (setf *default-parser* 'dom))
+(defmethod make-template ((kind (eql 'xml)) (spec cons))
+ (destructuring-bind (&key parser model)
+ (append (when (%spec-includes-opts spec) (second spec))
+ (list :model 'pt))
+ (make-instance 'xml-template
+ :parser (or parser (rcurry #'cxml:parse (get-handler-for-model model)))
+ :spec spec)))
hunk ./notes 3
-** working lhtml/xmls support
+** working lhtml/xmls support [1/2]
+ * [X] non-descendant cases (class, id, etc.)
+ * [ ] selectors involving descendants
hunk ./oh-ducks.asd 20
- ;; TODO: submit a patch for cl-unification to use
- ;; asdf-system-connections. Getting an unmodified version of
- ;; cl-unification to load the cl-ppcre stuff is a PITA.
hunk ./oh-ducks.asd 25
- :components
- ((:file "interface")))
+ :components ((:file "interface")))
hunk ./oh-ducks.asd 35
- :components (#+FIXME (:file "lhtml")
+ :components ((:file "lhtml")
hunk ./package.lisp 1
+(defpackage #:oh-ducks.functional
+ (:import-from #:alexandria . #1=(
+ #:compose
+ #:curry
+ #:rcurry))
+ (:export . #1#))
+
hunk ./package.lisp 9
- (:use #:cl)
+ (:use #:cl #:oh-ducks.functional)
hunk ./package.lisp 21
- (:use #:cl #:unify #:oh-ducks.traversal)
- (:import-from #:alexandria
- #:compose
- #:curry
- #:rcurry)
+ (:use #:cl #:unify #:oh-ducks.functional #:oh-ducks.traversal)
hunk ./selectors.lisp 25
- (format stream "#<combinator>"))
+ (format stream "#<~s ~s>" (class-name (class-of selector)) (matcher selector)))
hunk ./selectors.lisp 55
-(defgeneric find-matching-elements (selector elements))
-
-(defmethod find-matching-elements (selector (elements list))
- (nconc
- (remove-if-not (rcurry #'element-matches-p selector) elements)
- (reduce #'nconc
- (mapcar (compose (curry #'find-matching-elements selector) #'element-children)
- elements))))
-
-(defmethod find-matching-elements (selector (elements t))
- (find-matching-elements selector (list elements)))
+(defgeneric find-matching-elements (selector element)
+ (:method (selector (element t))
+ (flet ((find-in-list (elements)
+ (mapcar (curry #'find-matching-elements selector)
+ elements)))
+ (nconc
+ (when (element-matches-p element selector) (list element))
+ (reduce #'nconc
+ (find-in-list (element-children element)))))))
hunk ./selectors.lisp 85
+ (format t "cc:: el: ~s, s: ~s~%" (element-parent element) selector)
hunk ./templates.lisp 4
- ((parser :initarg :parser :initform nil) ;; subtype generally determines parser
+ ((parser :initarg :parser :initform nil) ;; subtype generally determines parser
hunk ./templates.lisp 8
-;; FIXME: split html-template and xml-template into the cxml/chtml stuff; then,
-;; split dom-template into dom-html-template and dom-xml-template.
-;; Actually, just ditch the subtypes entirely, and build new objects with
-;; a specified handler type.
-(defclass xml-template (css-selector-template) ()) ;; parses xml
-
-(defclass html-template (css-selector-template) ()) ;; parses html
-
+(defvar *model-handler-map* nil "A mapping between model types and handler functions.")
+(defun add-handler (model handler)
+ (push (cons model handler) *model-handler-map*))
+(defun get-handler-for-model (model)
+ (let ((handler (cdr (assoc model *model-handler-map*))))
+ (typecase handler
+ (null nil)
+ (function (funcall handler))
+ (symbol (funcall (symbol-function handler)))
+ (t handler))))
hunk ./templates.lisp 21
-(defgeneric document-parser (template)
- (:documentation "Returns a function which, given an unparsed document, parses that document into some sort of structure."))
-
-(defmethod document-parser ((template css-selector-template))
- (slot-value template 'parser))
-
-(defgeneric make-template-for-parser (parser spec)
- (:documentation "Returns a template of the appropriate type for a given parser.")
- (:method ((parser t) spec)
- (make-instance 'css-selector-template :parser parser :spec spec))
- (:method ((parser null) spec)
- (declare (ignore parser spec))
- (error "No parser specified.")))
-
hunk ./templates.lisp 24
-(defmethod make-template ((kind (eql 'html)) (spec cons))
- (destructuring-bind (&key parser)
- (if (%spec-includes-opts spec)
- (second spec)
- (list :parser *default-parser*))
- (make-template-for-parser parser spec)))
-
hunk ./tests.lisp 10
- (match (#T(html ("#id" . ?div))
+ (match (#T(html (:model lhtml) ("#id" . ?div))
hunk ./tests.lisp 18
- (match (#T(html (".fish" . ?divs)
+ (match (#T(html (:model lhtml)
+ (".fish" . ?divs)
hunk ./tests.lisp 31
- (match (#T(html ("div>i" . ?i))
+ (match (#T(html (:model dom)
+ ("div>i" . ?i))
hunk ./tests.lisp 37
- (match (#T(html ("div" ("> i" . ?i)
- ("span>i" . ?span)))
+ (match (#T(html (:model dom)
+ ("div" ("i" . ?i)
+ ("span" . ?span)))
hunk ./traversal/dom.lisp 3
+(defmethod oh-ducks::find-matching-elements (selector (element dom:document))
+ (oh-ducks::find-matching-elements selector (dom:document-element element)))
+
hunk ./traversal/dom.lisp 8
-(defmethod element-children ((element dom:node))
- (coerce (dom:child-nodes element) 'list))
-(defmethod element-parent ((element dom:node))
+(defmethod element-children ((element dom:element))
+ (remove-if-not #'dom:element-p (coerce (dom:child-nodes element) 'list)))
+(defmethod element-parent ((element dom:document))
+ nil)
+(defmethod element-parent ((element dom:element))
hunk ./traversal/dom.lisp 14
+#+(or)
hunk ./traversal/dom.lisp 22
+#+(or)
hunk ./traversal/dom.lisp 30
+#+(or)
hunk ./traversal/interface.lisp 9
- (:documentation "Returns a sequence of element's element-children."))
+ (:documentation "Returns a sequence of element's child tags."))
hunk ./traversal/interface.lisp 11
- (:documentation "Returns element's element-parent element."))
+ (:documentation "Returns element's parent element."))
hunk ./traversal/interface.lisp 15
- (:documentation "Returns the tag name (element-type) of element."))
+ (:documentation "Returns the tag name (type) of element."))
hunk ./traversal/lhtml.lisp 9
- (cddr element))
+ (remove-if-not (lambda (x) (and (listp x) (keywordp (car x))))
+ (cddr element)))
hunk ./traversal/lhtml.lisp 27
-(defmethod element-attribute ((element-attribute symbol) (element list))
- (cadr (assoc element-attribute (cadr element))))
-(defmethod element-attribute ((element-attribute string) (element list))
- (element-attribute (intern (string-upcase element-attribute) :keyword) element))
+(defmethod element-attribute ((attribute symbol) (element list))
+ (cadr (assoc attribute (cadr element))))
+(defmethod element-attribute ((attribute string) (element list))
+ (element-attribute (intern (string-upcase attribute) :keyword) element))
hunk ./traversal/pt.lisp 6
- (chtml:pt-children element))
+ (remove-if (rcurry #'member '(:pcdata :comment) :test #'eq)
+ (chtml:pt-children element)))
hunk ./unify.lisp 16
- (let ((val (find-matching-elements css-specifier document)))
+ (setf
+ env
+ (let ((val (find-matching-elements css-specifier document)))
+ #+(or) (if (null val) (cerror "continue" "null!"))
+ (format t "mel: ~s, css: ~s, tpl: ~s~%" val css-specifier template)
hunk ./unify.lisp 22
- ((unify::template-p template) (unify template val env))
- ((unify::variablep template) (unify::extend-environment template val env))
- (t (error "whoops: ~s, ~s" css-specifier template)))))
+ ((unify::template-p template)
+ #+(or) (format t "template-p~%")
+ (unify template val env)
+ #+(or) ;; FIXME: in the case of multiple items in val, this will only return one.
+ (loop :for element :in val
+ :do (setf env (unify template element env))
+ :finally (return env)))
+ ((unify::variablep template)
+ #+(or) (format t "variable-p~%")
+ (unify::extend-environment template val env))
+ (t (error "whoops: ~s, ~s" css-specifier template))))))
hunk ./unify.lisp 43
- (unify template (funcall (document-parser template) document) env))
+ (unify template (funcall (slot-value template 'parser) document) env))
hunk ./unify.lisp 48
- (unify template (funcall (document-parser template) document) env))
-
+ (unify template (funcall (slot-value template 'parser) document) env))
Fri Nov 20 13:09:18 UTC 2009 pix@kepibu.org
* Add fixme
hunk ./templates.lisp 8
+;; FIXME: split html-template and xml-template into the cxml/chtml stuff; then,
+;; split dom-template into dom-html-template and dom-xml-template.
+;; Actually, just ditch the subtypes entirely, and build new objects with
+;; a specified handler type.
Thu Nov 19 06:25:36 UTC 2009 pix@kepibu.org
* Moar CSS selectors, fewer explicit lambdas
hunk ./notes 6
-*** :nth-child
-*** :first-child
-*** :last-child
-*** universal selector (*)
+*** positional selectors
+ * [ ] :nth-child
+ * [ ] :nth-last-child
+ * [ ] :first-child
+ * [ ] :last-child
+ * [ ] :nth-of-type
+ * [ ] :nth-last-of-type
+ * [ ] :first-of-type
+ * [ ] :last-of-type
+ * [ ] :only-child
+ * [ ] :only-of-type
+ * [ ] :empty
+*** attribute selectors
+ * [ ] attribute-present [att]
+ * [ ] attribute-equal [att=val]
+ * [ ] attribute-member [att~=val]
+ * [ ] attribute-lang [att|=val]
+ * [ ] attribute-begins [att^=val]
+ * [ ] attribute-ends [att$=val]
+ * [ ] attribute-contains [att*=val]
+*** :not(...)
hunk ./notes 28
+** namespace support(?)
hunk ./oh-ducks.asd 23
- :depends-on (:cl-unification :cl-ppcre :split-sequence)
+ :depends-on (:cl-unification :cl-ppcre :split-sequence :alexandria)
hunk ./package.lisp 15
+ (:import-from #:alexandria
+ #:compose
+ #:curry
+ #:rcurry)
hunk ./selectors.lisp 32
-#+FIXME ; is this the right name?
hunk ./selectors.lisp 45
+ #+TODO (#T(regexp$ "[ ]*[~][ ]*" ()) (list (make-instance 'sibling-combinator :matcher (parse-selector &rest))))
+ #+TODO (#T(regexp$ "[ ]*[+][ ]*" ()) (list (make-instance 'adjacent-combinator :matcher (parse-selector &rest))))
hunk ./selectors.lisp 53
- #+TODO
hunk ./selectors.lisp 59
- (remove-if-not (lambda (el) (element-matches-p el selector)) elements)
+ (remove-if-not (rcurry #'element-matches-p selector) elements)
hunk ./selectors.lisp 61
- (remove-if #'null
- (mapcar (lambda (element) (find-matching-elements selector (element-children element)))
- elements)))))
+ (mapcar (compose (curry #'find-matching-elements selector) #'element-children)
+ elements))))
hunk ./selectors.lisp 80
+(defmethod element-matches-p (element (selector universal-selector))
+ t)
+
hunk ./selectors.lisp 84
- (every (lambda (s) (element-matches-p element s)) selector))
+ (every (curry #'element-matches-p element) selector))
hunk ./selectors.lisp 90
- (some (lambda (a) (element-matches-p a (matcher selector))) (element-ancestors element)))
+ (some (rcurry #'element-matches-p (matcher selector)) (element-ancestors element)))
+
+#+TODO
+(defmethod element-matches-p (element (selector adjacent-combinator))
+ ...)
+
+#+TODO
+(defmethod element-matches-p (element (selector sibling-combinator))
+ ...)
hunk ./templates.lisp 26
+ (declare (ignore parser spec))
Wed Nov 18 10:25:48 UTC 2009 pix@kepibu.org
* Try to set a sensible default for *default-parser*
hunk ./chtml.lisp 28
+(unless *default-parser* (setf *default-parser* 'pt))
+
hunk ./cxml.lisp 16
+(unless *default-parser* (setf *default-parser* 'dom))
+
Wed Nov 18 10:23:22 UTC 2009 pix@kepibu.org
* Add notes file
addfile ./notes
hunk ./notes 1
+#-*-mode: org;-*-
+* To Do
+** working lhtml/xmls support
+** write documentation
+** improve selector support
+*** :nth-child
+*** :first-child
+*** :last-child
+*** universal selector (*)
+*** any others?
Wed Nov 18 10:23:05 UTC 2009 pix@kepibu.org
* Status commit; split to avoid absolute dependency on cxml and closure-html
move ./unification-templates.lisp ./unify.lisp
addfile ./chtml.lisp
addfile ./cxml.lisp
addfile ./templates.lisp
hunk ./chtml.lisp 1
+(in-package #:oh-ducks)
+
+;; avoid conflicting with 'sgml:pt
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (import 'closure-html:pt))
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (export 'pt)
+ (export 'lhtml))
+
+(defclass lhtml-template (html-template) ())
+(defclass pt-template (html-template) ())
+
+(defmethod document-parser ((template lhtml-template))
+ (lambda (document) (chtml:parse document (chtml:make-lhtml-builder))))
+(defmethod document-parser ((template pt-template))
+ (lambda (document) (chtml:parse document (chtml:make-pt-builder))))
+
+(defmethod make-template-for-parser ((parser (eql 'lhtml)) spec)
+ (make-instance 'lhtml-template :spec spec))
+(defmethod make-template-for-parser ((parser (eql :lhtml)) spec)
+ (make-template-for-parser 'lhtml spec))
+
+(defmethod make-template-for-parser ((parser (eql 'pt)) spec)
+ (make-instance 'pt-template :spec spec))
+(defmethod make-template-for-parser ((parser (eql :pt)) spec)
+ (make-template-for-parser 'pt spec))
hunk ./cxml.lisp 1
+(in-package #:oh-ducks)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (export 'dom))
+
+(defclass dom-template (xml-template) ())
+
+(defmethod document-parser ((template dom-template))
+ (lambda (document) (cxml:parse document (cxml-dom:make-dom-builder))))
+
+(defmethod make-template-for-parser ((parser (eql 'dom)) spec)
+ (make-instance 'dom-template :spec spec))
+(defmethod make-template-for-parser ((parser (eql :dom)) spec)
+ (make-template-for-parser 'dom spec))
hunk ./oh-ducks.asd 1
+#+(or fixme todo)
+(cerror "Continue anyway."
+ "The author of \"Oh, ducks!\" tends to use #+FIXME and #+TODO to ~
+ mark things as being in-progress. At least one of these exists ~
+ in *features*, which may cause unusual behavior.")
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (asdf:operate 'asdf:load-op 'asdf-system-connections))
+
hunk ./oh-ducks.asd 14
-(asdf:defsystem oh-ducks
+(defsystem oh-ducks
hunk ./oh-ducks.asd 23
- :depends-on (:cl-unification :cl-ppcre :cxml :closure-html :split-sequence)
+ :depends-on (:cl-unification :cl-ppcre :split-sequence)
hunk ./oh-ducks.asd 25
- ;; FIXME: ordering
hunk ./oh-ducks.asd 27
- #+(or) (:file "tests")
- (:module traversal
+ (:module "traversal"
hunk ./oh-ducks.asd 29
- ((:file "interface")
- (:file "lhtml" :depends-on ("interface"))
- (:file "pt" :depends-on ("interface"))
- (:file "dom" :depends-on ("interface"))))
+ ((:file "interface")))
hunk ./oh-ducks.asd 31
- (:file "unification-templates")))
+ (:file "templates")
+ (:file "unify")
+ #+FIXME (:file "tests")))
+
+(defsystem-connection ducks+closure-html
+ :requires (:oh-ducks :closure-html)
+ :components ((:file "chtml")
+ (:module "traversal"
+ :components (#+FIXME (:file "lhtml")
+ (:file "pt")))))
+
+(defsystem-connection ducks+cxml
+ :requires (:oh-ducks :cxml)
+ :components ((:file "cxml")
+ (:module "traversal"
+ :components ((:file "dom")))))
hunk ./package.lisp 1
+(defpackage #:oh-ducks.traversal
+ (:use #:cl)
+ (:export #:element-children
+ #:element-parent
+ #:element-attribute
+ #:element-type
+
+ #:element-id
+ #:element-classes
+ #:element-type-equal
+ #:element-ancestors))
+
hunk ./package.lisp 14
- (:use #:cl #:unify)
- (:export #:lhtml))
+ (:use #:cl #:unify #:oh-ducks.traversal)
+ (:export ;; template machinery
+ #:*default-parser*
+ #:html
+ ))
hunk ./selectors.lisp 1
-#||
-Okay, here's how I figure selectors should work:
-* breadth-first traversal through the document
-* collect nodes (elements) which match the selector(s)
-
-Matching selectors:
-- The original plan was to start with the first selector in our
- list and work our way into the document.
-- Another plan might be to start with the last selector in our
- list and work our way up the document tree.
-- Yet another option would be to utilize the recursive structure
- of the document in our search, keeping track of which nodes
- match which selectors as we traverse into the document.
- Though, by that description, I'm not sure I'm clever enough to
- actually make it work.
-We have to work our way through the entire document structure
-anyway, which means starting from the outside and working our way
-in won't gain us any efficiency, as I had originally thought.
-
-For example, given a structure of
- (html
- (body
- (p ((class "foo")) "text")
- (p () (span ((class "bar")) "more text"))))
-and a selector of
- html p>span.bar
-we would walk the document tree asking first
- "Does this element have class 'bar'?"
-and only if that is true, continuing to ask
- "Is this a 'span' element?"
- "Is this element a child of a 'p' element?"
- "Is that 'p' element a descendant of an 'html' element?"
-
-I note, however, that a fully-reversed ordering should not be strictly
-necessary--we really only need reverse at the combinators. So we
-could also ask:
- "Is this a 'span' element?"
- "Is it of the 'bar' class?"
- "Is it a child of a 'p' element?"
- "Is that 'p' element a descendant of an 'html' element?"
-
-Hrm... how does ScrAPI do this? Or any of the other projects which
-offer element selection by CSS selector?
-||#
hunk ./selectors.lisp 52
- #+(or)
+ #+TODO
hunk ./templates.lisp 1
+(in-package #:oh-ducks)
+
+(defclass css-selector-template (unify::expression-template)
+ ((parser :initarg :parser :initform nil) ;; subtype generally determines parser
+ (specifiers :reader specifiers) ;; list of (specifier . variable) and (specifier . template)
+ ))
+
+(defclass xml-template (css-selector-template) ()) ;; parses xml
+
+(defclass html-template (css-selector-template) ()) ;; parses html
+
+
+(defvar *default-parser* nil "Determines the default parser when none is specified.")
+
+(defgeneric document-parser (template)
+ (:documentation "Returns a function which, given an unparsed document, parses that document into some sort of structure."))
+
+(defmethod document-parser ((template css-selector-template))
+ (slot-value template 'parser))
+
+(defgeneric make-template-for-parser (parser spec)
+ (:documentation "Returns a template of the appropriate type for a given parser.")
+ (:method ((parser t) spec)
+ (make-instance 'css-selector-template :parser parser :spec spec))
+ (:method ((parser null) spec)
+ (error "No parser specified.")))
+
+(defun %spec-includes-opts (spec)
+ (keywordp (first (second spec))))
+
+(defmethod make-template ((kind (eql 'html)) (spec cons))
+ (destructuring-bind (&key parser)
+ (if (%spec-includes-opts spec)
+ (second spec)
+ (list :parser *default-parser*))
+ (make-template-for-parser parser spec)))
+
+(defun combine-selectors (selector parent)
+ (let ((combinator (car (last selector))))
+ (cond
+ ((null parent)
+ selector)
+ ((combinator-p combinator)
+ (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
+ :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 (class-of template)
+ :spec (list* (first (template-spec template)) rest)
+ :css-specifiers rest
+ :parent selector))))))
+
+(defmethod initialize-instance :after ((template css-selector-template) &key css-specifiers parent &allow-other-keys)
+ (let* ((spec (template-spec template))
+ (specifiers-and-vars (or css-specifiers (if (%spec-includes-opts spec)
+ (cddr spec)
+ (rest spec)))))
+ (setf (slot-value template 'specifiers)
+ (parse-specifiers specifiers-and-vars template parent))))
hunk ./tests.lisp 5
+#.(set-dispatch-macro-character #\# #\T 'unify::|sharp-T-reader|)
+
+#+(or) (setq *default-parser* 'pt)
+
hunk ./traversal/dom.lisp 1
-(in-package #:oh-ducks)
+(in-package #:oh-ducks.traversal)
hunk ./traversal/dom.lisp 9
-(defmethod element-attribute (attribute (element dom:node)) nil)
+(defmethod element-attribute (attribute (element dom:node))
+ (declare (ignore attribute element))
+ nil)
hunk ./traversal/dom.lisp 16
-(defmethod element-type ((element dom:node)) nil)
+(defmethod element-type ((element dom:node))
+ (declare (ignore element))
+ nil)
hunk ./traversal/dom.lisp 24
+ (declare (ignore element))
hunk ./traversal/interface.lisp 4
-(in-package #:oh-ducks)
+(in-package #:oh-ducks.traversal)
hunk ./traversal/lhtml.lisp 4
-(in-package #:oh-ducks)
+(in-package #:oh-ducks.traversal)
hunk ./traversal/pt.lisp 1
-(in-package #:oh-ducks)
+(in-package #:oh-ducks.traversal)
hunk ./unify.lisp 2
-;; FIXME: rather than having separate
-;; #t(pt-html ...) [_$_]
-;; #t(lhtml ...)
-;; etc.
-;; syntaxes for every possible parser, have a single
-;; #t(html [(:parser parser-function)] ...)
-;; which uses the value of :parser to handle parsing. Or, if no
-;; parser is specified, requires an already-parsed document be passed
-;; in.
-
-(defvar *default-parser* 'pt "Determines the default parser when none is specified.")
-
-(defclass css-selector-template (unify::expression-template)
- ((parser :initarg :parser) ;; subtype generally determines parser
- (specifiers :reader specifiers) ;; list of (specifier . variable) and (specifier . template)
- ))
-
-(defclass xml-template (css-selector-template) ()) ;; parses using closure-xml
-
-(defclass dom-template (xml-template) ())
-
-(defclass html-template (css-selector-template) ()) ;; parses using closure-html
-
-(defclass lhtml-template (html-template) ())
-(defclass pt-template (html-template) ())
-
-(defgeneric document-parser (template)
- (:documentation "Returns a function which, given an unparsed document, parses that document into some sort of structure.")
- (:method ((template css-selector-template))
- (slot-value template 'parser))
- (:method ((template dom-template))
- (lambda (document) (cxml:parse document (cxml-dom:make-dom-builder))))
- (:method ((template lhtml-template))
- (lambda (document) (chtml:parse document (chtml:make-lhtml-builder))))
- (:method ((template pt-template))
- (lambda (document) (chtml:parse document (chtml:make-pt-builder)))))
-
-(defun %spec-includes-opts (spec)
- (keywordp (first (second spec))))
-
-(defmethod make-template ((kind (eql 'html)) (spec cons))
- (destructuring-bind (&key parser)
- (if (%spec-includes-opts spec)
- (second spec)
- (list :parser *default-parser*))
- (case parser
- ;; short names
- ((lhtml :lhtml) (make-instance 'lhtml-template :spec spec))
- ((pt :pt) (make-instance 'pt-template :spec spec))
- ((dom :dom) (make-instance 'dom-template :spec spec))
- ;; user-specified
- (t (make-instance 'css-selector-template :parser parser :spec spec)))))
-
-(defmethod initialize-instance :after ((template css-selector-template) &key css-specifiers parent &allow-other-keys)
- (let* ((spec (template-spec template))
- (specifiers-and-vars (or css-specifiers (if (%spec-includes-opts spec)
- (cddr spec)
- (rest spec)))))
- (setf (slot-value template 'specifiers)
- (parse-specifiers specifiers-and-vars template parent))))
-
-(defun combine-selectors (selector parent)
- (let ((combinator (car (last selector))))
- (cond
- ((null parent)
- selector)
- ((combinator-p combinator)
- (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
- :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 (class-of template)
- :spec (list* (first (template-spec template)) rest)
- :css-specifiers rest
- :parent selector))))))
Wed Nov 18 08:57:44 UTC 2009 pix@kepibu.org
* status commit; add cxml:dom support
addfile ./traversal/dom.lisp
hunk ./oh-ducks.asd 24
- (:file "pt" :depends-on ("interface"))))
+ (:file "pt" :depends-on ("interface"))
+ (:file "dom" :depends-on ("interface"))))
hunk ./traversal/dom.lisp 1
+(in-package #:oh-ducks)
+
+;;; general accessors
+
+(defmethod element-children ((element dom:node))
+ (coerce (dom:child-nodes element) 'list))
+(defmethod element-parent ((element dom:node))
+ (dom:parent-node element))
+(defmethod element-attribute (attribute (element dom:node)) nil)
+(defmethod element-attribute ((attribute symbol) (element dom:element))
+ (element-attribute (string-downcase (symbol-name attribute)) element))
+(defmethod element-attribute ((attribute string) (element dom:element))
+ (dom:get-attribute element attribute))
+(defmethod element-type ((element dom:node)) nil)
+(defmethod element-type ((element dom:element))
+ (dom:tag-name element))
+
+;;; special accessors in case something special needs to happen
+(defmethod element-id ((element dom:node))
+ nil)
+(defmethod element-id ((element dom:element))
+ (element-attribute "id" element))
+
+(defmethod element-classes (element)
+ (split-sequence:split-sequence #\Space (element-attribute "class" element) :remove-empty-subseqs t))
hunk ./traversal/interface.lisp 12
-(defgeneric element-attribute (element-attribute element)
- (:documentation "Returns the value of the element-attribute of element, or nil if no such element-attribute exists."))
+(defgeneric element-attribute (attribute element)
+ (:documentation "Returns the value of the attribute of element, or nil if no such attribute exists."))
hunk ./traversal/interface.lisp 20
- (:documentation "Equivalent in spirit to (element-attribute :element-id element).")
+ (:documentation "Equivalent in spirit to (element-attribute :id element).")
hunk ./traversal/interface.lisp 24
- (:documentation "Equivalent in spirit to (element-attribute :class element), except it returns a sequence of individual element-classes.")
+ (:documentation "Equivalent in spirit to (element-attribute :class element), except it returns a sequence of individual classes.")
hunk ./traversal/interface.lisp 29
- (:documentation "Equivalent in spirit to (string-equal (element-type element) element-type), but not obligated to work under the assumption of string-designators.")
+ (:documentation "Equivalent in spirit to (string-equal (element-type element) type), but not obligated to work under the assumption of string-designators.")
hunk ./unification-templates.lisp 12
+(defvar *default-parser* 'pt "Determines the default parser when none is specified.")
+
hunk ./unification-templates.lisp 15
- (#+(or)
- (parser :reader parser) ;; subtype determines parser
- (handler :reader handler) ;; cxml/closure-html handler
+ ((parser :initarg :parser) ;; subtype generally determines parser
hunk ./unification-templates.lisp 21
+(defclass dom-template (xml-template) ())
+
hunk ./unification-templates.lisp 28
-(defmethod make-template ((kind (eql 'lhtml)) (spec cons))
- (make-instance 'lhtml-template :spec spec))
+(defgeneric document-parser (template)
+ (:documentation "Returns a function which, given an unparsed document, parses that document into some sort of structure.")
+ (:method ((template css-selector-template))
+ (slot-value template 'parser))
+ (:method ((template dom-template))
+ (lambda (document) (cxml:parse document (cxml-dom:make-dom-builder))))
+ (:method ((template lhtml-template))
+ (lambda (document) (chtml:parse document (chtml:make-lhtml-builder))))
+ (:method ((template pt-template))
+ (lambda (document) (chtml:parse document (chtml:make-pt-builder)))))
+
+(defun %spec-includes-opts (spec)
+ (keywordp (first (second spec))))
hunk ./unification-templates.lisp 43
- (make-instance 'pt-template :spec spec))
+ (destructuring-bind (&key parser)
+ (if (%spec-includes-opts spec)
+ (second spec)
+ (list :parser *default-parser*))
+ (case parser
+ ;; short names
+ ((lhtml :lhtml) (make-instance 'lhtml-template :spec spec))
+ ((pt :pt) (make-instance 'pt-template :spec spec))
+ ((dom :dom) (make-instance 'dom-template :spec spec))
+ ;; user-specified
+ (t (make-instance 'css-selector-template :parser parser :spec spec)))))
hunk ./unification-templates.lisp 56
- (let ((specifiers-and-vars (or css-specifiers (rest (template-spec template)))))
+ (let* ((spec (template-spec template))
+ (specifiers-and-vars (or css-specifiers (if (%spec-includes-opts spec)
+ (cddr spec)
+ (rest spec)))))
hunk ./unification-templates.lisp 90
+ (declare (ignore env))
hunk ./unification-templates.lisp 107
-(defmethod unify ((template lhtml-template) (document string)
+(defmethod unify (document (template css-selector-template)
hunk ./unification-templates.lisp 110
- (unify template (chtml:parse document (chtml:make-lhtml-builder)) env))
+ (unify template document env))
hunk ./unification-templates.lisp 112
-(defmethod unify ((template pt-template) (document string)
+(defmethod unify ((template css-selector-template) (document string)
hunk ./unification-templates.lisp 115
- (unify template (chtml:parse document (chtml:make-pt-builder)) env))
+ (unify template (funcall (document-parser template) document) env))
+
+(defmethod unify ((template css-selector-template) (document pathname)
+ &optional (env (make-empty-environment))
+ &key &allow-other-keys)
+ (unify template (funcall (document-parser template) document) env))
+
Wed Nov 18 07:35:08 UTC 2009 pix@kepibu.org
* Forgot to rename the .asd file
move ./css-selector-unifier.asd ./oh-ducks.asd
Wed Nov 18 07:21:49 UTC 2009 pix@kepibu.org
* The library finally has a name!
replace ./css-selector-unifier.asd [A-Za-z0-9-] css-selector-unifier oh-ducks
replace ./package.lisp [A-Za-z0-9-] css-selector-unifier oh-ducks
replace ./regexp-template.lisp [A-Za-z0-9-] css-selector-unifier oh-ducks
replace ./selectors.lisp [A-Za-z0-9-] css-selector-unifier oh-ducks
replace ./tests.lisp [A-Za-z0-9-] css-selector-unifier oh-ducks
replace ./traversal/interface.lisp [A-Za-z0-9-] css-selector-unifier oh-ducks
replace ./traversal/lhtml.lisp [A-Za-z0-9-] css-selector-unifier oh-ducks
replace ./traversal/pt.lisp [A-Za-z0-9-] css-selector-unifier oh-ducks
replace ./unification-templates.lisp [A-Za-z0-9-] css-selector-unifier oh-ducks
Mon Nov 16 09:02:50 UTC 2009 pix@kepibu.org
* Status commit
hunk ./regexp-template.lisp 32
- (format t "rex: ~s, ~s~%"
- (concatenate 'string "^(.*?)" regexp "$")
- (append '(?&rest) vars))
hunk ./selectors.lisp 76
+#+FIXME ; is this the right name?
+(defclass universal-selector (simple-selector) ())
hunk ./selectors.lisp 87
-;; forwards
-#+(or)
hunk ./selectors.lisp 90
- (#T(regexp+ "^[ ]*[>][ ]*" ()) (list (make-instance 'child-combinator :matcher (parse-selector &rest))))
- (#T(regexp+ "^[ ]+" ()) (list (make-instance 'descendant-combinator :matcher (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))))
hunk ./selectors.lisp 93
- (#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)))))
-
-;; backwards
-;; 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$ "[ ]*[>][ ]*" ()) (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+)" (?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
-;; trouble. I'm not sure how to handle combinators now. (Not that I
-;; was doing very well with them before.)
-;;
-;; Should probably map this out on a whiteboard. I'm not doing very
-;; well with just trying to hack it.
+ (#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)))
+ #+(or)
+ (#T(regexp$ "\\*" ()) (cons (make-instance 'universal-selector) (parse-selector &rest)))))
hunk ./selectors.lisp 101
-(defmethod find-matching-elements ((selectors list) element)
- (call-next-method)
- #+(or)
- (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))
-
hunk ./selectors.lisp 102
- (format t "in fme: ~s~%" elements)
- (prog1
hunk ./selectors.lisp 107
- elements))))
- (format t "lv fme~%")))
+ elements)))))
hunk ./selectors.lisp 112
-;; 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)))
-||#
-
hunk ./selectors.lisp 114
-(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)))
-
hunk ./selectors.lisp 118
- ;(cerror "hrm" element)
- (format t "id: ~s~%" (element-id element))
hunk ./selectors.lisp 125
-#+(or)
-(defmethod element-matches-p (element (selector child-combinator))
- (plusp (length (find-matching-elements selector (element-children element)))))
-
-#+TODO
-(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)))
- (format t "el: ~s~%" elements)
- (case (selector-arg selector)
- (:direct (loop :for element :in elements
- :when (all-match element)
- :collect element))
- (t (css-collect-elements selector elements))))))
-
hunk ./tests.lisp 31
- (match (#T(html ("div" ("> i" . ?i)))
+ (match (#T(html ("div" ("> i" . ?i)
+ ("span>i" . ?span)))
hunk ./tests.lisp 34
- i))
+ (values i span)))
hunk ./traversal/lhtml.lisp 12
+#+FIXME
hunk ./traversal/lhtml.lisp 18
+(defmethod element-parent ((element list))
+ (error "cannot get parent"))
+#+FIXME
hunk ./traversal/lhtml.lisp 23
+(defmethod element-ancestors ((element list))
+ (error "cannot get ancestors"))
hunk ./unification-templates.lisp 2
+;; FIXME: rather than having separate
+;; #t(pt-html ...) [_$_]
+;; #t(lhtml ...)
+;; etc.
+;; syntaxes for every possible parser, have a single
+;; #t(html [(:parser parser-function)] ...)
+;; which uses the value of :parser to handle parsing. Or, if no
+;; parser is specified, requires an already-parsed document be passed
+;; in.
hunk ./unification-templates.lisp 17
- #+(or)
- (parent :reader parent-template :initarg :parent :initform nil)
hunk ./unification-templates.lisp 19
-(defmethod parent-template ((template t)) nil)
-
hunk ./unification-templates.lisp 32
-(defmethod initialize-instance :after ((template lhtml-template) &key css-specifiers &allow-other-keys)
- (let ((specifiers-and-vars (or css-specifiers (rest (template-spec template)))))
- (setf (slot-value template 'specifiers)
- (parse-specifiers specifiers-and-vars 'lhtml-template))))
-
-(defmethod initialize-instance :after ((template pt-template) &key css-specifiers parent &allow-other-keys)
+(defmethod initialize-instance :after ((template css-selector-template) &key css-specifiers parent &allow-other-keys)
hunk ./unification-templates.lisp 38
- (format t "sss: ~s~%" selector)
hunk ./unification-templates.lisp 43
- (format t "ok!~%")
hunk ./unification-templates.lisp 55
- ((consp rest) (make-instance (class-of template) :css-specifiers rest :parent selector))))))
+ ((consp rest)
+ (make-instance (class-of template)
+ :spec (list* (first (template-spec template)) rest)
+ :css-specifiers rest
+ :parent selector))))))
hunk ./unification-templates.lisp 71
- (format t "ts: ~s~%" (template-spec template))
hunk ./unification-templates.lisp 73
- (format t "spec: ~s, tpl: ~s~%" css-specifier template)
hunk ./unification-templates.lisp 74
- (format t "val: ~s~%" val)
Mon Nov 16 08:14:42 UTC 2009 pix@kepibu.org
* Status commit
hunk ./regexp-template.lisp 32
+ (format t "rex: ~s, ~s~%"
+ (concatenate 'string "^(.*?)" regexp "$")
+ (append '(?&rest) vars))
hunk ./regexp-template.lisp 37
- (concatenate 'string "^(.*)" regexp "$")
+ (concatenate 'string "^(.*?)" regexp "$")
hunk ./selectors.lisp 56
-(defclass simple-selector (simple-selector)
+(defclass simple-selector (selector)
hunk ./selectors.lisp 63
+
+(defgeneric combinator-p (object)
+ (:method ((ob combinator)) t)
+ (:method ((ob t)) nil))
+
+(defmethod print-object ((selector combinator) stream)
+ (format stream "#<combinator>"))
+
hunk ./selectors.lisp 80
-(defmethod initialize-instance :after ((template selector) &key)
+(defmethod initialize-instance :after ((template combinator) &key)
hunk ./selectors.lisp 86
+#+(or)
hunk ./selectors.lisp 98
-#+(or)
+;; FIXME: somehow, selector is ending up as "NIL"
hunk ./selectors.lisp 100
+ (when (string= "NIL" selector) (error "selector is nil"))
+ (format t "selector: ~s~%" selector)
+ (macrolet ((prest (x) `(format t "rest~s: ~S~%" ,x &rest)))
hunk ./selectors.lisp 105
- (#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))))
hunk ./selectors.lisp 108
- (#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))))))
hunk ./selectors.lisp 122
-(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)))
+(defmethod find-matching-elements ((selectors list) element)
+ (call-next-method)
hunk ./selectors.lisp 125
- (loop :for element :in elements
- :when (element-matches-p selector element)
- :collect element))
+ (prog1
+ (when (element-matches-p selectors element)
+ (when (every (alexandria:rcurry #'find-matching-elements element) selectors)
+ element)
+ (format t "lv fme~%"))))
hunk ./selectors.lisp 131
-#+(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))
- #+(or)
- (loop :for element :in elements
- :when (every (lambda (s) (element-matches-p m element)) selector)
- :collect element))
+(defmethod find-matching-elements ((selector selector) (elements list))
+ (call-next-method))
hunk ./selectors.lisp 134
-(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))
- )
+(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~%")))
hunk ./selectors.lisp 145
-(defvar *ancestor*)
+(defmethod find-matching-elements (selector (elements t))
+ (find-matching-elements selector (list elements)))
hunk ./selectors.lisp 148
+;; 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)))
+||#
hunk ./selectors.lisp 162
-(defgeneric element-matches-p (selector element))
+(defgeneric element-matches-p (element selector))
hunk ./selectors.lisp 164
-(defmethod element-matches-p ((selector selector) (element t))
+(defmethod element-matches-p ((element t) (selector selector))
+ (error "ar?")
hunk ./selectors.lisp 167
+(defmethod element-matches-p :around ((element string) (selector selector))
+ (call-next-method))
hunk ./selectors.lisp 170
-(defmethod element-matches-p ((selector type-selector) element)
+(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 (element (selector type-selector))
hunk ./selectors.lisp 184
-(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))
hunk ./selectors.lisp 189
-(defmethod element-matches-p ((selector class-selector) element)
+(defmethod element-matches-p (element (selector class-selector))
hunk ./selectors.lisp 194
-(defmethod element-matches-p ((selector child-combinator) element)
+#+(or)
+(defmethod element-matches-p (element (selector child-combinator))
hunk ./selectors.lisp 199
-(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))))
hunk ./selectors.lisp 210
+
+(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)))
hunk ./tests.lisp 2
+;; FIXME: the switch to chtml:pt nodes means our #'equalp no longer
+;; works.
hunk ./tests.lisp 6
- (match (#T(lhtml ("#id" . ?div))
+ (match (#T(html ("#id" . ?div))
hunk ./tests.lisp 14
- (match (#T(lhtml (".fish" . ?divs)
- (".pig" . ?pig))
+ (match (#T(html (".fish" . ?divs)
+ (".pig" . ?pig))
hunk ./tests.lisp 21
- (match (#T(lhtml ("div" ("i" . ?i)))
+ (match (#T(html ("div" ("i" . ?i)))
hunk ./tests.lisp 26
- (match (#T(lhtml ("div>i" . ?i))
+ (match (#T(html ("div>i" . ?i))
hunk ./tests.lisp 30
-;; 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.
hunk ./tests.lisp 31
- (match (#T(lhtml ("div" ("> i" . ?i)))
+ (match (#T(html ("div" ("> i" . ?i)))
hunk ./traversal/interface.lisp 21
- (:method (element) (element-attribute :element-id element)))
+ (:method (element) (element-attribute :id element)))
hunk ./traversal/interface.lisp 31
+
+(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))))))
hunk ./traversal/lhtml.lisp 11
+;; FIXME: bleh... may not even be worth trying to support this
hunk ./traversal/lhtml.lisp 13
- ;; 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*)
hunk ./traversal/pt.lisp 12
- (getf (chtml:pt-attrs element) element-attribute))
+ (unless (eq :pcdata (chtml:pt-name element))
+ (getf (chtml:pt-attrs element) element-attribute)))
hunk ./unification-templates.lisp 8
+ #+(or)
+ (parent :reader parent-template :initarg :parent :initform nil)
hunk ./unification-templates.lisp 12
+(defmethod parent-template ((template t)) nil)
+
hunk ./unification-templates.lisp 32
-(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)
hunk ./unification-templates.lisp 52
- :collect (cons (make-instance 'css-specifier :spec css-specifier)
+ :for selector = (combine-selectors (parse-selector css-specifier) parent)
+ :collect (cons selector
hunk ./unification-templates.lisp 57
- ((consp rest) (make-instance template-kind :css-specifiers rest))))))
+ ((consp rest) (make-instance (class-of template) :css-specifiers rest :parent selector))))))
hunk ./unification-templates.lisp 73
- (let ((val (css-select css-specifier document)))
+ (let ((val (find-matching-elements css-specifier document)))
hunk ./unification-templates.lisp 85
+
+(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))
Sun Nov 15 14:25:29 UTC 2009 pix@kepibu.org
* Status commit
Move the CSS-selector-specific stuff into its own file.
Still don't have it working, of course. Bleh.
hunk ./css-selector-unifier.asd 25
+ (:file "selectors")
hunk ./regexp-template.lisp 16
+;; for parsing front-to-back
+(defmethod make-template ((kind (eql 'regexp^)) (spec cons))
+ (destructuring-bind (re-kwd regexp &optional vars &rest keys)
+ spec
+ (declare (ignore re-kwd))
+ (make-instance 'unify::regular-expression-template
+ :spec (list* 'unify::regexp
+ (concatenate 'string "^" regexp "(.*)$")
+ (append vars '(?&rest))
+ keys))))
+
+;; For parsing back-to-front
+(defmethod make-template ((kind (eql 'regexp$)) (spec cons))
+ (destructuring-bind (re-kwd regexp &optional vars &rest keys)
+ spec
+ (declare (ignore re-kwd))
+ (make-instance 'unify::regular-expression-template
+ :spec (list* 'unify::regexp
+ (concatenate 'string "^(.*)" regexp "$")
+ (append '(?&rest) vars)
+ keys))))
+
+
addfile ./selectors.lisp
hunk ./selectors.lisp 1
+#||
+Okay, here's how I figure selectors should work:
+* breadth-first traversal through the document
+* collect nodes (elements) which match the selector(s)
+
+Matching selectors:
+- The original plan was to start with the first selector in our
+ list and work our way into the document.
+- Another plan might be to start with the last selector in our
+ list and work our way up the document tree.
+- Yet another option would be to utilize the recursive structure
+ of the document in our search, keeping track of which nodes
+ match which selectors as we traverse into the document.
+ Though, by that description, I'm not sure I'm clever enough to
+ actually make it work.
+We have to work our way through the entire document structure
+anyway, which means starting from the outside and working our way
+in won't gain us any efficiency, as I had originally thought.
+
+For example, given a structure of
+ (html
+ (body
+ (p ((class "foo")) "text")
+ (p () (span ((class "bar")) "more text"))))
+and a selector of
+ html p>span.bar
+we would walk the document tree asking first
+ "Does this element have class 'bar'?"
+and only if that is true, continuing to ask
+ "Is this a 'span' element?"
+ "Is this element a child of a 'p' element?"
+ "Is that 'p' element a descendant of an 'html' element?"
+
+I note, however, that a fully-reversed ordering should not be strictly
+necessary--we really only need reverse at the combinators. So we
+could also ask:
+ "Is this a 'span' element?"
+ "Is it of the 'bar' class?"
+ "Is it a child of a 'p' element?"
+ "Is that 'p' element a descendant of an 'html' element?"
+
+Hrm... how does ScrAPI do this? Or any of the other projects which
+offer element selection by CSS selector?
+||#
+(in-package #:css-selector-unifier)
+
+#.(set-dispatch-macro-character #\# #\T 'unify::|sharp-T-reader|)
+
+(defclass selector (unify::string-template)
+ ((matcher :reader matcher :initarg :matcher)))
+
+(defgeneric selector-p (object)
+ (:method ((ob selector)) t)
+ (:method ((ob t)) nil))
+
+(defclass simple-selector (simple-selector)
+ ((arg :reader selector-arg :initarg :arg)))
+
+(defmethod print-object ((selector simple-selector) stream)
+ (format stream "#<selector ~s>" (selector-arg selector)))
+
+(defclass combinator (selector) ())
+(defclass child-combinator (combinator) ())
+(defclass descendant-combinator (combinator) ())
+(defclass adjacent-combinator (combinator) ())
+(defclass sibling-combinator (combinator) ())
+
+(defclass type-selector (simple-selector) ())
+(defclass id-selector (simple-selector) ())
+(defclass class-selector (simple-selector) ())
+
+(defmethod initialize-instance :after ((template selector) &key)
+ (unless (slot-boundp template 'matcher)
+ (let ((selector (template-spec template)))
+ (setf (slot-value template 'matcher) (parse-selector (string-trim " " selector))))))
+
+;; forwards
+(defun parse-selector (selector)
+ (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))))
+ ;; 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)))))
+
+;; backwards
+#+(or)
+(defun parse-selector (selector)
+ (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))))
+ ;; 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)))))
+
+
+;; FIXME: the find/matches split seems to be causing me some mental
+;; trouble. I'm not sure how to handle combinators now. (Not that I
+;; was doing very well with them before.)
+;;
+;; Should probably map this out on a whiteboard. I'm not doing very
+;; well with just trying to hack it.
+
+(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))
+ #+(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*)
+
+
+(defgeneric element-matches-p (selector element))
+
+(defmethod element-matches-p ((selector selector) (element t))
+ nil)
+
+(defmethod element-matches-p ((selector type-selector) element)
+ (element-type-equal element (selector-arg selector)))
+
+(defmethod element-matches-p ((selector id-selector) element)
+ (string= (element-id element) (selector-arg selector)))
+
+(defmethod element-matches-p ((selector class-selector) element)
+ (member (selector-arg selector)
+ (element-classes element)
+ :test #'string=))
+
+(defmethod element-matches-p ((selector child-combinator) element)
+ (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))))
+ #+nil
+ (when (all-match element) element)
+ (let ((elements (cddr element)))
+ (format t "el: ~s~%" elements)
+ (case (selector-arg selector)
+ (:direct (loop :for element :in elements
+ :when (all-match element)
+ :collect element))
+ (t (css-collect-elements selector elements))))))
hunk ./unification-templates.lisp 3
-#.(set-dispatch-macro-character #\# #\T 'unify::|sharp-T-reader|)
-
hunk ./unification-templates.lisp 62
-
-[_^L_][_$_]
-
-;; FIXME: rename to selector
-(defclass css-specifier (unify::string-template)
- ((matcher :reader matcher :initarg :matcher)))
-
-(defgeneric specifier-p (object)
- (:method ((ob css-specifier)) t)
- (:method ((ob t)) nil))
-
-;; FIXME: rename to simple-selector
-(defclass css-selector (unify::template)
- ((arg :reader selector-arg :initarg :arg)))
-
-#|| TODO
- (defclass combinator (selector) ())
- (defclass child-combinator (combinator) ())
- (defclass descendant-combinator (combinator) ())
- (defclass adjacent-combinator (combinator) ())
- (defclass sibling-combinator (combinator) ())
-||#
-
-(defmethod print-object ((selector css-selector) stream)
- (format stream "#<selector ~s>" (selector-arg selector)))
-
-(defclass css-type-selector (css-selector) ())
-(defclass css-id-selector (css-selector) ())
-(defclass css-class-selector (css-selector) ())
-
-(defclass css-descendant-selector (css-specifier css-selector) ())
-
-(defmethod initialize-instance :after ((template css-specifier) &key)
- (unless (slot-boundp template 'matcher)
- (let ((specifier (template-spec template)))
- (setf (slot-value template 'matcher) (parse-css-specifier (string-trim " " specifier))))))
-
-(defun parse-css-specifier (specifier)
- (match-case (specifier)
- ;; combinators
- (#T(regexp+ "^[ ]*[>][ ]*" ()) (list (make-instance 'css-descendant-selector :arg :direct :matcher (parse-css-specifier &rest))))
- (#T(regexp+ "^[ ]+" ()) (list (make-instance 'css-descendant-selector :arg t :matcher (parse-css-specifier &rest))))
- ;; simple selector sequence
- (#T(regexp+ "^(\\w+)" (?type)) (cons (make-instance 'css-type-selector :arg type) (parse-css-specifier &rest)))
- (#T(regexp+ "^[#](\\w+)" (?id)) (cons (make-instance 'css-id-selector :arg id) (parse-css-specifier &rest)))
- (#T(regexp+ "^[\\.](\\w+)" (?class)) (cons (make-instance 'css-class-selector :arg class) (parse-css-specifier &rest)))))
-
-;; FIXME: rename to select-subject?
-;; FIXME: make css-select methods use functions defined in traversal/implementation.lisp
-(defgeneric css-select (specifier document))
-
-;; FIXME?: move to within (css-select css-specifier cons)
-;; FIXME: Should this really be this ugly?
-(defun css-collect-elements (selector elements)
- (flet ((last-matcher () (car (last (matcher selector))))
- (all-match (element) (every (lambda (m) (css-select m element)) (matcher selector))))
- (loop :for element :in elements
- :when (all-match element)
- :if (specifier-p (last-matcher))
- :nconc (css-select (last-matcher) element)
- :else
- :collect element
- :end
- :end
- :when (consp element)
- :nconc (css-collect-elements selector (cddr element)))))
-
-(defmethod css-select ((selector css-selector) (element string))
- nil)
-
-(defmethod css-select ((selector css-specifier) (document cons))
- (css-collect-elements selector
- ;; Urg. I may be doing something wrong here. :P
- (if (and (listp document) (listp (car document)))
- document
- (list document))))
-
-
-(defmethod css-select ((selector css-type-selector) (element cons))
- (when (string-equal (car element) (selector-arg selector))
- element))
-
-(defun lhtml-attr (attr element)
- (cadr (assoc attr (cadr element))))
-
-(defmethod css-select ((selector css-id-selector) (element cons))
- (when (string= (lhtml-attr :id element) (selector-arg selector))
- element))
-
-(defmethod css-select ((selector css-class-selector) (element cons))
- (when (member (selector-arg selector)
- (split-sequence:split-sequence #\Space (lhtml-attr :class element) :remove-empty-subseqs t)
- :test #'string=)
- element))
-
-(defmethod css-select ((selector css-descendant-selector) (element cons))
- (flet ((all-match (element) (every (lambda (m) (css-select m element)) (matcher selector))))
- #+nil
- (when (all-match element) element)
- (let ((elements (cddr element)))
- (format t "el: ~s~%" elements)
- (case (selector-arg selector)
- (:direct (loop :for element :in elements
- :when (all-match element)
- :collect element))
- (t (css-collect-elements selector elements))))))
Sat Nov 14 00:47:26 UTC 2009 pix@kepibu.org
* Whoops. Overzealous replace
hunk ./unification-templates.lisp 107
- (#T(regexp+ "^(\\w+)" (?element-type)) (cons (make-instance 'css-type-selector :arg element-type) (parse-css-specifier &rest)))
+ (#T(regexp+ "^(\\w+)" (?type)) (cons (make-instance 'css-type-selector :arg type) (parse-css-specifier &rest)))