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

This commit is contained in:
Shinmera 2018-07-29 10:39:30 +02:00
parent 580f474ebf
commit 0e0ef5de4a
No known key found for this signature in database
GPG key ID: E12B14478BE4C922
4 changed files with 95 additions and 18 deletions

View file

@ -57,7 +57,11 @@ T: PRINC-TO-STRING of THING")
(defun make-block (selector values) (defun make-block (selector values)
"Creates a block object with SELECTOR and 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) (defgeneric compile-property (key value)
(:documentation "Compile a property of KEY and VALUE to a list of property objects. (: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 = () (loop with result = ()
for func in cfunc for func in cfunc
do (loop for arg in cargs 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)))))) finally (return (compile-constraint (nreverse result) (cdr args))))))
(:method ((func null) (args null)) (:method ((func null) (args null))
NIL) NIL)
(:method (func (args null)) (:method (func (args null))
func) func)
(:method ((func (eql :constraint)) args)
(list (list* func args)))
(:method ((func (eql :or)) args) (:method ((func (eql :or)) args)
(apply #'append (mapcar #'compile-selector args))) (apply #'append (mapcar #'compile-selector args)))
(:method ((func (eql :and)) args) (:method ((func (eql :and)) args)
@ -140,7 +146,7 @@ See DEFINE-SPECIAL-SELECTOR.")
(loop with result = () (loop with result = ()
for func in cfunc for func in cfunc
do (loop for arg in cargs 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)))))) finally (return (compile-constraint :and (cons (cons :OR (nreverse result)) (cddr args))))))
(if (and (listp (first args)) (eql (first (first args)) :OR)) (if (and (listp (first args)) (eql (first (first args)) :OR))
(rest (first args)) (rest (first args))
@ -163,7 +169,43 @@ Returns a list with the RESOLVEd SELECTOR.")
(:method ((selector list)) (:method ((selector list))
(compile-constraint (car selector) (cdr selector))) (compile-constraint (car selector) (cdr selector)))
(:method ((selector T)) (: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) (defgeneric consume-item (item readable-list)
(:documentation "Consumes items from READABLE-LIST as required by the ITEM. (:documentation "Consumes items from READABLE-LIST as required by the ITEM.

View file

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

View file

@ -62,11 +62,11 @@
(list (format NIL "@keyframes ~a" (resolve identifier))) (list (format NIL "@keyframes ~a" (resolve identifier)))
inner)))) 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) (define-special-block namespace (prefix/namespace &optional namespace)
(list (make-property (list (make-property

View file

@ -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 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 VALUE. Finally a semicolon is printed. Spaces may be inserted where necessary
if *PRETTY* is non-NIL.") 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) (:method ((type (eql :block)) block stream)
(when (and block (cdr block)) (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) (:method ((type (eql :property)) attribute stream)
(when attribute (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) (:method ((type (eql :text)) block stream)
(when block (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) (defun write-sheet-part (stream block cp ap)
"Wrapper around WRITE-SHEET-OBJECT so that we can call it from FORMAT. "Wrapper around WRITE-SHEET-OBJECT so that we can call it from FORMAT.