Compile constraints to list form rather than turning them into literals right away, add better support for superblocks and media queries.

compiler.lisp

@@ -57,7 +57,11 @@ T:        PRINC-TO-STRING of THING")
 
 (defun make-block (selector values)
   "Creates a block object with SELECTOR and VALUES."
-  (cons :block (cons selector values)))
+  (list* :block (list* :selector selector) values))
+
+(defun make-superblock (type selector blocks)
+  "Creates a block object that can contain other blocks, such as @media, etc."
+  (list* :superblock type (when selector (list* :selector selector)) blocks))
 
 (defgeneric compile-property (key value)
   (:documentation "Compile a property of KEY and VALUE to a list of property objects.
@@ -124,12 +128,14 @@ See DEFINE-SPECIAL-SELECTOR.")
       (loop with result = ()
             for func in cfunc
             do (loop for arg in cargs
-                     do (push (format NIL "~a ~a" func arg) result))
+                     do (push (list :constraint :child func arg) result))
             finally (return (compile-constraint (nreverse result) (cdr args))))))
   (:method ((func null) (args null))
     NIL)
   (:method (func (args null))
     func)
+  (:method ((func (eql :constraint)) args)
+    (list (list* func args)))
   (:method ((func (eql :or)) args)
     (apply #'append (mapcar #'compile-selector args)))
   (:method ((func (eql :and)) args)
@@ -140,7 +146,7 @@ See DEFINE-SPECIAL-SELECTOR.")
             (loop with result = ()
                   for func in cfunc
                   do (loop for arg in cargs
-                           do (push (format NIL "~a~a" func arg) result))
+                           do (push (list :constraint :concat func arg) result))
                   finally (return (compile-constraint :and (cons (cons :OR (nreverse result)) (cddr args))))))
           (if (and (listp (first args)) (eql (first (first args)) :OR))
               (rest (first args))
@@ -163,7 +169,43 @@ Returns a list with the RESOLVEd SELECTOR.")
   (:method ((selector list))
     (compile-constraint (car selector) (cdr selector)))
   (:method ((selector T))
-    (list (resolve selector))))
+    (list (list :constraint :literal (resolve selector)))))
+
+(defgeneric compile-media-constraint (func args)
+  (:method (func args)
+    (loop for prop in (compile-property func args)
+          collect (list* :constraint prop)))
+  (:method ((func null) (args null))
+    NIL)
+  (:method (func (args null))
+    func)
+  (:method ((func (eql :or)) args)
+    (loop for arg in args
+          nconc (compile-media-query arg)))
+  (:method ((func (eql :constraint)) args)
+    (list (list* func args)))
+  (:method ((func (eql :property)) args)
+    (list (list* :constraint func args)))
+  (:method ((func (eql :and)) args)
+    (cond ((rest args)
+           (let ((cfunc (compile-media-query (first args)))
+                 (cargs (compile-media-query (second args))))
+             (loop with result = ()
+                   for func in cfunc
+                   do (loop for arg in cargs
+                            do (push (list :constraint :and func arg) result))
+                   finally (return (compile-media-constraint :and (list* (list* :or (nreverse result))
+                                                                         (cddr args)))))))
+          (args
+           (compile-media-query (first args))))))
+
+(defgeneric compile-media-query (query)
+  (:method ((query null))
+    NIL)
+  (:method ((query list))
+    (compile-media-constraint (car query) (cdr query)))
+  (:method ((query T))
+    (list (list :constraint :literal (resolve query)))))
 
 (defgeneric consume-item (item readable-list)
   (:documentation "Consumes items from READABLE-LIST as required by the ITEM.

lass.asd

@@ -6,7 +6,7 @@
 
 (defsystem lass
   :name "LASS"
-  :version "0.5.0"
+  :version "0.6.0"
   :license "Artistic"
   :author "Nicolas Hafner <shinmera@tymoon.eu>"
   :maintainer "Nicolas Hafner <shinmera@tymoon.eu>"

special.lisp

@@ -62,11 +62,11 @@
            (list (format NIL "@keyframes ~a" (resolve identifier)))
            inner))))
 
