repos / Oh, Ducks! / annotate_shade
summary | shortlog | log | tree | commit | commitdiff | headdiff | annotate | headblob | headfilediff | filehistory
normal | plain | shade | zebra
implicit-element is a better name than root
Annotate for file selectors.lisp
2009-11-18 pix 1 (in-package #:oh-ducks)
2009-11-15 pix 2
2009-12-05 pix 3 (defvar *implicit-element* nil
07:18:05 ' 4 "The element to be considered as an implicit element to be matched by combinators without a leading qualifier. E.g., \"> a\" will match <a> tags directly under *implicit-element*, and \"+ a\" will match <a> tags directly following *implicit-element*.")
2009-12-04 pix 5
2009-11-15 pix 6 #.(set-dispatch-macro-character #\# #\T 'unify::|sharp-T-reader|)
14:25:29 ' 7
' 8 (defclass selector (unify::string-template)
' 9 ((matcher :reader matcher :initarg :matcher)))
' 10
' 11 (defgeneric selector-p (object)
' 12 (:method ((ob selector)) t)
' 13 (:method ((ob t)) nil))
' 14
2009-11-16 pix 15 (defclass simple-selector (selector)
2009-11-15 pix 16 ((arg :reader selector-arg :initarg :arg)))
14:25:29 ' 17
' 18 (defmethod print-object ((selector simple-selector) stream)
' 19 (format stream "#<selector ~s>" (selector-arg selector)))
' 20
' 21 (defclass combinator (selector) ())
2009-11-16 pix 22
08:14:42 ' 23 (defgeneric combinator-p (object)
' 24 (:method ((ob combinator)) t)
' 25 (:method ((ob t)) nil))
' 26
' 27 (defmethod print-object ((selector combinator) stream)
2009-11-21 pix 28 (format stream "#<~s ~s>" (class-name (class-of selector)) (matcher selector)))
2009-11-16 pix 29
2009-11-15 pix 30 (defclass child-combinator (combinator) ())
14:25:29 ' 31 (defclass descendant-combinator (combinator) ())
' 32 (defclass adjacent-combinator (combinator) ())
' 33 (defclass sibling-combinator (combinator) ())
' 34
2009-11-16 pix 35 (defclass universal-selector (simple-selector) ())
2009-11-15 pix 36 (defclass type-selector (simple-selector) ())
14:25:29 ' 37 (defclass id-selector (simple-selector) ())
' 38 (defclass class-selector (simple-selector) ())
2009-11-23 pix 39 (defclass nth-child-selector (simple-selector) ())
2009-11-30 pix 40 (defclass nth-last-child-selector (nth-child-selector) ())
2009-11-23 pix 41
11:33:15 ' 42 (defmethod print-object ((selector universal-selector) stream)
' 43 (format stream "#<universal-selector>"))
2009-11-15 pix 44
2009-11-16 pix 45 (defmethod initialize-instance :after ((template combinator) &key)
2009-11-15 pix 46 (unless (slot-boundp template 'matcher)
14:25:29 ' 47 (let ((selector (template-spec template)))
' 48 (setf (slot-value template 'matcher) (parse-selector (string-trim " " selector))))))
' 49
2010-01-01 pix 50 (warn "parse-selector currently relies on a patch which has not yet made ~
05:06:19 ' 51 it in to cl-unification. Be sure to apply the patch from ~
' 52 <http://common-lisp.net/pipermail/cl-unification-devel/attachments/20091201/d5021e15/attachment.obj> ~
' 53 to ensure proper functioning of the \"Oh, Ducks!\" library.")
' 54
2009-12-05 pix 55 (defclass %implicit-element-selector (selector) ())
07:18:05 ' 56 (defparameter %implicit-element-selector (make-instance '%implicit-element-selector))
2009-12-04 pix 57
2009-12-05 pix 58 (defmethod print-object ((selector %implicit-element-selector) stream)
2009-12-04 pix 59 (print-unreadable-object (selector stream :type t)))
04:47:58 ' 60
2009-11-15 pix 61 (defun parse-selector (selector)
14:25:29 ' 62 (match-case (selector)
' 63 ;; combinators
2010-01-04 pix 64 (#T(regexp$ "[ ]*[~][ ]*" ())
2009-12-05 pix 65 (list (make-instance 'sibling-combinator :matcher (or (parse-selector &rest) %implicit-element-selector))))
2010-01-04 pix 66 (#T(regexp$ "[ ]*[+][ ]*" ())
2009-12-05 pix 67 (list (make-instance 'adjacent-combinator :matcher (or (parse-selector &rest) %implicit-element-selector))))
2010-01-04 pix 68 (#T(regexp$ "[ ]*[>][ ]*" ())
2009-12-05 pix 69 (list (make-instance 'child-combinator :matcher (or (parse-selector &rest) %implicit-element-selector))))
2010-01-04 pix 70 (#T(regexp$ "[ ]+" ())
2009-12-05 pix 71 (list (make-instance 'descendant-combinator :matcher (or (parse-selector &rest) %implicit-element-selector))))
2009-11-23 pix 72 ;; simple selectors
2009-11-30 pix 73 ;; cyclic (An+B, n+B)
2010-01-04 pix 74 (#T(regexp$ ":nth-child\\([ ]*([+-]?)([0-9]+)?n[ ]*([+-])[ ]*([0-9]+)?[ ]*\\)" (?asign ?a ?bsign ?b))
2009-11-30 pix 75 (cons (make-instance 'nth-child-selector
2010-01-04 pix 76 :arg (cons (funcall (if (string= "-" asign) #'- #'+)
05:59:48 ' 77 (if (stringp a) (parse-integer a) 1))
' 78 (funcall (if (string= "-" bsign) #'- #'+)
' 79 (if (stringp b) (parse-integer b) 0))))
2009-11-30 pix 80 (parse-selector &rest)))
04:48:22 ' 81 ;; absolute (B)
2010-01-04 pix 82 (#T(regexp$ ":nth-child\\([ ]*([+-]?[0-9]+)[ ]*\\)" (?b))
05:59:48 ' 83 (cons (make-instance 'nth-child-selector :arg (cons 0 (parse-integer b))) (parse-selector &rest)))
2009-11-30 pix 84 ;; named (odd, even)
2010-01-04 pix 85 (#T(regexp$ ":nth-child\\([ ]*(odd|even)[ ]*\\)" (?which))
05:59:48 ' 86 (cons (make-instance 'nth-child-selector :arg (cons 2 (if (string-equal "odd" which) 1 0)))
2009-11-30 pix 87 (parse-selector &rest)))
2010-01-04 pix 88 (#T(regexp$ ":first-child" ())
05:59:48 ' 89 (cons (make-instance 'nth-child-selector :arg (cons 0 1)) (parse-selector &rest)))
' 90 (#T(regexp$ "[#](\\w+)" (?id))
2009-11-23 pix 91 (cons (make-instance 'id-selector :arg id) (parse-selector &rest)))
2010-01-04 pix 92 (#T(regexp$ "[\\.](\\w+)" (?class))
2009-11-23 pix 93 (cons (make-instance 'class-selector :arg class) (parse-selector &rest)))
2010-01-04 pix 94 (#T(regexp$ "(\\w+)" (?type))
2009-11-23 pix 95 (cons (make-instance 'type-selector :arg type) (parse-selector &rest)))
2010-01-04 pix 96 (#T(regexp$ "\\*" ())
2009-11-23 pix 97 (cons (make-instance 'universal-selector) (parse-selector &rest)))
13:14:00 ' 98 (t (unless (string= selector "")
' 99 (error "Unable to to parse selector: ~s" selector)))))
2009-11-15 pix 100
2010-01-04 pix 101 ;; Hrm... would something like this make things more or less clear?
05:59:48 ' 102 ;#t(lex$ (":nth-child(" :s? (?a :int) "n" :s? (or #\+ #\-) :s? (?b :int) :s? ")"))
' 103 ;#t(lex$ ("#" (?id :identifier)))
' 104 ;#t(lex$ (?type :identifier))
' 105
2009-12-05 pix 106 (defun find-matching-elements-in-list (selector element-list)
07:18:05 ' 107 (reduce #'nconc
' 108 (mapcar (curry #'find-matching-elements selector)
' 109 element-list)))
' 110
2010-01-04 pix 111 (defgeneric find-matching-elements (selector element)
2010-01-04 pix 112 (:method (selector (element t))
01:03:10 ' 113 (flet ((find-in-list (elements)
2010-01-04 pix 114 (mapcar (curry #'find-matching-elements selector)
2010-01-04 pix 115 elements)))
01:03:10 ' 116 (nconc
' 117 (when (element-matches-p element selector) (list element))
' 118 (reduce #'nconc
' 119 (find-in-list (element-children element)))))))
2009-11-15 pix 120
2010-01-04 pix 121 (defgeneric element-matches-p (element selector))
2009-11-15 pix 122
2010-01-04 pix 123 (defmethod element-matches-p (element (selector type-selector))
2009-11-15 pix 124 (element-type-equal element (selector-arg selector)))
14:25:29 ' 125
2010-01-04 pix 126 (defmethod element-matches-p (element (selector id-selector))
2009-11-15 pix 127 (string= (element-id element) (selector-arg selector)))
14:25:29 ' 128
2010-01-04 pix 129 (defmethod element-matches-p (element (selector nth-child-selector))
2010-01-04 pix 130 (when-let* ((parent (element-parent element))
05:59:48 ' 131 (pos (position element (funcall (typecase selector
' 132 (nth-last-child-selector #'reverse)
' 133 (nth-child-selector #'identity))
' 134 (element-children parent)) :test #'eq)))
' 135 (let ((pos (1+ pos))
' 136 (a (car (selector-arg selector)))
' 137 (b (cdr (selector-arg selector))))
' 138 ;; pos = An + B
' 139 (cond
' 140 ;; pos = 0n + B
' 141 ((= 0 a) (= b pos))
' 142 ;; (pos - B)/A = n
' 143 (t (and (zerop (mod (- pos b) a))
' 144 (not (minusp (/ (- pos b) a)))))))))
2009-11-23 pix 145
2010-01-04 pix 146 (defmethod element-matches-p (element (selector class-selector))
2009-11-15 pix 147 (member (selector-arg selector)
2010-01-04 pix 148 (element-classes element)
05:59:48 ' 149 :test #'string=))
2009-11-15 pix 150
2010-01-04 pix 151 (defmethod element-matches-p (element (selector universal-selector))
2009-12-03 pix 152 (declare (ignore element selector))
2009-11-19 pix 153 t)
06:25:36 ' 154
2009-12-05 pix 155 (defmethod element-matches-p (element (selector %implicit-element-selector))
07:18:05 ' 156 (eq element *implicit-element*))
2009-12-04 pix 157
2010-01-04 pix 158 (defmethod element-matches-p (element (selector list))
01:04:12 ' 159 (every (curry #'element-matches-p element) selector))
2009-11-16 pix 160
2010-01-04 pix 161 (defmethod element-matches-p (element (selector child-combinator))
01:04:12 ' 162 (element-matches-p (element-parent element) (matcher selector)))
2009-11-16 pix 163
2010-01-04 pix 164 (defmethod element-matches-p (element (selector descendant-combinator))
01:04:12 ' 165 (some (rcurry #'element-matches-p (matcher selector)) (element-ancestors element)))
2009-11-19 pix 166
2010-01-04 pix 167 (defmethod element-matches-p (element (selector adjacent-combinator))
2009-12-03 pix 168 (let* ((parent (element-parent element))
00:12:02 ' 169 (siblings (element-children parent))
' 170 (ourpos (position element siblings :test #'eq)))
' 171 (and ourpos
' 172 (> ourpos 0)
2010-01-04 pix 173 (element-matches-p (elt siblings (1- ourpos)) (matcher selector)))))
2009-11-19 pix 174
2010-01-04 pix 175 (defmethod element-matches-p (element (selector sibling-combinator))
2009-12-03 pix 176 (let* ((parent (element-parent element))
00:12:02 ' 177 (siblings (element-children parent))
' 178 (ourpos (position element siblings :test #'eq)))
' 179 (and ourpos
' 180 (> ourpos 0)
2010-01-04 pix 181 (find-if (rcurry #'element-matches-p (matcher selector)) siblings :end ourpos))))
2009-12-05 pix 182
07:18:05 ' 183 ;; Hello excessively long name
' 184 (defun terminating-implicit-sibling-combinator-p (selector)
' 185 (typecase selector
' 186 ((or sibling-combinator adjacent-combinator)
' 187 (typecase (matcher selector)
' 188 (%implicit-element-selector t)
' 189 (list (terminating-implicit-sibling-combinator-p (car (last (matcher selector)))))))
' 190 (combinator (terminating-implicit-sibling-combinator-p (matcher selector)))
' 191 (selector nil)
' 192 (null nil)
' 193 (list (terminating-implicit-sibling-combinator-p (car (last selector))))
' 194 (t nil)))
Sally sells sea-shells by the sea shore.