Ignoring non-repository paths: /tests.lisp

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

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

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

* Minimal support for attribute-starts-with selector

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

* Update notes file

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

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

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

* Add attribute-equal selector

--- old-Oh, Ducks!/notes 2013-06-21 04:00:02.000000000 +0000

+++ new-Oh, Ducks!/notes 2013-06-21 04:00:02.000000000 +0000

@@ -51,7 +51,15 @@

For example,

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

-

+** Differentiating between LHTML lists and XMLS lists

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

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

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

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

+

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

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

+layered functions are welcome.

* Usage

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

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

@@ -155,9 +163,9 @@

* [X] :only-child

* [X] :only-of-type

* [X] :empty

-*** attribute selectors [1/7]

+*** attribute selectors [2/7]

* [X] attribute-present [att]

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

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

* [ ] attribute-member [att~=val]

* [ ] attribute-lang [att|=val]

* [ ] attribute-begins [att^=val]

@@ -167,6 +175,7 @@

*** any others?

** namespace support(?)

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

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

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

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

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

@@ -177,3 +186,12 @@

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

+** 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

--- old-Oh, Ducks!/oh-ducks.asd 2013-06-21 04:00:02.000000000 +0000

+++ new-Oh, Ducks!/oh-ducks.asd 2013-06-21 04:00:02.000000000 +0000

@@ -17,7 +17,7 @@

:maintainer "pinterface <pix@kepibu.org>"

:author "pinterface <pix@kepibu.org>"

:licence "BSD-style"

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

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

:serial t

:components ((:file "package")

(:file "regexp-template")

@@ -32,11 +32,17 @@

:requires (:oh-ducks :closure-html)

:components ((:file "chtml")

(:module "traversal"

- :components ((:file "lhtml")

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

(:file "pt")))))

(defsystem-connection ducks+cxml

:requires (:oh-ducks :cxml)

:components ((:file "cxml")

(:module "traversal"

- :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.

--- old-Oh, Ducks!/selectors.lisp 2013-06-21 04:00:02.000000000 +0000

+++ new-Oh, Ducks!/selectors.lisp 2013-06-21 04:00:02.000000000 +0000

@@ -42,8 +42,11 @@

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

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

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

+(defclass attribute-selector (simple-selector)

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

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

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

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

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

&key (asign "+") a

@@ -110,6 +113,12 @@

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

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

(parse-selector &rest)))

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

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

+ (parse-selector &rest)))

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

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

+ (parse-selector &rest)))

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

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

(?asign ?a ?bsign ?b))

@@ -271,6 +280,14 @@

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

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

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

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

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

+

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

+

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

(eq element *implicit-element*))

--- old-Oh, Ducks!/tests.lisp 2013-06-21 04:00:02.000000000 +0000

+++ new-Oh, Ducks!/tests.lisp 2013-06-21 04:00:02.000000000 +0000

@@ -157,6 +157,12 @@

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

ids))

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

+

#+LATER?

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

"<div>barbaz</div><div>fooooooobar</div>")

--- old-Oh, Ducks!/traversal/xmls.lisp 1970-01-01 00:00:00.000000000 +0000

+++ new-Oh, Ducks!/traversal/xmls.lisp 2013-06-21 04:00:02.000000000 +0000

@@ -0,0 +1,58 @@

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