1 (in-package #:oh-ducks) 2 3 (defclass css-selector-template (unify::expression-template) 4 ((parser :initarg :parser :initform nil) ;; subtype generally determines parser 5 (specifiers :reader specifiers) ;; list of (specifier . variable) and (specifier . template) 6 )) 7 8 (defvar *model-handler-map* nil "A mapping between model types and handler functions.") 9 (defun add-handler (model handler) 10 (push (cons model handler) *model-handler-map*)) 11 (defun get-handler-for-model (model) 12 (let ((handler (cdr (assoc model *model-handler-map*)))) 13 (typecase handler 14 (null nil) 15 (function (funcall handler)) 16 (symbol (funcall (symbol-function handler))) 17 (t handler)))) 18 19 (defvar *default-parser* nil "Determines the default parser when none is specified.") 20 21 (defun %spec-includes-opts (spec) 22 (keywordp (first (second spec)))) 23 24 (defun combine-selectors (selector parent) 25 (let ((combinator (car (last selector)))) 26 (cond 27 ((null parent) 28 selector) 29 ((combinator-p combinator) 30 (setf (slot-value combinator 'matcher) parent) 31 selector) 32 (t 33 (nconc selector (list (make-instance 'descendant-combinator :matcher parent))))))) 34 35 (defun parse-specifiers (specs template parent) 36 (loop :for (css-specifier . rest) :in specs 37 :for selector = (combine-selectors (parse-selector css-specifier) parent) 38 :collect (cons selector 39 (cond 40 ((unify::template-p rest) rest) 41 ((unify::variablep rest) rest) 42 ((consp rest) 43 (make-instance (class-of template) 44 :spec (list* (first (template-spec template)) rest) 45 :css-specifiers rest 46 :parent selector)))))) 47 48 (defmethod initialize-instance :after ((template css-selector-template) &key css-specifiers parent) 49 (let* ((spec (template-spec template)) 50 (specifiers-and-vars (or css-specifiers (if (%spec-includes-opts spec) 51 (cddr spec) 52 (rest spec))))) 53 (setf (slot-value template 'specifiers) 54 (parse-specifiers specifiers-and-vars template parent)))) 55 56 ;; Don't bother trying to save :parser when compiling 57 (defmethod make-load-form ((object css-selector-template) &optional env) 58 (declare (ignore env)) 59 `(make-template ',(first (template-spec object)) ',(template-spec object)))