-(define-special-block media (selector &rest body)
+(define-special-block media (query &rest body)
-  (let ((inner (apply #'compile-sheet body)))
+  (list (make-superblock
-    (list (make-block
+         "media"
-           (list (format NIL "@media~{ ~a~^,~}" (compile-selector selector)))
+         (compile-media-query query)
-           inner))))
+         (apply #'compile-sheet body))))
 
 (define-special-block namespace (prefix/namespace &optional namespace)
   (list (make-property

writer.lisp

@@ -34,22 +34,57 @@ necessary if *PRETTY* is non-NIL.
 Prints the KEY. If VALUE is non-NIL, a colon is printed followed by the
 VALUE. Finally a semicolon is printed. Spaces may be inserted where necessary
 if *PRETTY* is non-NIL.")
+  (:method ((type (eql :superblock)) block stream)
+    (when (and block (cddr block))
+      (destructuring-bind (type selector &rest blocks) block
+        (format stream "~a@~a" (indent) type)
+        (when selector
+          (format stream " ")
+          (let ((*indent-level* (+ *indent-level* 2 (length type))))
+            (write-sheet-object (car selector) (cdr selector) stream)))
+        (format stream "{")
+        (let ((*indent-level* (+ *indent-level* 4)))
+          (dolist (block blocks)
+            (when *pretty* (fresh-line stream))
+            (write-sheet-object (car block) (cdr block) stream)))
+        (format stream "~@[~&~*~]~a}" *pretty* (indent)))))
+  
   (:method ((type (eql :block)) block stream)
     (when (and block (cdr block))
-      (let ((true-format (format NIL "~a~~{~~a~~^,~@[~%~:*~a~* ~]~~}{~:*~@[~*~%~]~~{~~/lass::write-sheet-part/~~^~:*~@[~*~%~]~~}~:*~@[~*~%~]~:*~:*~a~*}"
+      (destructuring-bind (selector &rest body) block
-                                 (indent) *pretty*))
+        (format stream "~a" (indent))
-            (*indent-level* (+ *indent-level* 4)))
+        (write-sheet-object (car selector) (cdr selector) stream)
-        (format stream true-format
+        (format stream "{")
-                (car block) (cdr block)))))
+        (let ((*indent-level* (+ *indent-level* 4)))
+          (dolist (inner body)
+            (when *pretty* (fresh-line stream))
+            (write-sheet-object (car inner) (cdr inner) stream)))
+        (format stream "~@[~&~*~]~a}" *pretty* (indent)))))
 
   (:method ((type (eql :property)) attribute stream)
     (when attribute
-      (format stream (format NIL "~a~~a~~@[:~@[~* ~]~~a~~];" (indent) *pretty*)
+      (format stream "~a~a~:[~@[:~a~]~;~@[: ~a~]~];" (indent) (first attribute) *pretty* (second attribute))))
-              (first attribute) (second attribute))))
+  
+  (:method ((type (eql :constraint)) constraint stream)
+    (ecase (first constraint)
+      ((NIL))
+      (:child (format stream "~{~/lass::write-sheet-part/~^ ~}" (rest constraint)))
+      (:concat (format stream "~{~/lass::write-sheet-part/~}" (rest constraint)))
+      (:property (format stream "(~a:~@[~* ~]~a)" (second constraint) *pretty* (third constraint)))
+      (:and (format stream "~{~/lass::write-sheet-part/~^ and ~}" (rest constraint)))
+      (:literal (format stream "~a" (second constraint)))))
 
   (:method ((type (eql :text)) block stream)
     (when block
-      (format stream "~{~a~}~@[~*~%~]" block *pretty*))))
+      (format stream "~{~a~}~@[~*~%~]" block *pretty*)))
+
+  (:method ((type (eql :selector)) constraints stream)
+    (when constraints
+      (write-sheet-object (car (first constraints)) (cdr (first constraints)) stream)
+      (dolist (constraint (rest constraints))
+        (format stream ",")
+        (when *pretty* (format stream "~&~a" (indent)))
+        (write-sheet-object (car constraint) (cdr constraint) stream)))))
 
 (defun write-sheet-part (stream block cp ap)
   "Wrapper around WRITE-SHEET-OBJECT so that we can call it from FORMAT.