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

* Status commit

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

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

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

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

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

-(defclass simple-selector (simple-selector)

+(defclass simple-selector (selector)

+

+(defgeneric combinator-p (object)

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

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

+

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

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

+

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

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

+#+(or)

-#+(or)

+;; FIXME: somehow, selector is ending up as "NIL"

+ (when (string= "NIL" selector) (error "selector is nil"))

+ (format t "selector: ~s~%" selector)

+ (macrolet ((prest (x) `(format t "rest~s: ~S~%" ,x &rest)))

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

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

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

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

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

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

-(defvar *ancestor*)

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

+(defmethod element-matches-p :around ((element string) (selector selector))

+ (call-next-method))

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

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

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

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

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

+#+(or)

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

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

+

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

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

+;; works.

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

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

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

- (".pig" . ?pig))

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

+ (".pig" . ?pig))

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

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

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

+ (match (#T(html ("div>i" . ?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.

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

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

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

+ (:method (element) (element-attribute :id 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))))))

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

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

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

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

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

+ #+(or)

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

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

+

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

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

+ :for selector = (combine-selectors (parse-selector css-specifier) parent)

+ :collect (cons selector

- ((consp rest) (make-instance template-kind :css-specifiers rest))))))

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

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

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

+

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