Wed Nov 18 08:57:44 UTC 2009 pix@kepibu.org

* status commit; add cxml:dom support

- (:file "pt" :depends-on ("interface"))))

+ (:file "pt" :depends-on ("interface"))

+ (:file "dom" :depends-on ("interface"))))

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

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

- (:documentation "Equivalent in spirit to (element-attribute :element-id element).")

+ (:documentation "Equivalent in spirit to (element-attribute :id 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.")

- (: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.")

+(defvar *default-parser* 'pt "Determines the default parser when none is specified.")

+

- (#+(or)

- (parser :reader parser) ;; subtype determines parser

- (handler :reader handler) ;; cxml/closure-html handler

+ ((parser :initarg :parser) ;; subtype generally determines parser

+(defclass dom-template (xml-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))))

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

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

+ (declare (ignore env))

-(defmethod unify ((template lhtml-template) (document string)

+(defmethod unify (document (template css-selector-template)

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

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

+