repos / Oh, Ducks! / annotate_shade
summary | shortlog | log | tree | commit | commitdiff | headdiff | annotate | headblob | headfilediff | filehistory
normal | plain | shade | zebra
"lispier" regexps, l*last-child stuff
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
2010-01-04 pix 42 (defmethod initialize-instance :after ((selector nth-child-selector)
05:59:48 ' 43 &key (asign "+") a
' 44 (bsign "+") b
' 45 namedp)
' 46 (setf (slot-value selector 'arg)
' 47 (if namedp
' 48 (cons 2 (if (string-equal "odd" b) 1 0))
' 49 (cons (parse-integer (format nil "~a~a" asign (or a 1)))
' 50 (parse-integer (format nil "~a~a" bsign (or b 0)))))))
' 51
2009-11-23 pix 52 (defmethod print-object ((selector universal-selector) stream)
11:33:15 ' 53 (format stream "#<universal-selector>"))
2009-11-15 pix 54
2009-11-16 pix 55 (defmethod initialize-instance :after ((template combinator) &key)
2009-11-15 pix 56 (unless (slot-boundp template 'matcher)
14:25:29 ' 57 (let ((selector (template-spec template)))
' 58 (setf (slot-value template 'matcher) (parse-selector (string-trim " " selector))))))
' 59
2009-12-05 pix 60 (defclass %implicit-element-selector (selector) ())
07:18:05 ' 61 (defparameter %implicit-element-selector (make-instance '%implicit-element-selector))
2009-12-04 pix 62
2009-12-05 pix 63 (defmethod print-object ((selector %implicit-element-selector) stream)
2009-12-04 pix 64 (print-unreadable-object (selector stream :type t)))
04:47:58 ' 65
2010-01-04 pix 66 (cl-ppcre:define-parse-tree-synonym \s*
05:59:48 ' 67 (:non-greedy-repetition 0 nil :whitespace-char-class))
' 68 (cl-ppcre:define-parse-tree-synonym \s+
' 69 (:greedy-repetition 1 nil :whitespace-char-class))
' 70 (cl-ppcre:define-parse-tree-synonym sign
' 71 (:char-class #\+ #\-))
' 72 (cl-ppcre:define-parse-tree-synonym sign?
' 73 (:greedy-repetition 0 1 sign))
' 74 (cl-ppcre:define-parse-tree-synonym integer
' 75 (:greedy-repetition 1 nil :digit-class))
' 76 (cl-ppcre:define-parse-tree-synonym name
' 77 (:greedy-repetition 1 nil (:char-class :word-char-class #\-)))
' 78 (cl-ppcre:define-parse-tree-synonym $name
' 79 (:register name))
' 80 (cl-ppcre:define-parse-tree-synonym an+b
' 81 (:sequence
' 82 (:register sign?) (:greedy-repetition 0 1 (:register integer))
' 83 #\n \s*
' 84 (:register sign?) \s* (:greedy-repetition 0 1 (:register integer))))
' 85 (cl-ppcre:define-parse-tree-synonym b
' 86 (:register (:sequence sign? integer)))
' 87 (cl-ppcre:define-parse-tree-synonym odd/even
' 88 (:register (:alternation "odd" "even")))
' 89
2010-01-02 pix 90 ;; FIXME: proper parsing (e.g., by using the W3C's provided FLEX and YACC bits).
2009-11-15 pix 91 (defun parse-selector (selector)
14:25:29 ' 92 (match-case (selector)
' 93 ;; combinators
2010-01-04 pix 94 (#T(regexp$ (\s* #\~ \s*) ())
2009-12-05 pix 95 (list (make-instance 'sibling-combinator :matcher (or (parse-selector &rest) %implicit-element-selector))))
2010-01-04 pix 96 (#T(regexp$ (\s* #\+ \s*) ())
2009-12-05 pix 97 (list (make-instance 'adjacent-combinator :matcher (or (parse-selector &rest) %implicit-element-selector))))
2010-01-04 pix 98 (#T(regexp$ (\s* #\> \s*) ())
2009-12-05 pix 99 (list (make-instance 'child-combinator :matcher (or (parse-selector &rest) %implicit-element-selector))))
2010-01-04 pix 100 (#T(regexp$ (\s+) ())
2009-12-05 pix 101 (list (make-instance 'descendant-combinator :matcher (or (parse-selector &rest) %implicit-element-selector))))
2009-11-23 pix 102 ;; simple selectors
2009-11-30 pix 103 ;; cyclic (An+B, n+B)
2010-01-04 pix 104 (#T(regexp$ (":nth-child(" \s* an+b \s* ")")
05:59:48 ' 105 (?asign ?a ?bsign ?b))
2009-11-30 pix 106 (cons (make-instance 'nth-child-selector
2010-01-04 pix 107 :asign asign :a a
05:59:48 ' 108 :bsign bsign :b b)
' 109 (parse-selector &rest)))
' 110 (#T(regexp$ (":nth-last-child(" \s* an+b \s* ")")
' 111 (?asign ?a ?bsign ?b))
' 112 (cons (make-instance 'nth-last-child-selector
' 113 :asign asign :a a
' 114 :bsign bsign :b b)
2009-11-30 pix 115 (parse-selector &rest)))
04:48:22 ' 116 ;; absolute (B)
2010-01-04 pix 117 (#T(regexp$ (":nth-child(" \s* b \s* ")")
05:59:48 ' 118 (?b))
' 119 (cons (make-instance 'nth-child-selector :a 0 :b b)
' 120 (parse-selector &rest)))
' 121 (#T(regexp$ (":nth-last-child(" \s* b \s* ")")
' 122 (?b))
' 123 (cons (make-instance 'nth-last-child-selector :a 0 :b b)
' 124 (parse-selector &rest)))
2009-11-30 pix 125 ;; named (odd, even)
2010-01-04 pix 126 (#T(regexp$ (":nth-child(" \s* odd/even \s* ")")
05:59:48 ' 127 (?which))
' 128 (cons (make-instance 'nth-child-selector :namedp t :b which)
' 129 (parse-selector &rest)))
' 130 (#T(regexp$ (":nth-last-child(" \s* odd/even \s* ")")
' 131 (?which))
' 132 (cons (make-instance 'nth-last-child-selector :namedp t :b which)
2009-11-30 pix 133 (parse-selector &rest)))
2010-01-04 pix 134 ;; Everybody else
05:59:48 ' 135 (#T(regexp$ (":first-child") ())
' 136 (cons (make-instance 'nth-child-selector :a 0 :b 1)
' 137 (parse-selector &rest)))
' 138 (#T(regexp$ (":last-child") ())
' 139 (cons (make-instance 'nth-last-child-selector :a 0 :b 1)
' 140 (parse-selector &rest)))
' 141 (#T(regexp$ (":only-child") ())
' 142 (list* (make-instance 'nth-child-selector :a 0 :b 1)
' 143 (make-instance 'nth-last-child-selector :a 0 :b 1)
' 144 (parse-selector &rest)))
' 145 (#T(regexp$ (#\# $name) (?id))
2009-11-23 pix 146 (cons (make-instance 'id-selector :arg id) (parse-selector &rest)))
2010-01-04 pix 147 (#T(regexp$ (#\. $name) (?class))
2009-11-23 pix 148 (cons (make-instance 'class-selector :arg class) (parse-selector &rest)))
2010-01-04 pix 149 (#T(regexp$ ($name) (?type))
2009-11-23 pix 150 (cons (make-instance 'type-selector :arg type) (parse-selector &rest)))
2010-01-04 pix 151 (#T(regexp$ (#\*) ())
2009-11-23 pix 152 (cons (make-instance 'universal-selector) (parse-selector &rest)))
13:14:00 ' 153 (t (unless (string= selector "")
' 154 (error "Unable to to parse selector: ~s" selector)))))
2009-11-15 pix 155
2010-01-04 pix 156 (defun subjects-in-list (selector element-list)
2009-12-05 pix 157 (reduce #'nconc
2010-01-04 pix 158 (mapcar (curry #'subjects-of selector)
2009-12-05 pix 159 element-list)))
07:18:05 ' 160
2010-01-04 pix 161 (defun subjects-of (selector element)
01:03:10 ' 162 (nconc
2010-01-04 pix 163 (when (subject-p selector element) (list element))
2010-01-04 pix 164 (subjects-in-list selector (element-children element))))
2009-11-15 pix 165
2010-01-04 pix 166 (defgeneric subject-p (selector element))
2009-11-15 pix 167
2010-01-04 pix 168 (defmethod subject-p ((selector type-selector) element)
2009-11-15 pix 169 (element-type-equal element (selector-arg selector)))
14:25:29 ' 170
2010-01-04 pix 171 (defmethod subject-p ((selector id-selector) element)
2009-11-15 pix 172 (string= (element-id element) (selector-arg selector)))
14:25:29 ' 173
2010-01-04 pix 174 (defun an+b? (a b element siblings)
05:59:48 ' 175 (when-let* ((pos (1+ (position element siblings :test #'eq))))
' 176 ;; pos = An + B
' 177 (cond
' 178 ;; pos = 0n + B
' 179 ((= 0 a) (= b pos))
' 180 ;; (pos - B)/A = n
' 181 (t (and (zerop (mod (- pos b) a))
' 182 (not (minusp (/ (- pos b) a))))))))
' 183
2010-01-04 pix 184 (defmethod subject-p ((selector nth-child-selector) element)
2010-01-04 pix 185 (when-let* ((arg (selector-arg selector))
05:59:48 ' 186 (parent (element-parent element)))
' 187 (an+b? (car arg) (cdr arg) element (element-children parent))))
' 188
' 189 (defmethod subject-p ((selector nth-last-child-selector) element)
' 190 (when-let* ((arg (selector-arg selector))
' 191 (parent (element-parent element)))
' 192 (an+b? (car arg) (cdr arg) element (reverse (element-children parent)))))
2009-11-23 pix 193
2010-01-04 pix 194 (defmethod subject-p ((selector class-selector) element)
2009-11-15 pix 195 (member (selector-arg selector)
2010-01-04 pix 196 (element-classes element)
05:59:48 ' 197 :test #'string=))
2009-11-15 pix 198
2010-01-04 pix 199 (defmethod subject-p ((selector universal-selector) element)
2009-12-03 pix 200 (declare (ignore element selector))
2009-11-19 pix 201 t)
06:25:36 ' 202
2010-01-04 pix 203 (defmethod subject-p ((selector %implicit-element-selector) element)
2009-12-05 pix 204 (eq element *implicit-element*))
2009-12-04 pix 205
2010-01-04 pix 206 (defmethod subject-p ((selector list) element)
01:07:02 ' 207 (every (rcurry #'subject-p element) selector))
2009-11-16 pix 208
2010-01-04 pix 209 (defmethod subject-p ((selector child-combinator) element)
01:07:02 ' 210 (subject-p (matcher selector) (element-parent element)))
2009-11-16 pix 211
2010-01-04 pix 212 (defmethod subject-p ((selector descendant-combinator) element)
01:07:02 ' 213 (some (curry #'subject-p (matcher selector)) (element-ancestors element)))
2009-11-19 pix 214
2010-01-04 pix 215 (defmethod subject-p ((selector adjacent-combinator) element)
2009-12-03 pix 216 (let* ((parent (element-parent element))
00:12:02 ' 217 (siblings (element-children parent))
' 218 (ourpos (position element siblings :test #'eq)))
' 219 (and ourpos
' 220 (> ourpos 0)
2010-01-04 pix 221 (subject-p (matcher selector) (elt siblings (1- ourpos))))))
2009-11-19 pix 222
2010-01-04 pix 223 (defmethod subject-p ((selector sibling-combinator) element)
2009-12-03 pix 224 (let* ((parent (element-parent element))
00:12:02 ' 225 (siblings (element-children parent))
' 226 (ourpos (position element siblings :test #'eq)))
' 227 (and ourpos
' 228 (> ourpos 0)
2010-01-04 pix 229 (find-if (curry #'subject-p (matcher selector)) siblings :end ourpos))))
2009-12-05 pix 230
07:18:05 ' 231 ;; Hello excessively long name
' 232 (defun terminating-implicit-sibling-combinator-p (selector)
' 233 (typecase selector
' 234 ((or sibling-combinator adjacent-combinator)
' 235 (typecase (matcher selector)
' 236 (%implicit-element-selector t)
' 237 (list (terminating-implicit-sibling-combinator-p (car (last (matcher selector)))))))
' 238 (combinator (terminating-implicit-sibling-combinator-p (matcher selector)))
' 239 (selector nil)
' 240 (null nil)
' 241 (list (terminating-implicit-sibling-combinator-p (car (last selector))))
' 242 (t nil)))
There once was a man from Nantucket…