Mon Nov 16 08:14:42 UTC 2009 pix@kepibu.org

* Status commit

--- old-Oh, Ducks!/regexp-template.lisp 2015-04-10 16:13:31.000000000 +0000

+++ new-Oh, Ducks!/regexp-template.lisp 2015-04-10 16:13:31.000000000 +0000

@@ -29,9 +29,12 @@

(destructuring-bind (re-kwd regexp &optional vars &rest keys)

spec

(declare (ignore re-kwd))

+ (format t "rex: ~s, ~s~%"

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

+ (append '(?&rest) vars))

(make-instance 'unify::regular-expression-template

:spec (list* 'unify::regexp

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

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

(append '(?&rest) vars)

keys))))

--- old-Oh, Ducks!/selectors.lisp 2015-04-10 16:13:31.000000000 +0000

+++ new-Oh, Ducks!/selectors.lisp 2015-04-10 16:13:31.000000000 +0000

@@ -53,13 +53,21 @@

(:method ((ob selector)) t)

(:method ((ob t)) nil))

-(defclass simple-selector (simple-selector)

+(defclass simple-selector (selector)

((arg :reader selector-arg :initarg :arg)))

(defmethod print-object ((selector simple-selector) stream)

(format stream "#<selector ~s>" (selector-arg selector)))

(defclass combinator (selector) ())

+

+(defgeneric combinator-p (object)

+ (:method ((ob combinator)) t)

+ (:method ((ob t)) nil))

+

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

+ (format stream "#<combinator>"))

+

(defclass child-combinator (combinator) ())

(defclass descendant-combinator (combinator) ())

(defclass adjacent-combinator (combinator) ())

@@ -69,12 +77,13 @@

(defclass id-selector (simple-selector) ())

(defclass class-selector (simple-selector) ())

-(defmethod initialize-instance :after ((template selector) &key)

+(defmethod initialize-instance :after ((template combinator) &key)

(unless (slot-boundp template 'matcher)

(let ((selector (template-spec template)))

(setf (slot-value template 'matcher) (parse-selector (string-trim " " selector))))))

;; forwards

+#+(or)

(defun parse-selector (selector)

(match-case (selector)

;; combinators

@@ -86,16 +95,19 @@

(#T(regexp+ "^[\\.](\\w+)" (?class)) (cons (make-instance 'class-selector :arg class) (parse-selector &rest)))))

;; backwards

-#+(or)

+;; 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$ "[ ]*[>][ ]*" ()) (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))))

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

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

@@ -107,58 +119,85 @@

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

+(defmethod find-matching-elements ((selectors list) element)

+ (call-next-method)

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

-

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

+

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

+

+(defmethod find-matching-elements (selector (elements t))

+ (find-matching-elements selector (list elements)))

+

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

+||#

-(defgeneric element-matches-p (selector element))

+(defgeneric element-matches-p (element selector))

-(defmethod element-matches-p ((selector selector) (element t))

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

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

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

(element-type-equal element (selector-arg selector)))

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

(string= (element-id element) (selector-arg selector)))

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

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

(member (selector-arg selector)

(element-classes element)

:test #'string=))

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

+#+(or)

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

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

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

@@ -168,3 +207,12 @@

:when (all-match element)

:collect element))

(t (css-collect-elements selector elements))))))

+

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

--- old-Oh, Ducks!/tests.lisp 2015-04-10 16:13:31.000000000 +0000

+++ new-Oh, Ducks!/tests.lisp 2015-04-10 16:13:31.000000000 +0000

@@ -1,7 +1,9 @@

(in-package #:css-selector-unifier)

+;; FIXME: the switch to chtml:pt nodes means our #'equalp no longer

+;; works.

(equalp '(:div ((:id "id")) "I " (:i () "like") " cheese.")

- (match (#T(lhtml ("#id" . ?div))

+ (match (#T(html ("#id" . ?div))

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

;; FIXME: learn to distinguish between when there should only be one

;; result and when there should be many?

@@ -9,28 +11,24 @@

(equalp '((:div ((:class "red fish")) "one fish")

(:div ((:class "blue fish")) "two fish"))

- (match (#T(lhtml (".fish" . ?divs)

- (".pig" . ?pig))

+ (match (#T(html (".fish" . ?divs)

+ (".pig" . ?pig))

"<div class='pig'>bricklayer</div><div class='red fish'>one fish</div><div class='blue fish'>two fish</div>")

;; pig doesn't affect the equalp...but does show separate things are separate

(values divs pig)))

(equalp '((:i () "not") (:i () "cheese"))

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

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

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

i))

(equalp '((:i () "not"))

- (match (#T(lhtml ("div>i" . ?i))

+ (match (#T(html ("div>i" . ?i))

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

i))

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

(equalp '((:i () "not"))

- (match (#T(lhtml ("div" ("> i" . ?i)))

+ (match (#T(html ("div" ("> i" . ?i)))

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

i))

--- old-Oh, Ducks!/traversal/interface.lisp 2015-04-10 16:13:31.000000000 +0000

+++ new-Oh, Ducks!/traversal/interface.lisp 2015-04-10 16:13:31.000000000 +0000

@@ -18,7 +18,7 @@

(defgeneric element-id (element)

(:documentation "Equivalent in spirit to (element-attribute :element-id element).")

- (:method (element) (element-attribute :element-id element)))

+ (:method (element) (element-attribute :id element)))

(defgeneric element-classes (element)

(:documentation "Equivalent in spirit to (element-attribute :class element), except it returns a sequence of individual element-classes.")

@@ -28,3 +28,10 @@

(defgeneric element-type-equal (element type)

(:documentation "Equivalent in spirit to (string-equal (element-type element) element-type), but not obligated to work under the assumption of string-designators.")

(:method (element type) (string-equal type (element-type element))))

+

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

--- old-Oh, Ducks!/traversal/lhtml.lisp 2015-04-10 16:13:31.000000000 +0000

+++ new-Oh, Ducks!/traversal/lhtml.lisp 2015-04-10 16:13:31.000000000 +0000

@@ -8,11 +8,14 @@

(defmethod element-children ((element list))

(cddr element))

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

(defmethod element-parent ((element list))

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

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

(cadr (assoc element-attribute (cadr element))))

--- old-Oh, Ducks!/traversal/pt.lisp 2015-04-10 16:13:31.000000000 +0000

+++ new-Oh, Ducks!/traversal/pt.lisp 2015-04-10 16:13:31.000000000 +0000

@@ -9,7 +9,8 @@

(chtml:pt-parent element))

(defmethod element-attribute ((element-attribute symbol) (element chtml:pt))

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

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

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

(defmethod element-attribute ((element-attribute string) (element chtml:pt))

(element-attribute (intern (string-upcase element-attribute) :keyword) element))

--- old-Oh, Ducks!/unification-templates.lisp 2015-04-10 16:13:31.000000000 +0000

+++ new-Oh, Ducks!/unification-templates.lisp 2015-04-10 16:13:31.000000000 +0000

@@ -5,8 +5,12 @@

(parser :reader parser) ;; subtype determines parser

(handler :reader handler) ;; cxml/closure-html handler

(specifiers :reader specifiers) ;; list of (specifier . variable) and (specifier . template)

+ #+(or)

+ (parent :reader parent-template :initarg :parent :initform nil)

))

+(defmethod parent-template ((template t)) nil)

+

(defclass xml-template (css-selector-template) ()) ;; parses using closure-xml

(defclass html-template (css-selector-template) ()) ;; parses using closure-html

@@ -25,13 +29,32 @@

(setf (slot-value template 'specifiers)

(parse-specifiers specifiers-and-vars 'lhtml-template))))

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

(loop :for (css-specifier . rest) :in specs

- :collect (cons (make-instance 'css-specifier :spec css-specifier)

+ :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 template-kind :css-specifiers rest))))))

+ ((consp rest) (make-instance (class-of template) :css-specifiers rest :parent selector))))))

(defmethod unify ((a css-selector-template) (b css-selector-template)

&optional (env (make-empty-environment))

@@ -47,7 +70,7 @@

(loop :for (css-specifier . template) :in (specifiers template)

:do

(format t "spec: ~s, tpl: ~s~%" css-specifier template)

- (let ((val (css-select css-specifier document)))

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

(format t "val: ~s~%" val)

(cond

((unify::template-p template) (unify template val env))

@@ -59,3 +82,8 @@

&optional (env (make-empty-environment))

&key &allow-other-keys)

(unify template (chtml:parse document (chtml:make-lhtml-builder)) env))

+

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