Sun Jul 3 08:25:45 UTC 2011 pix@kepibu.org * Add support for XMLS-style lists, conflicting with LHTML-style lists diff -rN -u old-Oh, Ducks!/notes new-Oh, Ducks!/notes --- old-Oh, Ducks!/notes 2015-09-04 14:25:55.000000000 +0000 +++ new-Oh, Ducks!/notes 2015-09-04 14:25:55.000000000 +0000 @@ -51,7 +51,15 @@ For example, : :depends-on (:oh-ducks :closure-html :cxml) +** Differentiating between LHTML lists and XMLS lists +While it would, in theory, be possible to inspect lists and determine if they +are LHTML or XMLS lists, this is not currently done. You can, however, choose +which type you'd like to work with by pushing =:lists-are-xmls= or +=:lists-are-lhtml= to =*features*= before loading "Oh, Ducks!". +Unfortunately, this means you can only expect to use one list type in a single +lisp image. Patches to either automagically detect the list type, or to provide +layered functions are welcome. * Usage The combination of oh-ducks and closure-html provides an HTML template for use with cl-unification, and has the following syntax: diff -rN -u old-Oh, Ducks!/oh-ducks.asd new-Oh, Ducks!/oh-ducks.asd --- old-Oh, Ducks!/oh-ducks.asd 2015-09-04 14:25:55.000000000 +0000 +++ new-Oh, Ducks!/oh-ducks.asd 2015-09-04 14:25:55.000000000 +0000 @@ -32,11 +32,17 @@ :requires (:oh-ducks :closure-html) :components ((:file "chtml") (:module "traversal" - :components ((:file "lhtml") + :components (#-lists-are-xmls (:file "lhtml") (:file "pt"))))) (defsystem-connection ducks+cxml :requires (:oh-ducks :cxml) :components ((:file "cxml") (:module "traversal" - :components ((:file "dom"))))) + :components ((:file "dom") + #-lists-are-lhtml (:file "xmls"))))) + +;; In case you're wondering, we check the inverse of the :lists-are-* keywords +;; so, in the event you only load cxml (or chtml), and don't specify which +;; format lists are expected to take, you get the appropriate list operation by +;; default. diff -rN -u old-Oh, Ducks!/traversal/xmls.lisp new-Oh, Ducks!/traversal/xmls.lisp --- old-Oh, Ducks!/traversal/xmls.lisp 1970-01-01 00:00:00.000000000 +0000 +++ new-Oh, Ducks!/traversal/xmls.lisp 2015-09-04 14:25:55.000000000 +0000 @@ -0,0 +1,58 @@ +;;; WARNING: This conflicts with lhtml. +(in-package #:oh-ducks.traversal) + +(defvar *xmls-family-tree* nil) + +(defun in-hash (key hash) + (multiple-value-bind (val present-p) (gethash key hash) + (declare (ignore val)) + present-p)) + +(defun %mark-parents (parent children) + (dolist (item children) + (setf (gethash item *xmls-family-tree*) parent) + (%mark-parents item (element-children item)))) + +;; WARNING: This won't produce sane results for nested (match)es, because we +;; have no way to bind in a large enough scope. +(defmethod unify:unify ((template oh-ducks::css-selector-template) + (element list) + &optional (env (unify:make-empty-environment)) + &key) + (if (and *xmls-family-tree* + (in-hash element *xmls-family-tree*)) + (call-next-method) + (let ((*xmls-family-tree* (make-hash-table :test 'eq))) + (%mark-parents nil (list element)) + (%mark-parents element (element-children element)) + (call-next-method)))) + +(defmethod unify:unify ((document list) (template oh-ducks::css-selector-template) + &optional (env (unify:make-empty-environment)) + &key) + (unify:unify template document env)) + +;;; general accessors + +(defmethod element-children ((element list)) + (remove-if-not (lambda (x) (and (listp x) (stringp (car x)))) + (cddr element))) + +(defmethod element-parent ((element list)) + (multiple-value-bind (parent present?) + (gethash element *xmls-family-tree*) + (if present? + parent + (error "unable to determine parent")))) + +#+(or) +(defmethod element-attribute ((attribute symbol) (element list)) + (cadr (assoc attribute (cadr element)))) +(defmethod element-attribute ((attribute string) (element list)) + (cadr (assoc attribute (cadr element) :test #'string=))) + +(defmethod element-type ((element list)) + (car element)) + +(defmethod element-content ((element list)) + (cddr element))