Fri Nov 13 01:43:02 UTC 2009 pix@kepibu.org
* Begin work on library
diff -rN -u old-Oh, Ducks!/package.lisp new-Oh, Ducks!/package.lisp
--- old-Oh, Ducks!/package.lisp 1970-01-01 00:00:00.000000000 +0000
+++ new-Oh, Ducks!/package.lisp 2013-06-16 00:49:29.000000000 +0000
@@ -0,0 +1,3 @@
+(defpackage #:csslike-unifier
+ (:use #:cl #:unify)
+ (:export #:lhtml))
diff -rN -u old-Oh, Ducks!/tests.lisp new-Oh, Ducks!/tests.lisp
--- old-Oh, Ducks!/tests.lisp 1970-01-01 00:00:00.000000000 +0000
+++ new-Oh, Ducks!/tests.lisp 2013-06-16 00:49:29.000000000 +0000
@@ -0,0 +1,35 @@
+(in-package #:csslike-unifier)
+
+(equalp '(:div ((:id "id")) "I " (:i () "like") " cheese.")
+ (match (#T(lhtml ("#id" . ?div))
+ "<div id=\"id\">I <i>like</i> cheese.</div>")
+ ;; FIXME: learn to distinguish between when there should only be one
+ ;; result and when there should be many?
+ (car div)))
+
+(equalp '((:div ((:class "red fish")) "one fish")
+ (:div ((:class "blue fish")) "two fish"))
+ (match (#T(lhtml (".fish" . ?divs)
+ (".pig" . ?pig))
+ "<div class='pig'>bricklayer</div><div class='red fish'>one fish</div><div class='blue fish'>two fish</div>")
+ ;; pig doesn't affect the equalp...but does show separate things are separate
+ (values divs pig)))
+
+(equalp '((:i () "not") (:i () "cheese"))
+ (match (#T(lhtml ("div" ("i" . ?i)))
+ "<div>I do <i>not</i> like cheese.</div><div>I like <i>cheese</i>.</div>")
+ i))
+
+(equalp '((:i () "not"))
+ (match (#T(lhtml ("div>i" . ?i))
+ "<div>I do <i>not</i> like cheese.</div><div><span>I like <i>cheese</i>.</span></div>")
+ i))
+
+;; FIXME: it seems our options for this are either to return incorrect results
+;; ((:i not) (:i cheese)) or make ?i fail to acknowledge all available
+;; items under div>i. This probably means my strategy of implementation
+;; is faulty.
+(equalp '((:i () "not"))
+ (match (#T(lhtml ("div" ("> i" . ?i)))
+ "<div>I do <i>not</i> like cheese.</div><div><span>I like <i>cheese</i>.</span></div>")
+ i))
diff -rN -u old-Oh, Ducks!/unification-templates.lisp new-Oh, Ducks!/unification-templates.lisp
--- old-Oh, Ducks!/unification-templates.lisp 1970-01-01 00:00:00.000000000 +0000
+++ new-Oh, Ducks!/unification-templates.lisp 2013-06-16 00:49:29.000000000 +0000
@@ -0,0 +1,227 @@
+(in-package #:csslike-unifier)
+
+(defclass csslike-template (unify::expression-template)
+ (#+(or)
+ (parser :reader parser) ;; subtype determines parser
+ (handler :reader handler) ;; cxml/closure-html handler
+ (specifiers :reader specifiers) ;; list of (specifier . variable) and (specifier . template)
+ ))
+
+(defclass lhtml-template (csslike-template) ())
+
+(defmethod make-template ((kind (eql 'lhtml)) (spec cons))
+ (format t "spec: ~s~%" spec)
+ (make-instance 'lhtml-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)
+ (parse-specifiers specifiers-and-vars 'lhtml-template))))
+
+(defun parse-specifiers (specs template-kind)
+ (loop :for (css-specifier . rest) :in specs
+ :collect (cons (make-instance 'css-specifier :spec css-specifier)
+ (cond
+ ((unify::template-p rest) rest)
+ ((unify::variablep rest) rest)
+ ((consp rest) (make-instance template-kind :css-specifiers rest))))))
+
+(defmethod unify ((a csslike-template) (b csslike-template)
+ &optional (env (make-empty-environment))
+ &key &allow-other-keys)
+ (error 'unification-failure
+ :format-control "Do not know how to unify the two csslike-templates ~S and ~S."
+ :format-arguments (list a b)))
+
+(defmethod unify ((template csslike-template) document
+ &optional (env (make-empty-environment))
+ &key &allow-other-keys)
+ (format t "ts: ~s~%" (template-spec template))
+ (loop :for (css-specifier . template) :in (specifiers template)
+ :do
+ (format t "spec: ~s, tpl: ~s~%" css-specifier template)
+ (let ((val (css-select css-specifier document)))
+ (format t "val: ~s~%" val)
+ (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)))))
+ env)
+
+(defmethod unify ((template lhtml-template) (document string)
+ &optional (env (make-empty-environment))
+ &key &allow-other-keys)
+ (unify template (chtml:parse document (chtml:make-lhtml-builder)) env))
+
+
+
+(defclass css-specifier (unify::string-template)
+ ((matcher :reader matcher :initarg :matcher)))
+
+(defgeneric specifier-p (object)
+ (:method ((ob css-specifier)) t)
+ (:method ((ob t)) nil))
+
+(defclass css-selector (unify::template)
+ ((arg :reader selector-arg :initarg :arg)))
+
+(defmethod print-object ((selector css-selector) stream)
+ (format stream "#<selector ~s>" (selector-arg selector)))
+
+(defclass css-type-selector (css-selector) ())
+(defclass css-id-selector (css-selector) ())
+(defclass css-class-selector (css-selector) ())
+
+(defclass css-descendant-selector (css-specifier css-selector) ())
+
+(defmethod initialize-instance :after ((template css-specifier) &key)
+ (unless (slot-boundp template 'matcher)
+ (let ((specifier (template-spec template)))
+ (setf (slot-value template 'matcher) (parse-css-specifier (string-trim " " specifier))))))
+
+(defun parse-css-specifier (specifier)
+ (match-case (specifier)
+ ;; combinators
+ (#T(unify::regexp "^[ ]*[>][ ]*(.*)$" (?rest)) (list (make-instance 'css-descendant-selector :arg :direct :matcher (parse-css-specifier rest))))
+ (#T(unify::regexp "^[ ]+(.*)$" (?rest)) (list (make-instance 'css-descendant-selector :arg t :matcher (parse-css-specifier rest))))
+ ;; simple selector sequence
+ (#T(unify::regexp "^(\\w+)(.*)$" (?type ?rest)) (cons (make-instance 'css-type-selector :arg type) (parse-css-specifier rest)))
+ (#T(unify::regexp "^[#](\\w+)(.*)$" (?id ?rest)) (cons (make-instance 'css-id-selector :arg id) (parse-css-specifier rest)))
+ (#T(unify::regexp "^[\\.](\\w+)(.*)$" (?class ?rest)) (cons (make-instance 'css-class-selector :arg class) (parse-css-specifier rest)))))
+
+(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)
+ (flet ((last-matcher () (car (last (matcher selector))))
+ (all-match (element) (every (lambda (m) (css-select m element)) (matcher selector))))
+ (loop :for element :in elements
+ :when (all-match element)
+ :if (specifier-p (last-matcher))
+ :nconc (css-select (last-matcher) element)
+ :else
+ :collect element
+ :end
+ :end
+ :when (consp element)
+ :nconc (css-collect-elements selector (cddr element)))))
+
+(defmethod css-select ((selector css-specifier) (document cons))
+ (css-collect-elements selector
+ ;; Urg. I may be doing something wrong here. :P
+ (if (and (listp document) (listp (car document)))
+ document
+ (list document)))))
+
+
+(defmethod css-select ((selector css-type-selector) (element cons))
+ (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))))
+
+(defmethod css-select ((selector css-id-selector) (element cons))
+ (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
+ (when (all-match element) element)
+ (let ((elements (cddr element)))
+ (format t "el: ~s~%" elements)
+ (case (selector-arg selector)
+ (:direct (loop :for element :in elements
+ :when (all-match element)
+ :collect element))
+ (t (css-collect-elements selector elements))))))
+
+
+
+;; type-defines-selectors
+;; Under this implementation strategy, CSS selectors themselves would be
+;; implemented for elements.
+(defgeneric css-combinator:child (a b))
+(defgeneric css-combinator:descendant (a b))
+(defgeneric css-combinator:adjacent (a b))
+(defgeneric css-combinator:sibling (a b))
+
+(defgeneric css-selector:type (element type))
+(defgeneric css-selector:class (element class))
+(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