Sat Nov 21 16:12:13 UTC 2009 pix@kepibu.org
* Status commit
diff -rN -u old-Oh, Ducks!/chtml.lisp new-Oh, Ducks!/chtml.lisp
--- old-Oh, Ducks!/chtml.lisp 2013-06-22 21:30:25.000000000 +0000
+++ new-Oh, Ducks!/chtml.lisp 2013-06-22 21:30:25.000000000 +0000
@@ -7,22 +7,18 @@
(export 'pt)
(export 'lhtml))
-(defclass lhtml-template (html-template) ())
-(defclass pt-template (html-template) ())
+(defclass html-template (css-selector-template) ())
-(defmethod document-parser ((template lhtml-template))
- (lambda (document) (chtml:parse document (chtml:make-lhtml-builder))))
-(defmethod document-parser ((template pt-template))
- (lambda (document) (chtml:parse document (chtml:make-pt-builder))))
+(add-handler 'pt 'chtml:make-pt-builder)
+(add-handler 'lhtml 'chtml:make-lhtml-builder)
-(defmethod make-template-for-parser ((parser (eql 'lhtml)) spec)
- (make-instance 'lhtml-template :spec spec))
-(defmethod make-template-for-parser ((parser (eql :lhtml)) spec)
- (make-template-for-parser 'lhtml spec))
+(unless *default-parser*
+ (setf *default-parser* (rcurry #'chtml:parse (get-handler-for-model 'pt))))
-(defmethod make-template-for-parser ((parser (eql 'pt)) spec)
- (make-instance 'pt-template :spec spec))
-(defmethod make-template-for-parser ((parser (eql :pt)) spec)
- (make-template-for-parser 'pt spec))
-
-(unless *default-parser* (setf *default-parser* 'pt))
+(defmethod make-template ((kind (eql 'html)) (spec cons))
+ (destructuring-bind (&key parser model)
+ (append (when (%spec-includes-opts spec) (second spec))
+ (list :model 'pt))
+ (make-instance 'html-template
+ :parser (or parser (rcurry #'chtml:parse (get-handler-for-model model)))
+ :spec spec)))
diff -rN -u old-Oh, Ducks!/cxml.lisp new-Oh, Ducks!/cxml.lisp
--- old-Oh, Ducks!/cxml.lisp 2013-06-22 21:30:25.000000000 +0000
+++ new-Oh, Ducks!/cxml.lisp 2013-06-22 21:30:25.000000000 +0000
@@ -3,14 +3,17 @@
(eval-when (:compile-toplevel :load-toplevel :execute)
(export 'dom))
-(defclass dom-template (xml-template) ())
+(defclass xml-template (css-selector-template) ())
-(defmethod document-parser ((template dom-template))
- (lambda (document) (cxml:parse document (cxml-dom:make-dom-builder))))
+(add-handler 'dom 'cxml-dom:make-dom-builder)
-(defmethod make-template-for-parser ((parser (eql 'dom)) spec)
- (make-instance 'dom-template :spec spec))
-(defmethod make-template-for-parser ((parser (eql :dom)) spec)
- (make-template-for-parser 'dom spec))
+(unless *default-parser*
+ (setf *default-parser* (rcurry #'cxml:parse (get-handler-for-model 'dom))))
-(unless *default-parser* (setf *default-parser* 'dom))
+(defmethod make-template ((kind (eql 'xml)) (spec cons))
+ (destructuring-bind (&key parser model)
+ (append (when (%spec-includes-opts spec) (second spec))
+ (list :model 'pt))
+ (make-instance 'xml-template
+ :parser (or parser (rcurry #'cxml:parse (get-handler-for-model model)))
+ :spec spec)))
diff -rN -u old-Oh, Ducks!/notes new-Oh, Ducks!/notes
--- old-Oh, Ducks!/notes 2013-06-22 21:30:25.000000000 +0000
+++ new-Oh, Ducks!/notes 2013-06-22 21:30:25.000000000 +0000
@@ -1,6 +1,8 @@
#-*-mode: org;-*-
* To Do
-** working lhtml/xmls support
+** working lhtml/xmls support [1/2]
+ * [X] non-descendant cases (class, id, etc.)
+ * [ ] selectors involving descendants
** write documentation
** improve selector support
*** positional selectors
diff -rN -u old-Oh, Ducks!/oh-ducks.asd new-Oh, Ducks!/oh-ducks.asd
--- old-Oh, Ducks!/oh-ducks.asd 2013-06-22 21:30:25.000000000 +0000
+++ new-Oh, Ducks!/oh-ducks.asd 2013-06-22 21:30:25.000000000 +0000
@@ -17,16 +17,12 @@
:maintainer "pinterface <pix@kepibu.org>"
:author "pinterface <pix@kepibu.org>"
:licence "BSD-style"
- ;; TODO: submit a patch for cl-unification to use
- ;; asdf-system-connections. Getting an unmodified version of
- ;; cl-unification to load the cl-ppcre stuff is a PITA.
:depends-on (:cl-unification :cl-ppcre :split-sequence :alexandria)
:serial t
:components ((:file "package")
(:file "regexp-template")
(:module "traversal"
- :components
- ((:file "interface")))
+ :components ((:file "interface")))
(:file "selectors")
(:file "templates")
(:file "unify")
@@ -36,7 +32,7 @@
:requires (:oh-ducks :closure-html)
:components ((:file "chtml")
(:module "traversal"
- :components (#+FIXME (:file "lhtml")
+ :components ((:file "lhtml")
(:file "pt")))))
(defsystem-connection ducks+cxml
diff -rN -u old-Oh, Ducks!/package.lisp new-Oh, Ducks!/package.lisp
--- old-Oh, Ducks!/package.lisp 2013-06-22 21:30:25.000000000 +0000
+++ new-Oh, Ducks!/package.lisp 2013-06-22 21:30:25.000000000 +0000
@@ -1,5 +1,12 @@
+(defpackage #:oh-ducks.functional
+ (:import-from #:alexandria . #1=(
+ #:compose
+ #:curry
+ #:rcurry))
+ (:export . #1#))
+
(defpackage #:oh-ducks.traversal
- (:use #:cl)
+ (:use #:cl #:oh-ducks.functional)
(:export #:element-children
#:element-parent
#:element-attribute
@@ -11,11 +18,7 @@
#:element-ancestors))
(defpackage #:oh-ducks
- (:use #:cl #:unify #:oh-ducks.traversal)
- (:import-from #:alexandria
- #:compose
- #:curry
- #:rcurry)
+ (:use #:cl #:unify #:oh-ducks.functional #:oh-ducks.traversal)
(:export ;; template machinery
#:*default-parser*
#:html
diff -rN -u old-Oh, Ducks!/selectors.lisp new-Oh, Ducks!/selectors.lisp
--- old-Oh, Ducks!/selectors.lisp 2013-06-22 21:30:25.000000000 +0000
+++ new-Oh, Ducks!/selectors.lisp 2013-06-22 21:30:25.000000000 +0000
@@ -22,7 +22,7 @@
(:method ((ob t)) nil))
(defmethod print-object ((selector combinator) stream)
- (format stream "#<combinator>"))
+ (format stream "#<~s ~s>" (class-name (class-of selector)) (matcher selector)))
(defclass child-combinator (combinator) ())
(defclass descendant-combinator (combinator) ())
@@ -52,17 +52,15 @@
(#T(regexp$ "(\\w+)" (?type)) (cons (make-instance 'type-selector :arg type) (parse-selector &rest)))
(#T(regexp$ "\\*" ()) (cons (make-instance 'universal-selector) (parse-selector &rest)))))
-(defgeneric find-matching-elements (selector elements))
-
-(defmethod find-matching-elements (selector (elements list))
- (nconc
- (remove-if-not (rcurry #'element-matches-p selector) elements)
- (reduce #'nconc
- (mapcar (compose (curry #'find-matching-elements selector) #'element-children)
- elements))))
-
-(defmethod find-matching-elements (selector (elements t))
- (find-matching-elements selector (list elements)))
+(defgeneric find-matching-elements (selector element)
+ (:method (selector (element t))
+ (flet ((find-in-list (elements)
+ (mapcar (curry #'find-matching-elements selector)
+ elements)))
+ (nconc
+ (when (element-matches-p element selector) (list element))
+ (reduce #'nconc
+ (find-in-list (element-children element)))))))
(defgeneric element-matches-p (element selector))
@@ -84,6 +82,7 @@
(every (curry #'element-matches-p element) selector))
(defmethod element-matches-p (element (selector child-combinator))
+ (format t "cc:: el: ~s, s: ~s~%" (element-parent element) selector)
(element-matches-p (element-parent element) (matcher selector)))
(defmethod element-matches-p (element (selector descendant-combinator))
diff -rN -u old-Oh, Ducks!/templates.lisp new-Oh, Ducks!/templates.lisp
--- old-Oh, Ducks!/templates.lisp 2013-06-22 21:30:25.000000000 +0000
+++ new-Oh, Ducks!/templates.lisp 2013-06-22 21:30:25.000000000 +0000
@@ -1,45 +1,26 @@
(in-package #:oh-ducks)
(defclass css-selector-template (unify::expression-template)
- ((parser :initarg :parser :initform nil) ;; subtype generally determines parser
+ ((parser :initarg :parser :initform nil) ;; subtype generally determines parser
(specifiers :reader specifiers) ;; list of (specifier . variable) and (specifier . template)
))
-;; FIXME: split html-template and xml-template into the cxml/chtml stuff; then,
-;; split dom-template into dom-html-template and dom-xml-template.
-;; Actually, just ditch the subtypes entirely, and build new objects with
-;; a specified handler type.
-(defclass xml-template (css-selector-template) ()) ;; parses xml
-
-(defclass html-template (css-selector-template) ()) ;; parses html
-
+(defvar *model-handler-map* nil "A mapping between model types and handler functions.")
+(defun add-handler (model handler)
+ (push (cons model handler) *model-handler-map*))
+(defun get-handler-for-model (model)
+ (let ((handler (cdr (assoc model *model-handler-map*))))
+ (typecase handler
+ (null nil)
+ (function (funcall handler))
+ (symbol (funcall (symbol-function handler)))
+ (t handler))))
(defvar *default-parser* nil "Determines the default parser when none is specified.")
-(defgeneric document-parser (template)
- (:documentation "Returns a function which, given an unparsed document, parses that document into some sort of structure."))
-
-(defmethod document-parser ((template css-selector-template))
- (slot-value template 'parser))
-
-(defgeneric make-template-for-parser (parser spec)
- (:documentation "Returns a template of the appropriate type for a given parser.")
- (:method ((parser t) spec)
- (make-instance 'css-selector-template :parser parser :spec spec))
- (:method ((parser null) spec)
- (declare (ignore parser spec))
- (error "No parser specified.")))
-
(defun %spec-includes-opts (spec)
(keywordp (first (second spec))))
-(defmethod make-template ((kind (eql 'html)) (spec cons))
- (destructuring-bind (&key parser)
- (if (%spec-includes-opts spec)
- (second spec)
- (list :parser *default-parser*))
- (make-template-for-parser parser spec)))
-
(defun combine-selectors (selector parent)
(let ((combinator (car (last selector))))
(cond
diff -rN -u old-Oh, Ducks!/tests.lisp new-Oh, Ducks!/tests.lisp
--- old-Oh, Ducks!/tests.lisp 2013-06-22 21:30:25.000000000 +0000
+++ new-Oh, Ducks!/tests.lisp 2013-06-22 21:30:25.000000000 +0000
@@ -7,7 +7,7 @@
#+(or) (setq *default-parser* 'pt)
(equalp '(:div ((:id "id")) "I " (:i () "like") " cheese.")
- (match (#T(html ("#id" . ?div))
+ (match (#T(html (:model lhtml) ("#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?
@@ -15,7 +15,8 @@
(equalp '((:div ((:class "red fish")) "one fish")
(:div ((:class "blue fish")) "two fish"))
- (match (#T(html (".fish" . ?divs)
+ (match (#T(html (:model lhtml)
+ (".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
@@ -27,13 +28,15 @@
i))
(equalp '((:i () "not"))
- (match (#T(html ("div>i" . ?i))
+ (match (#T(html (:model dom)
+ ("div>i" . ?i))
"<div>I do <i>not</i> like cheese.</div><div><span>I like <i>cheese</i>.</span></div>")
i))
(equalp '((:i () "not"))
- (match (#T(html ("div" ("> i" . ?i)
- ("span>i" . ?span)))
+ (match (#T(html (:model dom)
+ ("div" ("i" . ?i)
+ ("span" . ?span)))
"<div>I do <i>not</i> like cheese.</div><div><span>I like <i>cheese</i>.</span></div>")
(values i span)))
diff -rN -u old-Oh, Ducks!/traversal/dom.lisp new-Oh, Ducks!/traversal/dom.lisp
--- old-Oh, Ducks!/traversal/dom.lisp 2013-06-22 21:30:25.000000000 +0000
+++ new-Oh, Ducks!/traversal/dom.lisp 2013-06-22 21:30:25.000000000 +0000
@@ -1,11 +1,17 @@
(in-package #:oh-ducks.traversal)
+(defmethod oh-ducks::find-matching-elements (selector (element dom:document))
+ (oh-ducks::find-matching-elements selector (dom:document-element element)))
+
;;; general accessors
-(defmethod element-children ((element dom:node))
- (coerce (dom:child-nodes element) 'list))
-(defmethod element-parent ((element dom:node))
+(defmethod element-children ((element dom:element))
+ (remove-if-not #'dom:element-p (coerce (dom:child-nodes element) 'list)))
+(defmethod element-parent ((element dom:document))
+ nil)
+(defmethod element-parent ((element dom:element))
(dom:parent-node element))
+#+(or)
(defmethod element-attribute (attribute (element dom:node))
(declare (ignore attribute element))
nil)
@@ -13,6 +19,7 @@
(element-attribute (string-downcase (symbol-name attribute)) element))
(defmethod element-attribute ((attribute string) (element dom:element))
(dom:get-attribute element attribute))
+#+(or)
(defmethod element-type ((element dom:node))
(declare (ignore element))
nil)
@@ -20,6 +27,7 @@
(dom:tag-name element))
;;; special accessors in case something special needs to happen
+#+(or)
(defmethod element-id ((element dom:node))
(declare (ignore element))
nil)
diff -rN -u old-Oh, Ducks!/traversal/interface.lisp new-Oh, Ducks!/traversal/interface.lisp
--- old-Oh, Ducks!/traversal/interface.lisp 2013-06-22 21:30:25.000000000 +0000
+++ new-Oh, Ducks!/traversal/interface.lisp 2013-06-22 21:30:25.000000000 +0000
@@ -6,13 +6,13 @@
;;; general accessors
(defgeneric element-children (element)
- (:documentation "Returns a sequence of element's element-children."))
+ (:documentation "Returns a sequence of element's child tags."))
(defgeneric element-parent (element)
- (:documentation "Returns element's element-parent element."))
+ (:documentation "Returns element's parent element."))
(defgeneric element-attribute (attribute element)
(:documentation "Returns the value of the attribute of element, or nil if no such attribute exists."))
(defgeneric element-type (element)
- (:documentation "Returns the tag name (element-type) of element."))
+ (:documentation "Returns the tag name (type) of element."))
;;; special accessors in case something special needs to happen
diff -rN -u old-Oh, Ducks!/traversal/lhtml.lisp new-Oh, Ducks!/traversal/lhtml.lisp
--- old-Oh, Ducks!/traversal/lhtml.lisp 2013-06-22 21:30:25.000000000 +0000
+++ new-Oh, Ducks!/traversal/lhtml.lisp 2013-06-22 21:30:25.000000000 +0000
@@ -6,7 +6,8 @@
;;; general accessors
(defmethod element-children ((element list))
- (cddr element))
+ (remove-if-not (lambda (x) (and (listp x) (keywordp (car x))))
+ (cddr element)))
;; FIXME: bleh... may not even be worth trying to support this
#+FIXME
@@ -23,10 +24,10 @@
(defmethod element-ancestors ((element list))
(error "cannot get ancestors"))
-(defmethod element-attribute ((element-attribute symbol) (element list))
- (cadr (assoc element-attribute (cadr element))))
-(defmethod element-attribute ((element-attribute string) (element list))
- (element-attribute (intern (string-upcase element-attribute) :keyword) element))
+(defmethod element-attribute ((attribute symbol) (element list))
+ (cadr (assoc attribute (cadr element))))
+(defmethod element-attribute ((attribute string) (element list))
+ (element-attribute (intern (string-upcase attribute) :keyword) element))
(defmethod element-type ((element list))
(car element))
diff -rN -u old-Oh, Ducks!/traversal/pt.lisp new-Oh, Ducks!/traversal/pt.lisp
--- old-Oh, Ducks!/traversal/pt.lisp 2013-06-22 21:30:25.000000000 +0000
+++ new-Oh, Ducks!/traversal/pt.lisp 2013-06-22 21:30:25.000000000 +0000
@@ -3,7 +3,8 @@
;;; general accessors
(defmethod element-children ((element chtml:pt))
- (chtml:pt-children element))
+ (remove-if (rcurry #'member '(:pcdata :comment) :test #'eq)
+ (chtml:pt-children element)))
(defmethod element-parent ((element chtml:pt))
(chtml:pt-parent element))
diff -rN -u old-Oh, Ducks!/unify.lisp new-Oh, Ducks!/unify.lisp
--- old-Oh, Ducks!/unify.lisp 2013-06-22 21:30:25.000000000 +0000
+++ new-Oh, Ducks!/unify.lisp 2013-06-22 21:30:25.000000000 +0000
@@ -13,11 +13,23 @@
&key &allow-other-keys)
(loop :for (css-specifier . template) :in (specifiers template)
:do
- (let ((val (find-matching-elements css-specifier document)))
+ (setf
+ env
+ (let ((val (find-matching-elements css-specifier document)))
+ #+(or) (if (null val) (cerror "continue" "null!"))
+ (format t "mel: ~s, css: ~s, tpl: ~s~%" val css-specifier template)
(cond
- ((unify::template-p template) (unify template val env))
- ((unify::variablep template) (unify::extend-environment template val env))
- (t (error "whoops: ~s, ~s" css-specifier template)))))
+ ((unify::template-p template)
+ #+(or) (format t "template-p~%")
+ (unify template val env)
+ #+(or) ;; FIXME: in the case of multiple items in val, this will only return one.
+ (loop :for element :in val
+ :do (setf env (unify template element env))
+ :finally (return env)))
+ ((unify::variablep template)
+ #+(or) (format t "variable-p~%")
+ (unify::extend-environment template val env))
+ (t (error "whoops: ~s, ~s" css-specifier template))))))
env)
(defmethod unify (document (template css-selector-template)
@@ -28,10 +40,9 @@
(defmethod unify ((template css-selector-template) (document string)
&optional (env (make-empty-environment))
&key &allow-other-keys)
- (unify template (funcall (document-parser template) document) env))
+ (unify template (funcall (slot-value template 'parser) document) env))
(defmethod unify ((template css-selector-template) (document pathname)
&optional (env (make-empty-environment))
&key &allow-other-keys)
- (unify template (funcall (document-parser template) document) env))
-
+ (unify template (funcall (slot-value template 'parser) document) env))