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 2014-07-15 08:30:23.000000000 +0000 +++ new-Oh, Ducks!/chtml.lisp 2014-07-15 08:30:23.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 2014-07-15 08:30:23.000000000 +0000 +++ new-Oh, Ducks!/cxml.lisp 2014-07-15 08:30:23.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 2014-07-15 08:30:23.000000000 +0000 +++ new-Oh, Ducks!/notes 2014-07-15 08:30:23.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 2014-07-15 08:30:23.000000000 +0000 +++ new-Oh, Ducks!/oh-ducks.asd 2014-07-15 08:30:23.000000000 +0000 @@ -17,16 +17,12 @@ :maintainer "pinterface " :author "pinterface " :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 2014-07-15 08:30:23.000000000 +0000 +++ new-Oh, Ducks!/package.lisp 2014-07-15 08:30:23.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 2014-07-15 08:30:23.000000000 +0000 +++ new-Oh, Ducks!/selectors.lisp 2014-07-15 08:30:23.000000000 +0000 @@ -22,7 +22,7 @@ (:method ((ob t)) nil)) (defmethod print-object ((selector combinator) stream) - (format stream "#")) + (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 2014-07-15 08:30:23.000000000 +0000 +++ new-Oh, Ducks!/templates.lisp 2014-07-15 08:30:23.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 2014-07-15 08:30:23.000000000 +0000 +++ new-Oh, Ducks!/tests.lisp 2014-07-15 08:30:23.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)) "
I like cheese.
") ;; 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)) "
bricklayer
one fish
two fish
") ;; 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)) "
I do not like cheese.
I like cheese.
") i)) (equalp '((:i () "not")) - (match (#T(html ("div" ("> i" . ?i) - ("span>i" . ?span))) + (match (#T(html (:model dom) + ("div" ("i" . ?i) + ("span" . ?span))) "
I do not like cheese.
I like cheese.
") (values i span))) diff -rN -u old-Oh, Ducks!/traversal/dom.lisp new-Oh, Ducks!/traversal/dom.lisp --- old-Oh, Ducks!/traversal/dom.lisp 2014-07-15 08:30:23.000000000 +0000 +++ new-Oh, Ducks!/traversal/dom.lisp 2014-07-15 08:30:23.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 2014-07-15 08:30:23.000000000 +0000 +++ new-Oh, Ducks!/traversal/interface.lisp 2014-07-15 08:30:23.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 2014-07-15 08:30:23.000000000 +0000 +++ new-Oh, Ducks!/traversal/lhtml.lisp 2014-07-15 08:30:23.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 2014-07-15 08:30:23.000000000 +0000 +++ new-Oh, Ducks!/traversal/pt.lisp 2014-07-15 08:30:23.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 2014-07-15 08:30:23.000000000 +0000 +++ new-Oh, Ducks!/unify.lisp 2014-07-15 08:30:23.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))