Sun Jul 3 08:25:45 UTC 2011 pix@kepibu.org

* Add support for XMLS-style lists, conflicting with LHTML-style lists

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

+++ new-Oh, Ducks!/traversal/xmls.lisp 2015-10-31 15:41:33.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))