Basic support for special reading behaviour on a property-basis. Added property functions and some basic default cases.

compiler.lisp

@@ -23,12 +23,13 @@ See the definition of the LET block.")
   (:documentation "Resolves THING to a value that makes sense for LASS.
 
 By default the following types are handled:
-NULL:    NIL
-STRING:  the THING itself
-ARRAY:   the variable stored in *VARS* under THING
-KEYWORD: Colon-prefixed, downcased symbol-name of THING
-SYMBOL:  Downcased symbol-name of THING
-T:       PRINC-TO-STRING of THING")
+NULL:     NIL
+STRING:   the THING itself
+ARRAY:    the variable stored in *VARS* under THING
+KEYWORD:  Colon-prefixed, downcased symbol-name of THING
+SYMBOL:   Downcased symbol-name of THING
+PATHNAME: If designating an image, base64 encoded inline image data.
+T:        PRINC-TO-STRING of THING")
   (:method ((thing null))
     NIL)
   (:method ((thing string))
@@ -164,6 +165,27 @@ Returns a list with the RESOLVEd SELECTOR.")
   (:method ((selector T))
     (list (resolve selector))))
 
+(defgeneric consume-item (item readable-list)
+  (:method (thing readable-list)
+    (error "Don't know what to do with ~s (not part of a property)." thing))
+  (:method ((subblock list) readable-list)
+    (values
+     NIL
+     subblock))
+  (:method ((property symbol) readable-list)
+    (if (keywordp property)
+        (values
+         (let ((propvals ()))
+           (loop for (next fullp) = (multiple-value-list (peek readable-list))
+                 while fullp
+                 do (etypecase next
+                      (keyword (return))
+                      (list (return))
+                      (T (push (consume readable-list) propvals))))
+           (cons property (nreverse propvals)))
+         NIL)
+        (call-next-method))))
+
 (defgeneric compile-block (header fields)
   (:documentation "Compiles the block with given HEADER and FIELDS list.
 By default, the following case is handled:
@@ -186,28 +208,25 @@ Special handling of blocks may occur.
 See DEFINE-SPECIAL-BLOCK.")
   (:method (selector fields)
     (let ((selector (compile-selector selector))
+          (readable (make-readable-list fields))
           (props ())
-          (subblocks ()))
-      ;; compute props and subblocks
+          (blocks ()))
+      ;; compute props and blocks
       (flet ((add-prop (prop)
                (when prop
-                 (let ((prop (nreverse prop)))
-                   (dolist (prop (compile-property (car prop) (cdr prop)))
-                     (push prop props))))))
-        (loop with prop = ()
-              for field in fields
-              do (etypecase field
-                   (keyword
-                    (add-prop prop)
-                    (setf prop (list field)))
-                   (list
-                    (dolist (subblock (compile-block (list selector (car field)) (cdr field)))
-                      (push subblock subblocks)))
-                   (T (push field prop)))
-              finally (add-prop prop)))
+                 (dolist (prop (compile-property (car prop) (cdr prop)))
+                   (push prop props))))
+             (add-block (block)
+               (when block
+                 (dolist (block (compile-block (list selector (car block)) (cdr block)))
+                   (push block blocks)))))
+        (loop until (empty-p readable)
+              for (prop block) = (multiple-value-list (consume-item (consume readable) readable))
+              do (add-prop prop)
+                 (add-block block)))
       ;; Returns list of blocks with ours consed to front
       (cons (make-block selector (nreverse props))
-            (nreverse subblocks)))))
+            (nreverse blocks)))))
 
 (defun compile-sheet (&rest blocks)
   "Compiles a LASS sheet composed of BLOCKS.

lass.asd

@@ -10,7 +10,7 @@
 
 (defsystem lass
   :name "LASS"
-  :version "0.2.0"
+  :version "0.3.0"
   :license "Artistic"
   :author "Nicolas Hafner <shinmera@tymoon.eu>"
   :maintainer "Nicolas Hafner <shinmera@tymoon.eu>"
@@ -18,7 +18,9 @@
   :homepage "https://github.com/Shinmera/LASS"
   :serial T
   :components ((:file "package")
+               (:file "readable-list")
                (:file "compiler")
+               (:file "property-funcs")
                (:file "writer")
                (:file "lass")
                (:file "special"))

property-funcs.lisp

@@ -0,0 +1,54 @@
+#|
+ This file is a part of LASS
+ (c) 2014 Shirakumo http://tymoon.eu (shinmera@tymoon.eu)
+ Author: Nicolas Hafner <shinmera@tymoon.eu>
+|#
+
+(in-package #:org.tymoonnext.lass)
+
+(defvar *property-functions* (make-hash-table :test 'equalp))
+
+(defun property-function (name)
+  (gethash (string name) *property-functions*))
+
+(defun (setf property-function) (function name)
+  (setf (gethash (string name) *property-functions*)
+        function))
+
+(defmacro define-property-function (name args &body body)
+  `(setf (property-function ,(string name))
+         #'(lambda ,args ,@body)))
+
+(defmacro define-simple-property-function (name args)
+  `(define-property-function ,name ,args
+     (format NIL ,(format NIL "~(~a~)(~{~*~~a~^,~})" name args)
+             ,@(loop for arg in args collect `(resolve ,arg)))))
+
+(defun resolve-function (function &rest args)
+  (let ((resolver (property-function function)))
+    (if resolver
+        (apply resolver args)
+        (format NIL "~(~a~)(~{~a~^,~})" function args))))
+
+(defmethod resolve ((thing list))
+  (apply #'resolve-function (car thing) (cdr thing)))
+
+;; We redefine the method here in order to delegate to property functions
+;; if they do actually exist.
+(defmethod consume-item ((property symbol) readable-list)
+    (if (keywordp property)
+        (values
+         (let ((propvals ()))
+           (loop for (next fullp) = (multiple-value-list (peek readable-list))
+                 while fullp
+                 do (etypecase next
+                      (keyword (return))
+                      (list
+                       (let ((resolver (property-function (car next))))
+                         (if resolver
+                             (push (consume readable-list) propvals)
+                             (return))))
+                      (T (push (consume readable-list) propvals))))
+           (cons property (nreverse propvals)))
+         NIL)
+        (call-next-method)))

readable-list.lisp

@@ -0,0 +1,37 @@
+#|
+ This file is a part of LASS 
+ (c) 2014 Shirakumo http://tymoon.eu (shinmera@tymoon.eu)
+ Author: Nicolas Hafner <shinmera@tymoon.eu>
+|#
+
+(in-package #:org.tymoonnext.lass)
+
+(defclass readable-list ()
+  ((inner :initarg :list :initform () :accessor inner)))
+
+(defun make-readable-list (&optional list)
+  (make-instance 'readable-list :list list))
+
+(defmacro with-empty-check ((lis) &body body)
+  `(if (null (inner ,lis))
+       (values NIL NIL)
+       (values (progn ,@body) T)))
+
+(defun empty-p (readable-list)
+  (null (inner readable-list)))
+
+(defun consume (readable-list)
+  (with-empty-check (readable-list)
+    (pop (inner readable-list))))
+
+(defun peek (readable-list)
+  (with-empty-check (readable-list)
+    (first (inner readable-list))))
+
+(defun advance (readable-list)
+  (with-empty-check (readable-list)
+    (setf (inner readable-list)
+          (cdr (inner readable-list)))))
+
+(defun pushback (item readable-list)
+  (push item (inner readable-list)))

special.lisp

@@ -6,6 +6,19 @@
 
 (in-package #:org.tymoonnext.lass)
 
+;;; FUNCS
+(macrolet ((define-properties (&rest rest)
+             `(progn
+                ,@(loop for (name args) on rest by #'cddr
+                        collect `(define-simple-property-function ,name ,args)))))
+  (define-properties
+    url (url)
+    rgb (red green blue)
+    rgba (red green blue alpha)
+    hsv (hue saturation value)
+    hsva (hue saturation value alpha)))
+(define-property-function hex (hex) (format NIL "#~a" hex))
+
 ;;; BLOCKS
 
 (define-special-block charset (charset)