repos
/
Oh, Ducks!
/ annotate_shade
summary
|
shortlog
|
log
|
tree
|
commit
|
commitdiff
|
headdiff
|
annotate
|
headblob
|
headfilediff
|
filehistory
normal
|
plain
|
shade
|
zebra
Support for asking about ancestors under lhtml
Annotate for file /traversal/lhtml.lisp
2009-11-13 pix
1
;;; WARNING: lhtml will conflict with any handler which also uses lists.
04:19:11 '
2
;;; xmls, for instance (though I think that's at least
'
3
;;; structurally compatible). Sorry, but that's the way it goes.
2009-11-18 pix
4
(in-package #:oh-ducks.traversal)
2009-11-13 pix
5
2010-01-04 pix
6
(defvar *lhtml-family-tree* nil)
07:06:50 '
7
'
8
(defun in-hash (key hash)
'
9
(multiple-value-bind (val present-p) (gethash key hash)
'
10
(declare (ignore val))
'
11
present-p))
'
12
'
13
(defun %mark-parents (parent children)
'
14
(dolist (item children)
'
15
(setf (gethash item *lhtml-family-tree*) parent)
'
16
(%mark-parents item (element-children item))))
'
17
'
18
;; WARNING: This won't produce sane results for nested (match)es, because we
'
19
;; have no way to bind in a large enough scope.
'
20
(defmethod unify:unify ((template oh-ducks::css-selector-template)
'
21
(element list)
'
22
&optional (env (unify:make-empty-environment))
'
23
&key)
'
24
(if (and *lhtml-family-tree*
'
25
(in-hash element *lhtml-family-tree*))
'
26
(call-next-method)
'
27
(let ((*lhtml-family-tree* (make-hash-table :test 'eq)))
'
28
(%mark-parents nil (list element))
'
29
(%mark-parents element (element-children element))
'
30
(call-next-method))))
'
31
2009-11-13 pix
32
;;; general accessors
04:19:11 '
33
2009-11-13 pix
34
(defmethod element-children ((element list))
2009-11-21 pix
35
(remove-if-not (lambda (x) (and (listp x) (keywordp (car x))))
16:12:13 '
36
(cddr element)))
2009-11-13 pix
37
2009-11-16 pix
38
(defmethod element-parent ((element list))
2010-01-04 pix
39
(multiple-value-bind (parent present?)
07:06:50 '
40
(gethash element *lhtml-family-tree*)
'
41
(if present?
'
42
parent
'
43
(error "unable to determine parent"))))
2009-11-13 pix
44
2009-11-21 pix
45
(defmethod element-attribute ((attribute symbol) (element list))
16:12:13 '
46
(cadr (assoc attribute (cadr element))))
'
47
(defmethod element-attribute ((attribute string) (element list))
'
48
(element-attribute (intern (string-upcase attribute) :keyword) element))
2009-11-13 pix
49
2009-11-13 pix
50
(defmethod element-type ((element list))
2009-11-13 pix
51
(car element))
2009-12-13 pix
52
(defmethod element-content ((element list))
05:24:52 '
53
(cddr element))
'
54