Wed Nov 18 08:57:44 UTC 2009 pix@kepibu.org * status commit; add cxml:dom support diff -rN -u old-Oh, Ducks!/oh-ducks.asd new-Oh, Ducks!/oh-ducks.asd --- old-Oh, Ducks!/oh-ducks.asd 2014-04-17 14:15:36.000000000 +0000 +++ new-Oh, Ducks!/oh-ducks.asd 2014-04-17 14:15:36.000000000 +0000 @@ -21,6 +21,7 @@ :components ((:file "interface") (:file "lhtml" :depends-on ("interface")) - (:file "pt" :depends-on ("interface")))) + (:file "pt" :depends-on ("interface")) + (:file "dom" :depends-on ("interface")))) (:file "selectors") (:file "unification-templates"))) diff -rN -u old-Oh, Ducks!/traversal/dom.lisp new-Oh, Ducks!/traversal/dom.lisp --- old-Oh, Ducks!/traversal/dom.lisp 1970-01-01 00:00:00.000000000 +0000 +++ new-Oh, Ducks!/traversal/dom.lisp 2014-04-17 14:15:36.000000000 +0000 @@ -0,0 +1,25 @@ +(in-package #:oh-ducks) + +;;; general accessors + +(defmethod element-children ((element dom:node)) + (coerce (dom:child-nodes element) 'list)) +(defmethod element-parent ((element dom:node)) + (dom:parent-node element)) +(defmethod element-attribute (attribute (element dom:node)) nil) +(defmethod element-attribute ((attribute symbol) (element dom:element)) + (element-attribute (string-downcase (symbol-name attribute)) element)) +(defmethod element-attribute ((attribute string) (element dom:element)) + (dom:get-attribute element attribute)) +(defmethod element-type ((element dom:node)) nil) +(defmethod element-type ((element dom:element)) + (dom:tag-name element)) + +;;; special accessors in case something special needs to happen +(defmethod element-id ((element dom:node)) + nil) +(defmethod element-id ((element dom:element)) + (element-attribute "id" element)) + +(defmethod element-classes (element) + (split-sequence:split-sequence #\Space (element-attribute "class" element) :remove-empty-subseqs t)) diff -rN -u old-Oh, Ducks!/traversal/interface.lisp new-Oh, Ducks!/traversal/interface.lisp --- old-Oh, Ducks!/traversal/interface.lisp 2014-04-17 14:15:36.000000000 +0000 +++ new-Oh, Ducks!/traversal/interface.lisp 2014-04-17 14:15:36.000000000 +0000 @@ -9,24 +9,24 @@ (:documentation "Returns a sequence of element's element-children.")) (defgeneric element-parent (element) (:documentation "Returns element's element-parent element.")) -(defgeneric element-attribute (element-attribute element) - (:documentation "Returns the value of the element-attribute of element, or nil if no such element-attribute exists.")) +(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.")) ;;; special accessors in case something special needs to happen (defgeneric element-id (element) - (:documentation "Equivalent in spirit to (element-attribute :element-id element).") + (:documentation "Equivalent in spirit to (element-attribute :id element).") (:method (element) (element-attribute :id element))) (defgeneric element-classes (element) - (:documentation "Equivalent in spirit to (element-attribute :class element), except it returns a sequence of individual element-classes.") + (:documentation "Equivalent in spirit to (element-attribute :class element), except it returns a sequence of individual classes.") (:method (element) (split-sequence:split-sequence #\Space (element-attribute :class element) :remove-empty-subseqs t))) (defgeneric element-type-equal (element type) - (:documentation "Equivalent in spirit to (string-equal (element-type element) element-type), but not obligated to work under the assumption of string-designators.") + (:documentation "Equivalent in spirit to (string-equal (element-type element) type), but not obligated to work under the assumption of string-designators.") (:method (element type) (string-equal type (element-type element)))) (defgeneric element-ancestors (element) diff -rN -u old-Oh, Ducks!/unification-templates.lisp new-Oh, Ducks!/unification-templates.lisp --- old-Oh, Ducks!/unification-templates.lisp 2014-04-17 14:15:36.000000000 +0000 +++ new-Oh, Ducks!/unification-templates.lisp 2014-04-17 14:15:36.000000000 +0000 @@ -9,28 +9,54 @@ ;; parser is specified, requires an already-parsed document be passed ;; in. +(defvar *default-parser* 'pt "Determines the default parser when none is specified.") + (defclass css-selector-template (unify::expression-template) - (#+(or) - (parser :reader parser) ;; subtype determines parser - (handler :reader handler) ;; cxml/closure-html handler + ((parser :initarg :parser) ;; subtype generally determines parser (specifiers :reader specifiers) ;; list of (specifier . variable) and (specifier . template) )) (defclass xml-template (css-selector-template) ()) ;; parses using closure-xml +(defclass dom-template (xml-template) ()) + (defclass html-template (css-selector-template) ()) ;; parses using closure-html (defclass lhtml-template (html-template) ()) (defclass pt-template (html-template) ()) -(defmethod make-template ((kind (eql 'lhtml)) (spec cons)) - (make-instance 'lhtml-template :spec spec)) +(defgeneric document-parser (template) + (:documentation "Returns a function which, given an unparsed document, parses that document into some sort of structure.") + (:method ((template css-selector-template)) + (slot-value template 'parser)) + (:method ((template dom-template)) + (lambda (document) (cxml:parse document (cxml-dom:make-dom-builder)))) + (:method ((template lhtml-template)) + (lambda (document) (chtml:parse document (chtml:make-lhtml-builder)))) + (:method ((template pt-template)) + (lambda (document) (chtml:parse document (chtml:make-pt-builder))))) + +(defun %spec-includes-opts (spec) + (keywordp (first (second spec)))) (defmethod make-template ((kind (eql 'html)) (spec cons)) - (make-instance 'pt-template :spec spec)) + (destructuring-bind (&key parser) + (if (%spec-includes-opts spec) + (second spec) + (list :parser *default-parser*)) + (case parser + ;; short names + ((lhtml :lhtml) (make-instance 'lhtml-template :spec spec)) + ((pt :pt) (make-instance 'pt-template :spec spec)) + ((dom :dom) (make-instance 'dom-template :spec spec)) + ;; user-specified + (t (make-instance 'css-selector-template :parser parser :spec spec))))) (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))))) + (let* ((spec (template-spec template)) + (specifiers-and-vars (or css-specifiers (if (%spec-includes-opts spec) + (cddr spec) + (rest spec))))) (setf (slot-value template 'specifiers) (parse-specifiers specifiers-and-vars template parent)))) @@ -61,6 +87,7 @@ (defmethod unify ((a css-selector-template) (b css-selector-template) &optional (env (make-empty-environment)) &key &allow-other-keys) + (declare (ignore env)) (error 'unification-failure :format-control "Do not know how to unify the two css-selector-templates ~S and ~S." :format-arguments (list a b))) @@ -77,12 +104,18 @@ (t (error "whoops: ~s, ~s" css-specifier template))))) env) -(defmethod unify ((template lhtml-template) (document string) +(defmethod unify (document (template css-selector-template) &optional (env (make-empty-environment)) &key &allow-other-keys) - (unify template (chtml:parse document (chtml:make-lhtml-builder)) env)) + (unify template document env)) -(defmethod unify ((template pt-template) (document string) +(defmethod unify ((template css-selector-template) (document string) &optional (env (make-empty-environment)) &key &allow-other-keys) - (unify template (chtml:parse document (chtml:make-pt-builder)) env)) + (unify template (funcall (document-parser template) 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)) +