Mon Nov 16 09:02:50 UTC 2009 pix@kepibu.org

* Status commit

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

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

@@ -29,9 +29,6 @@

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

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

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

@@ -73,6 +73,8 @@

(defclass adjacent-combinator (combinator) ())

(defclass sibling-combinator (combinator) ())

+#+FIXME ; is this the right name?

+(defclass universal-selector (simple-selector) ())

(defclass type-selector (simple-selector) ())

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

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

@@ -82,108 +84,37 @@

(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

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

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

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

(defgeneric find-matching-elements (selector elements))

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

-

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

+ elements)))))

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

-(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 (element (selector type-selector))

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

(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 (element (selector class-selector))

@@ -191,23 +122,6 @@

(element-classes element)

:test #'string=))

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

-

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

(every (lambda (s) (element-matches-p element s)) selector))

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

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

@@ -28,9 +28,10 @@

i))

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

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

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

+ ("span>i" . ?span)))

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

- i))

+ (values i span)))

#+LATER

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

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

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

@@ -9,13 +9,19 @@

(cddr element))

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

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

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

+ (error "cannot get parent"))

+#+FIXME

(defmethod element-ancestors ((element list))

*ancestors*)

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

+ (error "cannot get ancestors"))

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

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

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

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

@@ -1,16 +1,21 @@

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

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

(defclass css-selector-template (unify::expression-template)

(#+(or)

(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

@@ -24,24 +29,17 @@

(defmethod make-template ((kind (eql 'html)) (spec cons))

(make-instance 'pt-template :spec spec))

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

(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

@@ -54,7 +52,11 @@

(cond

((unify::template-p rest) rest)

((unify::variablep rest) rest)

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

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

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

@@ -66,12 +68,9 @@

(defmethod unify ((template css-selector-template) document

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

&key &allow-other-keys)

- (format t "ts: ~s~%" (template-spec template))

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

:do

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

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

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

(cond

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

((unify::variablep template) (unify::extend-environment template val env))