Fri Nov 13 04:19:11 UTC 2009 pix@kepibu.org * Time commit diff -rN -u old-Oh, Ducks!/regexp-template.lisp new-Oh, Ducks!/regexp-template.lisp --- old-Oh, Ducks!/regexp-template.lisp 1970-01-01 00:00:00.000000000 +0000 +++ new-Oh, Ducks!/regexp-template.lisp 2015-10-03 13:57:50.000000000 +0000 @@ -0,0 +1,15 @@ +;;;; we add an automagical &rest, because cl-unification's cl-ppcre support +;;;; requires matching the entire string, and we're generally concerned with +;;;; just the beginning of it. +(in-package #:csslike-unifier) + +(defmethod make-template ((kind (eql 'regexp+)) (spec cons)) + (destructuring-bind (re-kwd regexp &optional vars &rest keys) + spec + (make-instance 'unify::regular-expression-template + :spec (list* re-kwd + (concatenate 'string regexp "(.*)$") + (append vars '(?rest)) + keys)))) + +#+(or) (match #t(regexp+ "^f(o+)" (?o)) (values o rest)) diff -rN -u old-Oh, Ducks!/traversal/interface.lisp new-Oh, Ducks!/traversal/interface.lisp --- old-Oh, Ducks!/traversal/interface.lisp 1970-01-01 00:00:00.000000000 +0000 +++ new-Oh, Ducks!/traversal/interface.lisp 2015-10-03 13:57:50.000000000 +0000 @@ -0,0 +1,30 @@ +;;;; type-defines-accessors +;;;; Under this implementation strategy, elements would need only implement +;;;; accessors for traversing the node graph. +(in-package #:csslike-unifier) + +;;; general accessors + +(defgeneric children (element) + (:documentation "Returns a sequence of element's children.")) +(defgeneric parent (element) + (:documentation "Returns element's parent element.")) +(defgeneric attribute (attribute element) + (:documentation "Returns the value of the attribute of element, or nil if no such attribute exists.")) +(defgeneric type (element) + (:documentation "Returns the tag name (type) of element.")) + +;;; special accessors in case something special needs to happen + +(defgeneric id (element) + (:documentation "Equivalent in spirit to (attribute :id element).") + (:method (element) (attribute :id element))) + +(defgeneric classes (element) + (:documentation "Equivalent in spirit to (attribute :class element), except it returns a sequence of individual classes.") + (:method (element) + (split-sequence:split-sequence #\Space (attribute :class element) :remove-empty-subseqs t))) + +(defgeneric type-equal (element type) + (:documentation "Equivalent in spirit to (string-equal (type element) type), but not obligated to work under the assumption of string-designators.") + (:method (element type) (string-equal type (type element)))) diff -rN -u old-Oh, Ducks!/traversal/lhtml.lisp new-Oh, Ducks!/traversal/lhtml.lisp --- old-Oh, Ducks!/traversal/lhtml.lisp 1970-01-01 00:00:00.000000000 +0000 +++ new-Oh, Ducks!/traversal/lhtml.lisp 2015-10-03 13:57:50.000000000 +0000 @@ -0,0 +1,23 @@ +;;; WARNING: lhtml will conflict with any handler which also uses lists. +;;; xmls, for instance (though I think that's at least +;;; structurally compatible). Sorry, but that's the way it goes. +(in-package #:csslike-unifier) + +;;; general accessors + +(defmethod children ((element list)) + (cddr element)) + +(defmethod parent ((element list)) + ;; FIXME: figure out how to do this. Maybe we can do something involving + ;; signals and restart-cases. Ask "are you my mother?" up the stack, and + ;; only error if everybody says no. + (error "Unable to locate parent or suitable guardian.")) + +(defmethod attribute ((attribute symbol) (element list)) + (cadr (assoc attribute (cadr element)))) +(defmethod attribute ((attribute string) (element list)) + (attribute (intern (string-upcase attribute) :keyword) element)) + +(defmethod 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 1970-01-01 00:00:00.000000000 +0000 +++ new-Oh, Ducks!/traversal/pt.lisp 2015-10-03 13:57:50.000000000 +0000 @@ -0,0 +1,17 @@ +(in-package #:csslike-unifier) + +;;; general accessors + +(defmethod children ((element chtml:pt)) + (chtml:pt-children element)) + +(defmethod parent ((element chtml:pt)) + (chtml:pt-parent element)) + +(defmethod attribute ((attribute symbol) (element chtml:pt)) + (getf (chtml:pt-attrs element) attribute)) +(defmethod attribute ((attribute string) (element chtml:pt)) + (attribute (intern (string-upcase attribute) :keyword) element)) + +(defmethod type ((element chtml:pt)) + (chtml:pt-name element)) diff -rN -u old-Oh, Ducks!/unification-templates.lisp new-Oh, Ducks!/unification-templates.lisp --- old-Oh, Ducks!/unification-templates.lisp 2015-10-03 13:57:50.000000000 +0000 +++ new-Oh, Ducks!/unification-templates.lisp 2015-10-03 13:57:50.000000000 +0000 @@ -1,3 +1,5 @@ +;; FIXME: rename from csslike to css-selector...so css-selector-unifier and +;; css-selector-template. Much nicer name, methinks. (in-package #:csslike-unifier) (defclass csslike-template (unify::expression-template) @@ -7,12 +9,20 @@ (specifiers :reader specifiers) ;; list of (specifier . variable) and (specifier . template) )) -(defclass lhtml-template (csslike-template) ()) +(defclass xml-template (csslike-template) ()) ;; parses using closure-xml + +(defclass html-template (csslike-template) ()) ;; parses using closure-html + +(defclass lhtml-template (html-template) ()) +(defclass pt-template (html-template) ()) (defmethod make-template ((kind (eql 'lhtml)) (spec cons)) (format t "spec: ~s~%" spec) (make-instance 'lhtml-template :spec (rest spec))) +(defmethod make-template ((kind (eql 'html)) (spec cons)) + (make-instance 'pt-template :spec (rest spec))) + (defmethod initialize-instance :after ((template lhtml-template) &key css-specifiers &allow-other-keys) (let ((specifiers-and-vars (or css-specifiers (template-spec template)))) (setf (slot-value template 'specifiers) @@ -91,37 +101,6 @@ (defgeneric css-select (specifier document)) -#+nil -(defmethod css-select ((specifier css-specifier) document) - (loop :with docs = (list document) - :for spec :in (matcher specifier) - :do (setf docs (loop :for doc :in docs :nconc (css-select spec doc))) - :finally (return docs))) - -;; lhtml -#+nil -(defun css-collect-elements (selector elements) - (loop :for element :in elements - :when (css-select selector element) - :collect (css-select selector element) - :when (consp element) - :nconc (css-collect-elements selector (cddr element)))) - -#+nil -(defmethod css-select ((selector css-specifier) (document cons)) - (let ((found (list document))) - (loop :for matcher :in (matcher selector) - :do (setf found (css-collect-elements matcher found)) - (format t "found: ~s~%" found)) - found)) - -;; FIXME: It would probably be better to have a user-visible API like: -;; (defmethod element-id (element) ...) -;; (defmethod element-classes (element) ...) -;; (defmethod element-type (element) ...) -;; (defmethod element-children (element) ...) -;; Then our algorithms here would use that, rather than being tied to a specific representation. - ;; FIXME?: move to within (css-select css-specifier cons) ;; FIXME: Should this really be this ugly? (defun css-collect-elements (selector elements) @@ -150,14 +129,6 @@ (when (string-equal (car element) (selector-arg selector)) element)) -#+nil ( - (flet ((collect-elements () (loop :for element :in (cddr document) - :when (consp element) - :nconc (css-select selector element)))) - (if (string-equal (car document) (selector-arg selector)) - (cons document (collect-elements)) - (remove nil (collect-elements))))) - (defun lhtml-attr (attr element) (cadr (assoc attr (cadr element)))) @@ -165,31 +136,12 @@ (when (string= (lhtml-attr :id element) (selector-arg selector)) element)) -#+nil -(defmethod css-select ((selector css-id-selector) (document cons)) - (flet ((collect-elements () (loop :for element :in (cddr document) - :when (consp element) - :nconc (css-select selector element)))) - (if (string= (lhtml-attr :id document) (selector-arg selector)) - (cons document (collect-elements)) - (remove nil (collect-elements))))) - (defmethod css-select ((selector css-class-selector) (element cons)) (when (member (selector-arg selector) (split-sequence:split-sequence #\Space (lhtml-attr :class element) :remove-empty-subseqs t) :test #'string=) element)) - -#+nil -(defmethod css-select ((selector css-class-selector) (document cons)) - (flet ((collect-elements () (loop :for element :in (cddr document) - :when (consp element) - :nconc (css-select selector element)))) - (if (member (selector-arg selector) (split-sequence:split-sequence #\Space (lhtml-attr :class document) :remove-empty-subseqs t) :test #'string=) - (cons document (collect-elements)) - (remove nil (collect-elements))))) - (defmethod css-select ((selector css-descendant-selector) (element cons)) (flet ((all-match (element) (every (lambda (m) (css-select m element)) (matcher selector)))) #+nil @@ -217,11 +169,3 @@ (defgeneric css-selector:id (element id)) - -;; type-defines-accessors -;; Under this implementation strategy, elements would need only implement -;; accessors for traversing the node graph. -(defgeneric children (element)) -(defgeneric parent (element)) -(defgeneric attribute (element attribute)) -(defgeneric type (element)) ;; tag