repos / Oh, Ducks! / annotate_shade
summary | shortlog | log | tree | commit | commitdiff | headdiff | annotate | headblob | headfilediff | filehistory
normal | plain | shade | zebra
Minimal support for attribute-starts-with selector
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) ())
2010-01-04 pix 41 (defclass nth-of-type-selector (nth-child-selector) ())
06:32:07 ' 42 (defclass nth-last-of-type-selector (nth-of-type-selector) ())
2010-01-04 pix 43 (defclass empty-selector (simple-selector) ())
2009-11-23 pix 44
2010-02-10 pix 45 (defclass attribute-selector (simple-selector)
08:50:16 ' 46 ((val :reader attribute-value :initarg :value)))
2010-02-10 pix 47 (defclass attribute-present-selector (attribute-selector) ())
2010-02-10 pix 48 (defclass attribute-equal-selector (attribute-selector) ())
2011-07-03 pix 49 (defclass attribute-starts-with-selector (attribute-selector) ())
2010-02-10 pix 50
2010-01-04 pix 51 (defmethod initialize-instance :after ((selector nth-child-selector)
05:59:48 ' 52 &key (asign "+") a
' 53 (bsign "+") b
' 54 namedp)
' 55 (setf (slot-value selector 'arg)
' 56 (if namedp
' 57 (cons 2 (if (string-equal "odd" b) 1 0))
' 58 (cons (parse-integer (format nil "~a~a" asign (or a 1)))
' 59 (parse-integer (format nil "~a~a" bsign (or b 0)))))))
' 60
2009-11-23 pix 61 (defmethod print-object ((selector universal-selector) stream)
11:33:15 ' 62 (format stream "#<universal-selector>"))
2009-11-15 pix 63
2009-11-16 pix 64 (defmethod initialize-instance :after ((template combinator) &key)
2009-11-15 pix 65 (unless (slot-boundp template 'matcher)
14:25:29 ' 66 (let ((selector (template-spec template)))
' 67 (setf (slot-value template 'matcher) (parse-selector (string-trim " " selector))))))
' 68
2009-12-05 pix 69 (defclass %implicit-element-selector (selector) ())
07:18:05 ' 70 (defparameter %implicit-element-selector (make-instance '%implicit-element-selector))
2009-12-04 pix 71
2009-12-05 pix 72 (defmethod print-object ((selector %implicit-element-selector) stream)
2009-12-04 pix 73 (print-unreadable-object (selector stream :type t)))
04:47:58 ' 74
2010-01-04 pix 75 (cl-ppcre:define-parse-tree-synonym \s*
05:59:48 ' 76 (:non-greedy-repetition 0 nil :whitespace-char-class))
' 77 (cl-ppcre:define-parse-tree-synonym \s+
' 78 (:greedy-repetition 1 nil :whitespace-char-class))
' 79 (cl-ppcre:define-parse-tree-synonym sign
' 80 (:char-class #\+ #\-))
' 81 (cl-ppcre:define-parse-tree-synonym sign?
' 82 (:greedy-repetition 0 1 sign))
' 83 (cl-ppcre:define-parse-tree-synonym integer
' 84 (:greedy-repetition 1 nil :digit-class))
' 85 (cl-ppcre:define-parse-tree-synonym name
' 86 (:greedy-repetition 1 nil (:char-class :word-char-class #\-)))
' 87 (cl-ppcre:define-parse-tree-synonym $name
' 88 (:register name))
' 89 (cl-ppcre:define-parse-tree-synonym an+b
' 90 (:sequence
' 91 (:register sign?) (:greedy-repetition 0 1 (:register integer))
' 92 #\n \s*
' 93 (:register sign?) \s* (:greedy-repetition 0 1 (:register integer))))
' 94 (cl-ppcre:define-parse-tree-synonym b
' 95 (:register (:sequence sign? integer)))
' 96 (cl-ppcre:define-parse-tree-synonym odd/even
' 97 (:register (:alternation "odd" "even")))
' 98
2010-01-02 pix 99 ;; FIXME: proper parsing (e.g., by using the W3C's provided FLEX and YACC bits).
2009-11-15 pix 100 (defun parse-selector (selector)
14:25:29 ' 101 (match-case (selector)
' 102 ;; combinators
2010-01-04 pix 103 (#T(regexp$ (\s* #\~ \s*) ())
2009-12-05 pix 104 (list (make-instance 'sibling-combinator :matcher (or (parse-selector &rest) %implicit-element-selector))))
2010-01-04 pix 105 (#T(regexp$ (\s* #\+ \s*) ())
2009-12-05 pix 106 (list (make-instance 'adjacent-combinator :matcher (or (parse-selector &rest) %implicit-element-selector))))
2010-01-04 pix 107 (#T(regexp$ (\s* #\> \s*) ())
2009-12-05 pix 108 (list (make-instance 'child-combinator :matcher (or (parse-selector &rest) %implicit-element-selector))))
2010-01-04 pix 109 (#T(regexp$ (\s+) ())
2009-12-05 pix 110 (list (make-instance 'descendant-combinator :matcher (or (parse-selector &rest) %implicit-element-selector))))
2009-11-23 pix 111 ;; simple selectors
2010-02-10 pix 112 ;; attribute selectors
08:28:34 ' 113 (#T(regexp$ ("[" $name "]") (?attribute))
' 114 (cons (make-instance 'attribute-present-selector :arg attribute)
' 115 (parse-selector &rest)))
2010-02-10 pix 116 (#T(regexp$ ("[" $name "=" $name "]") (?attribute ?value))
08:50:16 ' 117 (cons (make-instance 'attribute-equal-selector :arg attribute :value value)
' 118 (parse-selector &rest)))
2011-07-03 pix 119 (#T(regexp$ ("[" $name "^=" $name "]") (?attribute ?value))
07:55:18 ' 120 (cons (make-instance 'attribute-starts-with-selector :arg attribute :value value)
' 121 (parse-selector &rest)))
2009-11-30 pix 122 ;; cyclic (An+B, n+B)
2010-01-04 pix 123 (#T(regexp$ (":nth-child(" \s* an+b \s* ")")
05:59:48 ' 124 (?asign ?a ?bsign ?b))
2009-11-30 pix 125 (cons (make-instance 'nth-child-selector
2010-01-04 pix 126 :asign asign :a a
05:59:48 ' 127 :bsign bsign :b b)
' 128 (parse-selector &rest)))
' 129 (#T(regexp$ (":nth-last-child(" \s* an+b \s* ")")
' 130 (?asign ?a ?bsign ?b))
' 131 (cons (make-instance 'nth-last-child-selector
' 132 :asign asign :a a
' 133 :bsign bsign :b b)
2009-11-30 pix 134 (parse-selector &rest)))
2010-01-04 pix 135 (#T(regexp$ (":nth-of-type(" \s* an+b \s* ")")
06:32:07 ' 136 (?asign ?a ?bsign ?b))
' 137 (cons (make-instance 'nth-of-type-selector
' 138 :asign asign :a a
' 139 :bsign bsign :b b)
' 140 (parse-selector &rest)))
' 141 (#T(regexp$ (":nth-last-of-type(" \s* an+b \s* ")")
' 142 (?asign ?a ?bsign ?b))
' 143 (cons (make-instance 'nth-last-of-type-selector
' 144 :asign asign :a a
' 145 :bsign bsign :b b)
' 146 (parse-selector &rest)))
2009-11-30 pix 147 ;; absolute (B)
2010-01-04 pix 148 (#T(regexp$ (":nth-child(" \s* b \s* ")")
05:59:48 ' 149 (?b))
' 150 (cons (make-instance 'nth-child-selector :a 0 :b b)
' 151 (parse-selector &rest)))
' 152 (#T(regexp$ (":nth-last-child(" \s* b \s* ")")
' 153 (?b))
' 154 (cons (make-instance 'nth-last-child-selector :a 0 :b b)
' 155 (parse-selector &rest)))
2010-01-04 pix 156 (#T(regexp$ (":nth-of-type(" \s* b \s* ")")
06:32:07 ' 157 (?b))
' 158 (cons (make-instance 'nth-of-type-selector :a 0 :b b)
' 159 (parse-selector &rest)))
' 160 (#T(regexp$ (":nth-last-of-type(" \s* b \s* ")")
' 161 (?b))
' 162 (cons (make-instance 'nth-last-of-type-selector :a 0 :b b)
' 163 (parse-selector &rest)))
2009-11-30 pix 164 ;; named (odd, even)
2010-01-04 pix 165 (#T(regexp$ (":nth-child(" \s* odd/even \s* ")")
05:59:48 ' 166 (?which))
' 167 (cons (make-instance 'nth-child-selector :namedp t :b which)
' 168 (parse-selector &rest)))
' 169 (#T(regexp$ (":nth-last-child(" \s* odd/even \s* ")")
' 170 (?which))
' 171 (cons (make-instance 'nth-last-child-selector :namedp t :b which)
2009-11-30 pix 172 (parse-selector &rest)))
2010-01-04 pix 173 (#T(regexp$ (":nth-of-type(" \s* odd/even \s* ")")
06:32:07 ' 174 (?which))
' 175 (cons (make-instance 'nth-of-type-selector :namedp t :b which)
' 176 (parse-selector &rest)))
' 177 (#T(regexp$ (":nth-last-of-type(" \s* odd/even \s* ")")
' 178 (?which))
' 179 (cons (make-instance 'nth-last-of-type-selector :namedp t :b which)
' 180 (parse-selector &rest)))
2010-01-04 pix 181 ;; Everybody else
05:59:48 ' 182 (#T(regexp$ (":first-child") ())
' 183 (cons (make-instance 'nth-child-selector :a 0 :b 1)
' 184 (parse-selector &rest)))
' 185 (#T(regexp$ (":last-child") ())
' 186 (cons (make-instance 'nth-last-child-selector :a 0 :b 1)
' 187 (parse-selector &rest)))
' 188 (#T(regexp$ (":only-child") ())
' 189 (list* (make-instance 'nth-child-selector :a 0 :b 1)
' 190 (make-instance 'nth-last-child-selector :a 0 :b 1)
' 191 (parse-selector &rest)))
2010-01-04 pix 192 (#T(regexp$ (":first-of-type") ())
06:32:07 ' 193 (cons (make-instance 'nth-of-type-selector :a 0 :b 1)
' 194 (parse-selector &rest)))
' 195 (#T(regexp$ (":last-of-type") ())
' 196 (cons (make-instance 'nth-last-of-type-selector :a 0 :b 1)
' 197 (parse-selector &rest)))
' 198 (#T(regexp$ (":only-of-type") ())
' 199 (list* (make-instance 'nth-of-type-selector :a 0 :b 1)
' 200 (make-instance 'nth-last-of-type-selector :a 0 :b 1)
' 201 (parse-selector &rest)))
2010-01-04 pix 202 (#T(regexp$ (":empty") ())
06:32:27 ' 203 (cons (make-instance 'empty-selector) (parse-selector &rest)))
2010-01-04 pix 204 (#T(regexp$ (#\# $name) (?id))
2009-11-23 pix 205 (cons (make-instance 'id-selector :arg id) (parse-selector &rest)))
2010-01-04 pix 206 (#T(regexp$ (#\. $name) (?class))
2009-11-23 pix 207 (cons (make-instance 'class-selector :arg class) (parse-selector &rest)))
2010-01-04 pix 208 (#T(regexp$ ($name) (?type))
2009-11-23 pix 209 (cons (make-instance 'type-selector :arg type) (parse-selector &rest)))
2010-01-04 pix 210 (#T(regexp$ (#\*) ())
2009-11-23 pix 211 (cons (make-instance 'universal-selector) (parse-selector &rest)))
13:14:00 ' 212 (t (unless (string= selector "")
' 213 (error "Unable to to parse selector: ~s" selector)))))
2009-11-15 pix 214
2010-01-04 pix 215 (defun subjects-in-list (selector element-list)
2009-12-05 pix 216 (reduce #'nconc
2010-01-04 pix 217 (mapcar (curry #'subjects-of selector)
2009-12-05 pix 218 element-list)))
07:18:05 ' 219
2010-01-04 pix 220 (defun subjects-of (selector element)
01:03:10 ' 221 (nconc
2010-01-04 pix 222 (when (subject-p selector element) (list element))
2010-01-04 pix 223 (subjects-in-list selector (element-children element))))
2009-11-15 pix 224
2010-01-04 pix 225 (defgeneric subject-p (selector element))
2009-11-15 pix 226
2010-01-04 pix 227 (defmethod subject-p ((selector type-selector) element)
2009-11-15 pix 228 (element-type-equal element (selector-arg selector)))
14:25:29 ' 229
2010-01-04 pix 230 (defmethod subject-p ((selector id-selector) element)
2009-11-15 pix 231 (string= (element-id element) (selector-arg selector)))
14:25:29 ' 232
2010-01-04 pix 233 (defun an+b? (a b element siblings)
05:59:48 ' 234 (when-let* ((pos (1+ (position element siblings :test #'eq))))
' 235 ;; pos = An + B
' 236 (cond
' 237 ;; pos = 0n + B
' 238 ((= 0 a) (= b pos))
' 239 ;; (pos - B)/A = n
' 240 (t (and (zerop (mod (- pos b) a))
' 241 (not (minusp (/ (- pos b) a))))))))
' 242
2010-01-04 pix 243 (defmethod subject-p ((selector nth-child-selector) element)
2010-01-04 pix 244 (when-let* ((arg (selector-arg selector))
05:59:48 ' 245 (parent (element-parent element)))
' 246 (an+b? (car arg) (cdr arg) element (element-children parent))))
' 247
' 248 (defmethod subject-p ((selector nth-last-child-selector) element)
' 249 (when-let* ((arg (selector-arg selector))
' 250 (parent (element-parent element)))
' 251 (an+b? (car arg) (cdr arg) element (reverse (element-children parent)))))
2009-11-23 pix 252
2010-01-04 pix 253 (defmethod subject-p ((selector nth-of-type-selector) element)
06:32:07 ' 254 (when-let* ((arg (selector-arg selector))
' 255 (parent (element-parent element)))
' 256 (an+b? (car arg) (cdr arg) element
' 257 (remove-if-not (rcurry #'element-type-equal (element-type element))
' 258 (element-children parent)))))
' 259
' 260 (defmethod subject-p ((selector nth-last-of-type-selector) element)
' 261 (when-let* ((arg (selector-arg selector))
' 262 (parent (element-parent element)))
' 263 (an+b? (car arg) (cdr arg) element
' 264 (reverse
' 265 (remove-if-not (rcurry #'element-type-equal (element-type element))
' 266 (element-children parent))))))
' 267
2010-01-04 pix 268 (defmethod subject-p ((selector empty-selector) element)
06:32:27 ' 269 (= 0 (length (element-children element))))
' 270
2010-01-04 pix 271 (defmethod subject-p ((selector class-selector) element)
2009-11-15 pix 272 (member (selector-arg selector)
2010-01-04 pix 273 (element-classes element)
05:59:48 ' 274 :test #'string=))
2009-11-15 pix 275
2010-01-04 pix 276 (defmethod subject-p ((selector universal-selector) element)
2009-12-03 pix 277 (declare (ignore element selector))
2009-11-19 pix 278 t)
06:25:36 ' 279
2010-02-10 pix 280 (defmethod subject-p ((selector attribute-present-selector) element)
08:28:34 ' 281 (element-attribute (selector-arg selector) element))
' 282
2010-02-10 pix 283 (defmethod subject-p ((selector attribute-equal-selector) element)
08:50:16 ' 284 (when-let* ((val (element-attribute (selector-arg selector) element)))
' 285 (string= val (attribute-value selector))))
' 286
2011-07-03 pix 287 (defmethod subject-p ((selector attribute-starts-with-selector) element)
07:55:18 ' 288 (when-let* ((val (element-attribute (selector-arg selector) element)))
' 289 (alexandria:starts-with-subseq (string-downcase (attribute-value selector)) (string-downcase val))))
' 290
2010-01-04 pix 291 (defmethod subject-p ((selector %implicit-element-selector) element)
2009-12-05 pix 292 (eq element *implicit-element*))
2009-12-04 pix 293
2010-01-04 pix 294 (defmethod subject-p ((selector list) element)
01:07:02 ' 295 (every (rcurry #'subject-p element) selector))
2009-11-16 pix 296
2010-01-04 pix 297 (defmethod subject-p ((selector child-combinator) element)
01:07:02 ' 298 (subject-p (matcher selector) (element-parent element)))
2009-11-16 pix 299
2010-01-04 pix 300 (defmethod subject-p ((selector descendant-combinator) element)
01:07:02 ' 301 (some (curry #'subject-p (matcher selector)) (element-ancestors element)))
2009-11-19 pix 302
2010-01-04 pix 303 (defmethod subject-p ((selector adjacent-combinator) element)
2009-12-03 pix 304 (let* ((parent (element-parent element))
00:12:02 ' 305 (siblings (element-children parent))
' 306 (ourpos (position element siblings :test #'eq)))
' 307 (and ourpos
' 308 (> ourpos 0)
2010-01-04 pix 309 (subject-p (matcher selector) (elt siblings (1- ourpos))))))
2009-11-19 pix 310
2010-01-04 pix 311 (defmethod subject-p ((selector sibling-combinator) element)
2009-12-03 pix 312 (let* ((parent (element-parent element))
00:12:02 ' 313 (siblings (element-children parent))
' 314 (ourpos (position element siblings :test #'eq)))
' 315 (and ourpos
' 316 (> ourpos 0)
2010-01-04 pix 317 (find-if (curry #'subject-p (matcher selector)) siblings :end ourpos))))
2009-12-05 pix 318
07:18:05 ' 319 ;; Hello excessively long name
' 320 (defun terminating-implicit-sibling-combinator-p (selector)
' 321 (typecase selector
' 322 ((or sibling-combinator adjacent-combinator)
' 323 (typecase (matcher selector)
' 324 (%implicit-element-selector t)
' 325 (list (terminating-implicit-sibling-combinator-p (car (last (matcher selector)))))))
' 326 (combinator (terminating-implicit-sibling-combinator-p (matcher selector)))
' 327 (selector nil)
' 328 (null nil)
' 329 (list (terminating-implicit-sibling-combinator-p (car (last selector))))
' 330 (t nil)))
There once was a man from Nantucket…