Sat Nov 21 16:12:13 UTC 2009 pix@kepibu.org

* Status commit

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

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

-** working lhtml/xmls support

+** working lhtml/xmls support [1/2]

+ * [X] non-descendant cases (class, id, etc.)

+ * [ ] selectors involving descendants

- ;; 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.

- :components

- ((:file "interface")))

+ :components ((:file "interface")))

- :components (#+FIXME (:file "lhtml")

+ :components ((:file "lhtml")

+(defpackage #:oh-ducks.functional

+ (:import-from #:alexandria . #1=(

+ #:compose

+ #:curry

+ #:rcurry))

+ (:export . #1#))

+

- (:use #:cl)

+ (:use #:cl #:oh-ducks.functional)

- (:use #:cl #:unify #:oh-ducks.traversal)

- (:import-from #:alexandria

- #:compose

- #:curry

- #:rcurry)

+ (:use #:cl #:unify #:oh-ducks.functional #:oh-ducks.traversal)

- (format stream "#<combinator>"))

+ (format stream "#<~s ~s>" (class-name (class-of selector)) (matcher selector)))

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

+ (format t "cc:: el: ~s, s: ~s~%" (element-parent element) selector)

- ((parser :initarg :parser :initform nil) ;; subtype generally determines parser

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

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

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

-

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

-

- (match (#T(html ("#id" . ?div))

+ (match (#T(html (:model lhtml) ("#id" . ?div))

- (match (#T(html (".fish" . ?divs)

+ (match (#T(html (:model lhtml)

+ (".fish" . ?divs)

- (match (#T(html ("div>i" . ?i))

+ (match (#T(html (:model dom)

+ ("div>i" . ?i))

- (match (#T(html ("div" ("> i" . ?i)

- ("span>i" . ?span)))

+ (match (#T(html (:model dom)

+ ("div" ("i" . ?i)

+ ("span" . ?span)))

+(defmethod oh-ducks::find-matching-elements (selector (element dom:document))

+ (oh-ducks::find-matching-elements selector (dom:document-element element)))

+

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

+#+(or)

+#+(or)

+#+(or)

- (:documentation "Returns a sequence of element's element-children."))

+ (:documentation "Returns a sequence of element's child tags."))

- (:documentation "Returns element's element-parent element."))

+ (:documentation "Returns element's parent element."))

- (:documentation "Returns the tag name (element-type) of element."))

+ (:documentation "Returns the tag name (type) of element."))

- (cddr element))

+ (remove-if-not (lambda (x) (and (listp x) (keywordp (car x))))

+ (cddr element)))

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

- (chtml:pt-children element))

+ (remove-if (rcurry #'member '(:pcdata :comment) :test #'eq)

+ (chtml:pt-children element)))

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

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

- (unify template (funcall (document-parser template) document) env))

+ (unify template (funcall (slot-value template 'parser) document) env))

- (unify template (funcall (document-parser template) document) env))

-

+ (unify template (funcall (slot-value template 'parser) document) env))