thodg/css-parser

diff --git a/css-parser.lisp b/css-parser.lisp
index 37fb1b8..93c62aa 100644
--- a/css-parser.lisp
+++ b/css-parser.lisp
@@ -17,27 +17,28 @@
 	    :accessor item-prelude
 	    :type list)))
 
-(defclass with-block (item)
-  ((block :initarg :block
+(defclass with-items (item)
+  ((items :initarg :items
 	  :initform nil
-	  :accessor item-block
+	  :accessor item-items
 	  :type list)))
 
-(defclass stylesheet (item) ())
+(defclass stylesheet (with-items) ())
 
 (defclass toplevel-flag (item)
   ((toplevel :initarg :toplevel
 	     :initform nil
 	     :accessor item-toplevel
 	     :type boolean)))
-  
-(defclass at-rule (named-item with-prelude with-block toplevel-flag) ())
-(defclass qualified-rule (with-prelude with-block toplevel-flag) ())
+
+(defclass at-rule (named-item with-prelude with-items toplevel-flag) ())
+(defclass qualified-rule (with-prelude with-items toplevel-flag) ())
 
 (defclass css-declaration (named-item)
-  ((value :initarg :value
-	  :accessor item-value
-	  :type list)
+  ((values :initarg :value
+	   :initform nil
+	   :accessor item-value
+	   :type list)
    (important-p :initarg :important
 		:initform nil
 		:accessor important-p
@@ -45,10 +46,47 @@
 
 (defclass component-value (item) ())
 
-(defclass css-parser (parser)
-  ((item :initform (make-instance 'stylesheet)
-	 :accessor parser-item
-	 :type item)))
+(defclass values-block (item)
+  ((values :initarg :values
+	   :accessor item-values
+	   :type list)))
+
+(defclass {}-block (values-block) ())
+(defclass paren-block (values-block) ())
+(defclass []-block (values-block) ())
+(defclass function-block (values-block)
+  ((function :initarg :function
+	     :reader item-function
+	     :type function-token)))
+
+(defun make-item-buffer ()
+  (make-array 64
+	      :adjustable t
+	      :fill-pointer 0))
+
+(defmethod item-push-extend ((p parser) (item item))
+  (vector-push-extend item (parser-ib p) 64))
+
+(defmethod item-input ((p parser) (length fixnum))
+  (unless (= 0 length)
+    (item-push-extend p (consume-token p))
+    (item-input p (1- length))))
+
+(defmethod parser-match-item ((p parser))
+  (item-input p 1)
+  (aref (parser-ib p) (parser-item-match-start p)))
+
+(defmethod item-match ((p parser) (type symbol))
+  (let ((item (parser-match-item p)))
+    (when (typep item type)
+      (incf (parser-item-match-start p))
+      item)))
+
+(defmethod item-match ((p parser) (type list))
+  (let ((item (parser-match-item p)))
+    (when (typep item type)
+      (incf (parser-item-match-start p))
+      item)))
 
 ;;  Parsing
 
@@ -56,20 +94,80 @@
 (defgeneric assert-item (parser type))
 (defgeneric parse-at-rule (parser &key toplevel))
 (defgeneric parse-qualified-rule (parser &key toplevel))
+(defgeneric parse-component-value (parser))
 (defgeneric parse-component-value* (parser))
 (defgeneric parse-{}-block (parser))
+(defgeneric parse-paren-block (parser))
+(defgeneric parse-[]-block (parser))
+(defgeneric parse-function-block (parser))
+(defgeneric parse-preserved-token (parser))
 
 (defmethod parser-error ((p parser) (message string))
-  (error "CSS error ~S ~A line ~D character ~D"
-	 message
+  (error "CSS error ~A:~D:~D ~A"
 	 (parser-input p)
 	 (parser-input-line p)
-	 (parser-input-character p)))
+	 (parser-input-character p)
+	 message))
 
 (defmethod assert-item ((p parser) (type symbol))
   (or (typep (parser-item p) type)
       (parser-error p (format nil "rule expected inside ~A" type))))
 
+(defmethod pop-parser-item ((p parser))
+  (setf (parser-item p) (item-parent (parser-item p))))
+
+(defmethod parse-component-value ((p parser))
+  (or (parse-function-block p)
+      (parse-[]-block p)
+      (parse-paren-block p)
+      (parse-{}-block p)
+      (parse-preserved-token p)))
+
+(defmethod parse-component-value* ((p parser))
+  (let ((value (parse-component-value p)))
+    (when value
+      (cons value (parse-component-value* p)))))
+
+(defmethod parse-{}-block ((p parser))
+  (when ({-token p)
+    (let ((values (parse-component-value* p)))
+      (if (}-token p)
+	  (make-instance '{}-block
+			 :values values)
+	  (parser-error p "expected '}'")))))
+
+(defmethod parse-paren-block ((p parser))
+  (when (left-paren-token p)
+    (let ((values (parse-component-value* p)))
+      (if (right-paren-token p)
+	  (make-instance 'paren-block
+			 :values values)
+	  (parser-error p "expected ')'")))))
+
+(defmethod parse-[]-block ((p parser))
+  (when ([-token p)
+    (let ((values (parse-component-value* p)))
+      (if (]-token p)
+	  (make-instance '[]-block
+			 :values values)
+	  (parser-error p "expected ']'")))))
+
+(defmethod parse-function-block ((p parser))
+  (let ((fun (function-token p)))
+    (when fun
+      (let ((values (parse-component-value* p)))
+	(if (right-paren-token p)
+	    (make-instance 'function-block
+			   :function fun
+			   :values values)
+	    (parser-error p "expected ')'"))))))
+
+(defmethod parse-preserved-token ((p parser))
+  (let ((token (consume-token p)))
+    (if (typep token '(or function-token {-token left-paren-token [-token))
+	(parser-error p (format nil "unexpected '~A'" (token-string token)))
+	token)))
+
 (defmethod parse-at-rule ((p parser) &key toplevel)
   (let ((at-keyword (at-keyword-token p)))
     (when at-keyword
@@ -82,16 +180,21 @@
 				  :prelude prelude
 				  :toplevel toplevel)))
 	(setf (parser-item p) item)
-	(or (semicolon-token p)
-	    (parse-{}-block p))
-	(push item (item-at-rules parent))))))
+	(cond ((or (semicolon-token p)
+		   (parse-{}-block p))
+	       (push item (item-items parent))
+	       (pop-parser-item p)
+	       item)
+	      (t
+	       (pop-parser-item p)
+	       nil))))))
 
 (defmethod parse-rule-list ((p parser))
-  (or (and (or (parse-at-rule p)
-	       (parse-qualified-rule p)
-	       (whitespace-token p))
-	   (parse-rule-list p))
-      t))
+  (if (or (parse-at-rule p)
+	  (parse-qualified-rule p)
+	  (whitespace-token p))
+      (parse-rule-list p))
+      t)
 
 (defmethod parse-stylesheet ((p parser))
   (setf (parser-item p) (make-instance 'stylesheet :parent nil))
diff --git a/parser.lisp b/parser.lisp
index e7ecb7d..71822b6 100644
--- a/parser.lisp
+++ b/parser.lisp
@@ -41,4 +41,10 @@
 		:type fixnum)
    (token-stack :initform ()
 		:accessor parser-token-stack
-		:type list)))
+		:type list)
+   (ib :initform (make-item-buffer)
+       :accessor parser-ib
+       :type vector)
+   (item-match-start :initform 0
+		     :accessor parser-item-match-start
+		     :type fixnum)))