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	2015-11-15 02:01:48.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	2015-11-15 02:01:48.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	2015-11-15 02:01:48.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