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)))