Fri Nov 13 04:19:11 UTC 2009 pix@kepibu.org

* Time commit

--- old-Oh, Ducks!/regexp-template.lisp 1970-01-01 00:00:00.000000000 +0000

+++ new-Oh, Ducks!/regexp-template.lisp 2015-04-10 16:10:47.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))

--- old-Oh, Ducks!/traversal/interface.lisp 1970-01-01 00:00:00.000000000 +0000

+++ new-Oh, Ducks!/traversal/interface.lisp 2015-04-10 16:10:47.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))))

--- old-Oh, Ducks!/traversal/lhtml.lisp 1970-01-01 00:00:00.000000000 +0000

+++ new-Oh, Ducks!/traversal/lhtml.lisp 2015-04-10 16:10:47.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))

--- old-Oh, Ducks!/traversal/pt.lisp 1970-01-01 00:00:00.000000000 +0000

+++ new-Oh, Ducks!/traversal/pt.lisp 2015-04-10 16:10:47.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))

--- old-Oh, Ducks!/unification-templates.lisp 2015-04-10 16:10:47.000000000 +0000

+++ new-Oh, Ducks!/unification-templates.lisp 2015-04-10 16:10:47.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