Mon Nov 16 09:02:50 UTC 2009 pix@kepibu.org
* Status commit
diff -rN -u old-Oh, Ducks!/regexp-template.lisp new-Oh, Ducks!/regexp-template.lisp
--- old-Oh, Ducks!/regexp-template.lisp 2015-11-19 05:27:46.000000000 +0000
+++ new-Oh, Ducks!/regexp-template.lisp 2015-11-19 05:27:46.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 "$")
diff -rN -u old-Oh, Ducks!/selectors.lisp new-Oh, Ducks!/selectors.lisp
--- old-Oh, Ducks!/selectors.lisp 2015-11-19 05:27:46.000000000 +0000
+++ new-Oh, Ducks!/selectors.lisp 2015-11-19 05:27:46.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))
diff -rN -u old-Oh, Ducks!/tests.lisp new-Oh, Ducks!/tests.lisp
--- old-Oh, Ducks!/tests.lisp 2015-11-19 05:27:46.000000000 +0000
+++ new-Oh, Ducks!/tests.lisp 2015-11-19 05:27:46.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)))
"I do not like cheese.
I like cheese.
")
- i))
+ (values i span)))
#+LATER
(match (#t(lhtml ("div::content" . #t(regexp+ "^f(o+)" (?o))))
diff -rN -u old-Oh, Ducks!/traversal/lhtml.lisp new-Oh, Ducks!/traversal/lhtml.lisp
--- old-Oh, Ducks!/traversal/lhtml.lisp 2015-11-19 05:27:46.000000000 +0000
+++ new-Oh, Ducks!/traversal/lhtml.lisp 2015-11-19 05:27:46.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))))
diff -rN -u old-Oh, Ducks!/unification-templates.lisp new-Oh, Ducks!/unification-templates.lisp
--- old-Oh, Ducks!/unification-templates.lisp 2015-11-19 05:27:46.000000000 +0000
+++ new-Oh, Ducks!/unification-templates.lisp 2015-11-19 05:27:46.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))