;; scss.scm: main module exports and implementations for SCSS
;; Copyright (C) 2007 Julian Graham

;; SCSS is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2 of the License, or
;; (at your option) any later version.
;;
;; SCSS is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with SCSS; if not, write to the Free Software
;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA

(define-module (scss scss)
  #:export (scss:css->scss
	    scss:scss->css

	    scss:set-user-stylesheet!
	    scss:set-author-stylesheet!
	    scss:set-agent-stylesheet!

	    scss:create-cascade
	    scss:create-ruleset

	    scss:color->hex

	    scss:set-property!
	    scss:get-property
	    scss:add-selector!
	    scss:remove-selector!

	    scss:set-sxml-parent-function!
	    scss:set-dot-handler!
	    scss:set-id-handler!
	    scss:set-pseudo-class-handler!
	    scss:set-pseudo-element-handler!
	    scss:set-uri-import-handler!

	    scss:stylesheet?
	    scss:cascade?
	    scss:inherited?
	    scss:get-default-value

	    scss:select-value
	    scss:select-value-at-node
	    scss:clear-style-cache!))

(load "lexer.scm")
(load "parser.scm")

(use-modules (ice-9 regex) (srfi srfi-1))

;; The format of these regexes needs to stay consistent with the code for
;; replace-escapes

(define unicode-regex "(\\\\([0-9a-fA-F]{1,6})[[:space:]]?)")
(define unicode-regexc (make-regexp unicode-regex))
(define escape-regex 
  (string-append "(" unicode-regex "|(\\\\[^[:space:]0-9a-fA-F]))"))
(define escape-regexc (make-regexp escape-regex))

(define nonascii-regex "([^[:alnum:][:punct:]])")
(define nonascii-regexc (make-regexp nonascii-regex))
(define nmstart-regex 
  (string-append "([_a-zA-Z]|" nonascii-regex "|" escape-regex ")"))
(define nmstart-regexc (make-regexp nmstart-regex))
(define nmchar-regex
  (string-append "([_a-zA-Z0-9-]|" nonascii-regex "|" escape-regex ")"))
(define nmchar-regexc (make-regexp nmchar-regex))
(define ident-regex (string-append "([-]?" nmstart-regex nmchar-regex "*)"))
(define ident-regexc (make-regexp ident-regex))
(define name-regex (string-append nmchar-regex "+"))
(define nl-regex "(\\n|(\\r\\n)|\\r|\\f)")
(define string1-regex "(\\\"((\\\\[nrf\\\"])|([^\\\\\\\"][^\\\"]?))*\\\")")
(define string2-regex "(\\'((\\\\[nrf\\'])|([^\\\\\\'][^\\']?))*\\')")
(define string-regex (string-append "(" string1-regex "|" string2-regex ")"))
(define string-regexc (make-regexp string-regex))
(define w-regex "([ \\t\\r\\n\\f]*)")
(define integer-regex "([+-]?[0-9]+)")
(define pos-integer-regex "(\\+?[0-9]+)")
(define number-regex (string-append "(" integer-regex "(\\.[0-9]+)?)"))
(define pos-number-regex (string-append "(" pos-integer-regex "(\\.[0-9]+)?)"))
(define angle-regex (string-append "(" number-regex "((deg)|(grad)|(rad)))"))
(define percentage-regex (string-append "(" number-regex "%)"))
(define pos-length-regex
  (string-append "(0|(" pos-number-regex
		 "((em)|(ex)|(px)|(in)|(cm)|(mm)|(pt)|(pc))))"))
(define length-regex 
  (string-append "(0|(" number-regex 
		 "((em)|(ex)|(px)|(in)|(cm)|(mm)|(pt)|(pc))))"))
(define color-regex 
  (string-append "((maroon)|(red)|(orange)|(yellow)|(olive)|(purple)|"
		 "(fuchsia)|(white)|(lime)|(green)|(navy)|(blue)|(aqua)|"
		 "(teal)|(black)|(silver)|(gray)|(#[a-fA-F0-9]{3})|"
		 "(#[a-fA-F0-9]{6}))"))
(define border-style-regex 
  (string-append "((none)|(hidden)|(dotted)|(dashed)|(solid)|(double)|"
		 "(groove)|(ridge)|(inset)|(outset))"))
(define border-width-regex 
  (string-append "((thin)|(medium)|(thick)|" length-regex ")"))
(define svoice-regex (string-append "(" ident-regex "|" string-regex ")"))
(define gvoice-regex "((male)|(female)|(child))")

(define gfont-regex "((serif)|(sans-serif)|(cursive)|(fantasy)|(monospace))")
(define sfont-regex string-regex)

(define ffamily-regex 
  (string-append "(((" sfont-regex "|" gfont-regex ")(\\w+" sfont-regex "|" 
		 gfont-regex ")*)|(inherit))"))
(define fsize-regex 
  (string-append "(((xx-small)|(x-small)|(small)|(medium)|(large)|(x-large)|"
		 "(xx-large))|((larger)|(smaller))|" length-regex "|"
		 percentage-regex "|(inherit))"))
(define fstyle-regex "((normal)|(italic)|(oblique)|(inherit))")
(define fvariant-regex "((normal)|(small-caps)|(inherit))")
(define fweight-regex 
  (string-append "((normal)|(bold)|(bolder)|(lighter)|(100)|(200)|(300)|(400)|"
		 "(500)|(600)|(700)|(800)|(900)|(inherit))"))

(define lheight-regex (string-append "((normal)|" number-regex "|" length-regex
				     "|" percentage-regex "|(inherit))"))

;; This isn't 100% accurate, but...
(define uri-regex (string-append "(url\\(" string-regex "\\))"))

(define lsimage-regex (string-append "(" uri-regex "|(none))"))
(define lsposition-regex "((inside)|(outside))")
(define lstype-regex 
  (string-append "((disc)|(circle)|(square)|(decimal)|(decimal-leading-zero)|"
		 "(lower-roman)|(upper-roman)|(lower-greek)|(lower-latin)|"
		 "(lower-alpha)|(upper-latin)|(upper-alpha)|(armenian)|"
		 "(georgian)|(none))"))

(define margin-regex 
  (string-append "(" length-regex "|" percentage-regex "|(auto))"))

(define counter-regex 
  (string-append "(counter\\(" ident-regex "(, " lstype-regex ")?\\))"))


(define ocolor-regex (string-append "(" color-regex "|(invert))"))
(define ostyle-regex border-style-regex)
(define owidth-regex border-width-regex)

(define time-regex (string-append "(" number-regex "m?s)"))

(define padding-regex 
  (string-append "(" pos-length-regex "|" percentage-regex ")"))
(define pcolor-regex 
  (string-append "(" color-regex "|(transparent)|(inherit))"))
(define pimage-regex (string-append "(" uri-regex "|(none)|(inherit))"))
(define prepeat-regex "((repeat)|(repeat-x)|(repeat-y)|(no-repeat)|(inherit))")
(define pattach-regex "((scroll)|(fixed)|(inherit))")

(define lposition
  (lambda (x)
    (or (exact-match (string-append "((" percentage-regex "|" length-regex 
				    "|(left)|(center)|(right))(" 
				    percentage-regex "|" length-regex 
				    "|(top)|(center)|(bottom))?)") x)
	((any-order-or-match "(left)|(center)|(right)" 
			     "(top)|(center)|(bottom)") x)
	(exact-match "inherit" x))))

;; NOTE: Changes to this regex will require updates to the selection 
;; functions!

(define attr-sel-regexc 
  (make-regexp (string-append "\\[" ident-regex "(([|~]?=)(" ident-regex "|" 
			      string-regex "))?\\]")))

(define color-table
  '(("maroon" "#800000") ("red" "#ff0000") ("orange" "#ffa500") 
    ("yellow" "#ffff00") ("olive" "#808000") ("purple" "#800080")
    ("fuchsia" "#ff00ff") ("white" "#ffffff") ("lime" "#00ff00") 
    ("green" "#008000") ("navy" "#000080") ("blue" "#0000ff") 
    ("aqua" "#00ffff") ("teal" "#008080") ("black" "#000000") 
    ("silver" "#c0c0c0") ("gray" "#808080")))

(define exact-match
  (lambda (pattern str)
    (let ((match (string-match pattern str)))
      (if match (equal? str (match:substring match 0)) match))))

(define exact-exec
  (lambda (pattern str)
    (let ((match (regexp-exec pattern str)))
      (and match 
	   (eqv? (match:start match) 0) 
	   (eqv? (match:end match) (string-length str))))))

(define any-order-or-match
  (lambda lst
    (lambda (input)
      (let ((l (copy-tree lst)))
	(if (not (null? input))
	    (let ((result #t))
	      (for-each (lambda (x)
			  (if (> (string-length x) 0)
			      (if (null? l) 
				  (set! result #f)
				  (let ((m (find (lambda (y)
						   (if (procedure? y)
						       (apply y (list x))
						       (exact-match y x)))
						 l)))
				    (if m (delete! m l) (set! result #f))))))
			(string-split input #\sp))
	      result)
	    #f)))))

(define matchf (lambda (expr) (lambda (input) (exact-match expr input))))

(define property-table
  `(("azimuth" 
     ,(lambda (x)
	(or (exact-match angle-regex x)
	    (apply (any-order-or-match
		    (string-append "(left-side)|(far-left)|(left)|"
				   "(center-left)|(center)|(center-right)|"
				   "(right)|(far-right)|(right-side)")
		    "behind") (list x))
	    (exact-match "(leftwards)|(rightwards)|(inherit)" x)))
     ("center") #t)
    ("background-attachment" ,(matchf pattach-regex) ("scroll") #f)
    ("background-color" ,(matchf pcolor-regex) ("transparent") #f)
    ("background-image" ,(matchf pimage-regex) ("none") #f)
    ("background-position" lposition ("0%" "0%") #f)
    ("background-repeat" ,(matchf prepeat-regex) ("repeat") #f)
    ("background"
     ,(lambda (x)
	(or (apply (any-order-or-match pcolor-regex pimage-regex prepeat-regex
				       pattach-regex lposition)
		   (list x))
	    (exact-match "inherit" x)))
     ("black" "none" "no-repeat" "fixed" "0% 0%") #f)
    ("border-collapse" ,(matchf "(collapse)|(separate)|(inherit)")
     ("separate") #t)
    ("border-color" 
     ,(matchf (string-append "((" color-regex "|(transparent))\\s*){1,4}|"
			     "(inherit)"))
     (color color color color) "color")
    ("border-spacing"
     ,(matchf (string-append "(" length-regex "\\w+" length-regex 
			     "?)|(inherit)")) ("0") #t)
    ("border-style"
     ,(matchf (string-append "(" border-style-regex "\\s*){1,4}|(inherit)"))
     ("none" "none" "none" "none") #f)
    (,(list "border-top" "border-right" "border-bottom" "border-left")
     ,(lambda (x) 
	(or (apply (any-order-or-match border-width-regex 
				       border-style-regex 
				       pcolor-regex)
		   (list x))
	    (exact-match "inherit" x)))
     ("medium" "none" color) #f)
    (,(list "border-top-color" "border-right-color"
	    "border-left-color" "border-bottom-color")
     ,(matchf pcolor-regex) (color) "color")
    (,(list "border-top-style" "border-right-style"
	    "border-left-style" "border-bottom-style")
     ,(matchf (string-append border-style-regex "|(inherit)")) ("none") #f)
    (,(list "border-top-width" "border-right-width"
	    "border-bottom-width" "border-left-width")
     ,(matchf (string-append border-width-regex "|(inherit)")) ("medium") #f)
    ("border-width" 
     ,(matchf (string-append "(" border-width-regex "\\s*){1,4}|(inherit)"))
     ("medium" "medium" "medium" "medium") #f)
    ("border"
     ,(lambda (x) 
	(or (apply (any-order-or-match border-width-regex 
				       border-style-regex 
				       pcolor-regex)
		   (list x))
	    (exact-match "inherit" x)))
     ("medium none" color) #f)
    ("bottom" ,(matchf (string-append length-regex "|" percentage-regex 
				      "|(auto)|inherit"))
     ("auto") #f)
    ("caption-side" ,(matchf "(top)|(bottom)|(inherit)") ("top") #t)
    ("clear" ,(matchf "(none)|(left)|(right)|(both)|(inherit)") ("none") #f)
    ("clip" 
     ,(matchf (string-append "(rect\\((" length-regex "|(auto))(,\\w(" 
			     length-regex "|(auto))){3}\\))|(auto)|"
			     "(inherit)"))
     ("auto") #f)
    ("color" ,(matchf pcolor-regex) ("white") #t)
    ("content" 
     ,(matchf (string-append "(normal)|(" string-regex "|" uri-regex "|" 
			     counter-regex "|(attr\\(" ident-regex "\\))|"
			     "(open-quote)|(close-quote)|(no-open-quote)|"
			     "(no-close-quote))+|(inherit)"))
     ("normal") #f)
    (,(list "counter-increment" "counter-reset")
     ,(matchf (string-append "(" ident-regex "(\\w+" integer-regex ")?)+|"
			     "(none)|(inherit)"))
     ("none") #f)
    (,(list "cue-after" "cue-before") 
     ,(matchf (string-append uri-regex "|(none)|(inherit)")) ("none") #f)
    ("cue"
     ,(matchf (string-append "(" uri-regex "|(none)|(inherit)(\\w+" uri-regex
			     "|(none)|(inherit))?)|(inherit)"))
     ("none" "none") #f)
    ("cursor"
     ,(matchf (string-append "((" uri-regex ",)*((auto)|(crosshair)|(default)|"
			     "(pointer)|(move)|(e-resize)|(ne-resize)|"
			     "(nw-resize)|(n-resize)|(se-resize)|(sw-resize)|"
			     "(s-resize)|(w-resize)|(text)|(wait)|(help)|"
			     "(progress)))|(inherit)"))
     ("auto") #t)
    ("direction" ,(matchf "(ltr)|(rtl)|(inherit)") ("ltr") #t)
    ("display"
     ,(matchf (string-append "(inline)|(block)|(list-item)|(run-in)|"
			     "(inline-block)|(table)|(inline-table)|"
			     "(table-row-group)|(table-header-group)|"
			     "(table-footer-group)|(table-row)|"
			     "(table-column-group)|(table-column)|"
			     "(table-cell)|(table-caption)|(none)|(inherit)"))
     ("inline") #f)
    ("elevation"
     ,(matchf (string-append angle-regex "|(below)|(level)|(above)|(higher)|"
			     "(lower)|(inherit)"))
     ("level") #t)
    ("empty-cells" ,(matchf "(show)|(hide)|(inherit)") ("show") #t)
    ("float" ,(matchf "(left)|(right)|(none)|(inherit)") ("none") #f)
    ("font-family" ,(matchf ffamily-regex) ("monospace") #t)
    ("font-size" ,(matchf fsize-regex) ("medium") #t)
    ("font-style" ,(matchf fstyle-regex) ("normal") #t)
    ("font-variant" ,(matchf fvariant-regex) ("normal") #t)
    ("font-weight" ,(matchf fweight-regex) ("normal") #t)
    ("font" 
     ,(lambda (x)
	(let ((y (string-append fsize-regex "(\\w+\\/" lheight-regex ")?\\w+"
				ffamily-regex)))
	  (or (and (apply (any-order-or-match fstyle-regex fvariant-regex 
					      fweight-regex y)
			  (list x))
		   (string-match (string-append y "$") x))
	      (exact-match y x)
	      (exact-match (string-append "(caption)|(icon)|(menu)|"
					  "(message-box)|(small-caption)|"
					  "(status-bar)|(inherit)") x))))
     ("normal" "normal" "normal" "medium" "monospace") #t)
    (,(list "height" "left" "right" "width" "bottom" "top")
     ,(matchf (string-append length-regex "|" percentage-regex "|(auto)|"
			     "(inherit)"))
     ("auto") #f)
    ("letter-spacing"
     ,(matchf (string-append "(normal)|" length-regex "|(inherit)"))
     ("normal") #t)
    ("line-height"
     ,(matchf (string-append "(normal)|" number-regex "|" length-regex "|"
			     percentage-regex "|(inherit)"))
     ("normal") #t)
    ("list-style-image"
     ,(matchf (string-append lsimage-regex "|(inherit)")) ("none") #t)
    ("list-style-position" 
     ,(matchf (string-append lsposition-regex "|(inherit)")) ("outside") #t)
    ("list-style-type"
     ,(matchf (string-append lstype-regex "|(inherit)")) ("disc") #t)
    ("list-style"
     ,(lambda (x)
	(or (apply (any-order-or-match lstype-regex lsposition-regex 
				       lsimage-regex)
		   (list x))
	    (exact-match "inherit" x)))
     ("disc" "outside" "none") #t)
    (,(list "margin-right" "margin-left" "margin-top" "margin-bottom")
     ,(matchf (string-append length-regex "|" percentage-regex 
			     "|(auto)|(inherit)"))
     ("0") #f)
    ("margin" ,(matchf (string-append "(" margin-regex "\\s*){1,4}|(inherit)"))
     ("0" "0" "0" "0") #f)
    (,(list "max-height" "max-width")
     ,(matchf (string-append length-regex "|" percentage-regex "|(none)|"
			     "(inherit)"))
     ("none") #f)
    (,(list "min-height" "min-width")
     ,(matchf (string-append length-regex "|" percentage-regex "|(inherit)"))
     ("0") #f)
    ("orphans" ,(matchf (string-append integer-regex "|(inherit)")) ("2") #t)
    ("outline-color" ,(matchf (string-append ocolor-regex "|(inherit)")) 
     ("invert") #f)
    ("outline-style" ,(matchf (string-append ostyle-regex "|(inherit)"))
     ("none") #f)
    ("outline-width" ,(matchf (string-append owidth-regex "|(inherit)"))
     ("medium") #f)
    ("outline" 
     ,(lambda (x) 
	(or (apply (any-order-or-match ocolor-regex ostyle-regex owidth-regex)
		   (list x))
	    (exact-match "inherit" x)))
     ("invert" "none" "medium") #f)
    ("overflow"
     ,(matchf "(visible)|(hidden)|(scroll)|(auto)|(inherit)") ("visible") #f)
    (,(list "padding-top" "padding-right" "padding-bottom" "padding-left")
     ,(matchf (string-append length-regex "|" percentage-regex "|(inherit)"))
     ("0") #f)
    ("padding" ,(matchf (string-append "(" padding-regex "\\s*){1,4}|"
				       "(inherit)"))
     ("0" "0" "0" "0") #f)
    (,(list "page-break-after" "page-break-before")
     ,(matchf "(auto)|(always)|(avoid)|(left)|(right)|(inherit)") ("auto") #f)
    ("page-break-inside" ,(matchf "(avoid)|(auto)|(inherit)") ("auto") #t)
    (,(list "pause-after" "pause-before")
     ,(matchf (string-append time-regex "|" percentage-regex "|(inherit)"))
     ("0") #f)
    ("pause"
     ,(matchf (string-append "((" time-regex "|" percentage-regex ")\\s*){1,2}"
			     "|(inherit)"))
     ("0" "0") #f)
    ("pitch-range" ,(matchf (string-append number-regex "|(inherit)")) 
     ("50") #t)
    ("pitch" ,(matchf (string-append "(" number-regex "k?Hz)|(x-low)|(low)|"
				     "(medium)|(high)|(x-high)|(inherit)"))
     ("medium") #t)
    ("play-during" 
     ,(matchf (string-append uri-regex "|(" uri-regex "\\w+mix)|(" uri-regex
			     "\\w+repeat)|(" uri-regex "\\w+mix\\w+repeat)|("
			     uri-regex "\\w+repeat\\w+mix)|(auto)|(none)|"
			     "(inherit)"))
     ("auto") #f)
    ("position" ,(matchf "(static)|(relative)|(absolute)|(fixed)|(inherit)") 
     ("static") #f)
    ("quotes" 
     ,(matchf (string-append "(" string-regex "\\w+" string-regex ")+|(none)|"
			     "(inherit)"))
     ("none") #t)
    ("richness" ,(matchf (string-append number-regex "|(inherit)")) ("50") #t)
    ("speak-header" ,(matchf "(once)|(always)|(inherit)") ("once") #t)
    ("speak-numeral" ,(matchf "(digits)|(continuous)|(inherit)") 
     ("continuous") #t)
    ("speak-punctuation" ,(matchf "(code)|(none)|(inherit)") ("none") #t)
    ("speak" ,(matchf "(normal)|(none)|(spell-out)|(inherit)") ("normal") #t)
    ("speech-rate"
     ,(matchf (string-append number-regex "|(x-slow)|(slow)|(medium)|(fast)|"
			     "(x-fast)|(faster)|(slower)|(inherit)"))
     ("medium") #t)
    ("stress" ,(matchf (string-append number-regex "|(inherit)")) ("50") #t)
    ("table-layout" ,(matchf "(auto)|(fixed)|(inherit)") ("auto") #f)
    ("text-align" ,(matchf "(left)|(right)|(center)|(justify)|(inherit)")
     ("left") #t)
    ("text-decoration"
     ,(lambda (x) 
	(or (exact-match "none" x)
	    (apply (any-order-or-match "underline" "overline" "line-through" 
				       "blink")
		   (list x))
	    (exact-match "inherit" x)))
     ("none") #f)
    ("text-indent" ,(matchf (string-append length-regex "|" percentage-regex 
					   "|(inherit)"))
     ("0") #t)
    ("text-transform" 
     ,(matchf "(capitalize)|(uppercase)|(lowercase)|(none)|(inherit)") 
     ("none") #t)
    ("unicode-bidi" ,(matchf "(normal)|(embed)|(bidi-override)|(inherit)")
     ("normal") #f)
    ("vertical-align"
     ,(matchf (string-append "(baseline)|(sub)|(super)|(top)|(text-top)|"
			     "(middle)|(bottom)|(text-bottom)|" 
			     percentage-regex "|" length-regex "|(inherit)"))
     ("baseline") #f)
    ("visibility" ,(matchf "(visible)|(hidden)|(collapse)|(inherit)")
     ("visible") #t)
    ("voice-family" 
     ,(matchf (string-append "((" svoice-regex "|" gvoice-regex ",)*(" 
			     svoice-regex "|" gvoice-regex "))|(inherit)"))
     ("female") #t)
    ("volume"
     ,(matchf (string-append number-regex "|" percentage-regex 
			     "|(silent)|(x-soft)|(soft)|(medium)|(loud)|"
			     "(xloud)|(inherit)"))
     ("medium") #t)
    ("white-space" 
     ,(matchf "(normal)|(pre)|(nowrap)|(pre-wrap)|(pre-line)|(inherit)")
     ("normal") #t)
    ("widows" ,(matchf (string-append integer-regex "|(inherit)")) ("2") #t)
    ("word-spacing" 
     ,(matchf (string-append "(normal)|" length-regex "|(inherit)"))
     ("normal") #t)		    
    ("z-index" ,(matchf (string-append "(auto)|" integer-regex "|(inherit)")) 
     ("auto") #f)))

(define num-css-props (length property-table))

(define property-hash-table
  (let ((pht (make-hash-table num-css-props)))
    (for-each (lambda (x) 
		(if (list? (car x))
		    (for-each (lambda (y) (hash-set! pht y (cdr x))) (car x))
		    (hash-set! pht (car x) (cdr x))))
	      property-table)
    pht))

(define document-hash-table (make-weak-key-hash-table 16))
(define cascade-hash-table (make-weak-key-hash-table 16))

(define cascade-hash
  (lambda (cascade n) (modulo (+ (hashq (car cascade) n) 
				 (hashq (cadr cascade) n)
				 (hashq (caddr cascade) n))
			      n)))

(define cascade-assoc
  (lambda (x alist) (find (lambda (y) (and (eq? (car x) (caar y))
					   (eq? (cadr x) (cadar y))
					   (eq? (caddr x) (caddar y))))
			  alist)))

(define node?
  (lambda (x)
    (and (list? x) (let ((y (car x))) (or (symbol? y) (string? y))))))
	  
(define sxml-node? 
  (lambda (x) (let ((y (node? x))) (and y (not (eq? (car x) '*TOP*))))))

(define sxml-doc? (lambda (x) (and (list? x) (eq? (car x) '*TOP*))))

(define get-sxml-parent
  (lambda (doc node)
    (if (memq node doc) doc (let ((c (filter list? (cdr doc))))
			      (if c (find (lambda (x) 
					    (get-sxml-parent x node))
					  c))
			      #f))))

(define sxml-node-name
  (lambda (node)
    (let* ((str (false-if-exception (symbol->string (car node))))
	   (ri (if str (string-rindex str #\:) #f)))
      (if ri (substring str (+ ri 1)) str))))

(define sxml-attr-val
  (lambda (node name)
    (if (string? (car node)) 
	#f
	(let ((attrs (find (lambda (x) (and (list? x) (eq? (car x) '@)))
			   (cdr node))))
	  (if attrs (find (lambda (x) 
			    (and (list? x) (equal? (sxml-node-name x) name))) 
			  (cdr attrs)) 
	      #f)))))			 

(define scss:set-sxml-parent-function!
  (lambda (proc) 
    (verify-arg-types "scss:set-sxml-parent-function!" 
		      (list procedure?) 
		      (list proc)
		      1)
    (set! get-sxml-parent proc)))

(define internal-dot-handler (lambda (sel doc node) #f))
(define scss:set-dot-handler! 
  (lambda (p) 
    (verify-arg-types "scss:set-dot-handler!" (list procedure?) (list p) 1)
    (set! internal-dot-handler p)))

(define internal-id-handler (lambda (str doc node) #f))
(define scss:set-id-handler! 
  (lambda (p) 
    (verify-arg-types "scss:set-id-handler!" (list procedure?) (list p) 1)
    (set! internal-id-handler p)))

(define internal-pseudo-class-handler (lambda (str doc node) #f))
(define scss:set-pseudo-class-handler!
  (lambda (p)
    (verify-arg-types "scss:set-pseudo-class-handler!" 
		      (list procedure?) 
		      (list p)
		      1)
    (set! internal-pseudo-class-handler p)))

(define internal-pseudo-element-handler (lambda (str doc node) #f))
(define scss:set-pseudo-element-handler!
  (lambda (p)
    (verify-arg-types "scss:set-pseudo-element-handler!"
		      (list procedure?) 
		      (list p)
		      1)
    (set! internal-pseudo-element-handler p)))

(define internal-uri-import-handler (lambda (uri) (open-input-string "")))
(define scss:set-uri-import-handler!
  (lambda (p)
    (verify-arg-types "scss:set-uri-import-handler!"
		      (list procedure?)
		      (list p)
		      1)
    (set! internal-uri-import-handler p)))

(define null-merge 
  (lambda (x y) (if (not (null? x)) (if (null? y) (list x) (cons x y)) y)))

(define guile-unicode-support 
  (let ((v (string-split (version) #\.)))
    (or (> 6 (string->number (cadr v)))
	(> 1 (string->number (car v))))))

(define can-parse-unicode?
  (lambda (num) (or (< num 256) guile-unicode-support)))

(define replace-escapes
  (lambda (str)
    (let ((f (lambda (m)
	       (let ((esc (substring (match:substring m) 1)))
		 (if (eqv? (string-ref esc 0) #\\)
		     "\\"
		     (let* ((ms (match:substring m 3))
			    (n (and ms (string->number ms 16))))
		       (if (and n (can-parse-unicode? n))
			   (make-string 1 (integer->char n)) 
			   esc)))))))
      (regexp-substitute/global #f escape-regexc str 'pre f 'post))))

(define merge-selectors
  (lambda (selector-list)
    (let ((l (list (list))))
      (for-each (lambda (x) 
		  (if (equal? x ",")
		      (append! l (list (list)))
		      (if (not (null? (car l)))
			  (set-car! (list-cdr-ref l (- (length l) 1))
				    (append (list-ref l (- (length l) 1))
					    (list (replace-escapes x))))
			  (set-car! l (list (replace-escapes x))))))
		selector-list)
      l)))

(define parse-selector
  (lambda (sel)
    (let ((sel-block (string-append sel " { }")))
      (lexer-init 'string sel-block)
      (caar (scss-parser lexer-wrapper (lambda e (error #t e)))))))

(define pseudo-class? 
  (let ((re (make-regexp (string-append ":((first-child)|(link)|(visited)|"
					"(hover)|(active)|(focus)|(lang))"))))
    (lambda (str) (and (eqv? (string-ref str 0) #\:) (exact-exec re str)))))

(define pseudo-element? 
  (let ((re (make-regexp ":((first-line)|(first-letter)|(before)|(after))")))
    (lambda (str) (and (eqv? (string-ref str 0) #\:) (exact-exec re str)))))

(define validate-selector 
  (lambda (sel)
    (let* ((id-regexc (make-regexp (string-append "#" ident-regex)))
	   (dot-regexc (make-regexp (string-append "\\." ident-regex))))
      (for-each 
       (lambda (x)
	 (let ((read-ident #f))
	   (for-each 
	    (lambda (y)
	      (cond ((or (equal? y "*")
			 (exact-exec ident-regexc y)
			 (exact-exec attr-sel-regexc y))
		     (set! read-ident #t))
		    ((and read-ident (or (equal? "+" y) (equal? ">" y)))
		     (set! read-ident #f))
		    ((or (and read-ident 
			      (or (pseudo-class? y) 
				  (and (pseudo-element? y)
				       (equal? (car (last-pair x)) y))))
			 (exact-exec id-regexc y)
			 (exact-exec dot-regexc y)))
		    (else (error #t 
				 (string-append "scss: invalid selector "
						(apply string-append x))))))
	      x)))
       sel))))

(define calc-precedence
  (lambda (item)
    (case (car item)
      ((agent) 1)
      ((user) (if (and (= (length item) 5) (eq? (list-ref item 4) '!)) 5 2))
      (else (if (and (= (length item) 5) (eq? (list-ref item 4) '!)) 4 3)))))

(define calc-specificity
  (lambda (sel) 
    (let ((count (lambda (pred lst) (length (filter pred lst)))))
      (+ (* (count (lambda (x) (eqv? (string-ref x 0) #\#)) sel) 100)
	 (* (count (lambda (x) (or (pseudo-class? x) 
				   (eqv? (string-ref x 0) #\[)
				   (eqv? (string-ref x 0) #\.)))
		   sel) 10)
	 (count (lambda (x) (or (pseudo-element? x) 
				(exact-exec ident-regexc x)))
		sel)))))

(define check-important 
  (lambda (v) 
    (let ((slist (string-split v #\sp)))
      (if (equal? (car (last-pair slist)) "!important")
	  (let ((relist (list-head slist (- (length slist) 1))))
	    (list (fold (lambda (x y) 
			  (if (null? y) x (string-append x " " y)))
			(list-head relist (- (length relist) 1))
			(last-pair relist)) 
		  '!))
	  (list v)))))

(define validate-property-parse
  (lambda (property value)
    (let* ((escd-prop (replace-escapes property))
	   (escd-val (replace-escapes value))
	   (pe (hash-ref property-hash-table escd-prop)))
      (if pe
	  (let ((v2 (let ((x (string-length escd-val)))
		      (if (and (> x 11) (equal? (substring escd-val (- x 10))
						"!important"))
			  (substring escd-val 0 (- x 11))
			  escd-val))))
	    (if (apply (car pe) (list (string-downcase v2)))
		(cons escd-prop (check-important escd-val))
		(list)))
	  (list escd-prop escd-val)))))

(define validate-property 
  (lambda (property value)
    (let ((pe (hash-ref property-hash-table property)))
      (if pe 
	  (if (apply (car pe) (list (string-downcase value))) 
	      #t 
	      (error #t (string-append 
			 "invalid value " value " for property " property)))
	  (error #t (string-append "invalid property name " property))))))

(define verify-arg-types
  (lambda (name predicates args startnum)
    (if (not (= (length predicates) (length args)))
	(error #t "predicate argument mismatch"))
    (letrec ((f (lambda (l1 l2 i)
		  (if (null? l1) 
		      #t
		      (if (apply (car l1) (list (car l2)))
			  (f (cdr l1) (cdr l2) (+ i 1))
			  (error #t (string-append 
				     name ": wrong argument type in position "
				     (number->string (+ startnum i)))))))))
      (f predicates args 0))))

(define display-list (lambda lst (display lst)))

(define lexer-wrapper
  (lambda () 
    (let ((tok (lexer))) 
      (if (and (car tok) (not (eqv? (car tok) 0))) tok '(*eoi*)))))

(define scss:css->scss 
  (lambda (port . baseurl)
    (verify-arg-types "scss:css->scss" (list port?) (list port) 1)
    (if (not (null? baseurl)) 
	(verify-arg-types "scss:css->scss" (list string?) baseurl 1))
    (let* ((dirstr (lambda (str)
		     (let ((s (string-rindex str #\/)))
		       (if s (substring str 0 (+ s 1)) ""))))
	   (uh (make-regexp "^\\w+\\:\\/\\/"))
	   (bu (if (null? baseurl)
		   (if (file-port? port) 
		       (dirstr (port-filename port))
		       (getcwd))
		   (car baseurl))))
      (lexer-init 'port port)
      (let* ((parsed-sheet (scss-parser lexer-wrapper display-list))
	     (imports (letrec 
			  ((f (lambda (s i)
				(if (not (null? s)) 
				    (if (eq? (caar s) '@import)
					(f (cdr s) (cons (cadar s) i))
					i)
				    i))))
			(f parsed-sheet (list))))
	     (clean-sheet (list-tail parsed-sheet (length imports)))
	     (final (fold-right 
		     (lambda (s1 s2)
		       (let* ((s1 (if (and (> (string-length s1) 7)
					   (equal? (substring s1 0 7) 
						   "file://"))
				      (substring s1 7)
				      s1))
			      (bu (if (and (> (string-length bu) 7)
					   (equal? (substring bu 0 7) 
						   "file://"))
				      (substring bu 7)
				      bu))
			      (nbu (dirstr (if (and (> (string-length s1) 0)
						    (eqv? (string-ref s1 0) 
							  #\/))
					       s1
					       (string-append bu "/" s1))))
			      (p (false-if-exception
				  (cond ((and (> (string-length s1) 0)
					      (equal? (string-ref s1 0) #\/))
					 (open-input-file s1))
					((regexp-exec uh s1))
					(else (open-input-file 
					       (string-append bu "/" s1))))))
			      (new-sheet (false-if-exception (scss:css->scss 
							      p nbu))))
			 (if new-sheet 
			     (append (map (lambda (x)
					    (cons (list (car x))
						  (cdr x)))
					  new-sheet)
				     s2) 
			     (list s2))))
		     clean-sheet
		     imports)))
	(expand-stylesheet final)))))

(define scss:scss->css
  (lambda (stylesheet port)
    (let* 
	((ser-selector 
	  (lambda (selector)
	    (display 
	     (fold (lambda (x y) 
		     (string-append 
		      (fold (lambda (q r)
			      (string-append 
			       q (if (or (exact-exec ident-regexc r)
					 (equal? r ">")
					 (equal? r "+")
					 (equal? r "*"))
				     " " "") r))
			    ""
			    (reverse x))
		      (if (null? y) "" (string-append ", " y))))
		   '()
		   (reverse selector))
	     port)))
	 (ser-property (lambda (pair) 
			 (display "\t" port)
			 (display (car pair) port)
			 (display ": " port)
			 (display (cadr pair) port)
			 (display ";" port)
			 (newline port)))
	 (ser-block (lambda (block)
		      (ser-selector (car block))
		      (display " {" port)
		      (newline port)
		      (for-each (lambda (x) (ser-property x)) (cadr block))
		      (display "}" port)
		      (newline port)
		      (newline port))))			  
      (verify-arg-types "scss:scss->css"
			(list scss:stylesheet? port?) 
			(list stylesheet port)
			1)
      (for-each (lambda (block) (ser-block block)) stylesheet))))

(define scss:create-cascade 
  (lambda arglist
    (if (null? arglist) 
	(list (list) (list) (list))
	(if (= (length arglist) 3)
	    (begin (verify-arg-types "scss:create-cascade"
				     (make-list 3 scss:stylesheet?) 
				     arglist
				     1)
		   arglist)
	    (error #t "wrong number of arguments to scss:create-cascade")))))
    
(define scss:create-ruleset
  (lambda (sel-str . rest)
    (verify-arg-types "scss:create-ruleset"
		      (list string? 
			    (lambda (x) 
			      (and (list? x)
				   (every (lambda (y) 
					    (and (list? y)
						 (>= (length y) 2)
						 (string? (car y))
						 (string? (cadr y))
						 (if (= (length y) 3)
						     (eq? (caddr y) '!)
						     #t)))
					  x))))
		      (list sel-str rest)
		      1)
    (let ((sel (parse-selector sel-str)))
      (list sel rest))))
						     
(define scss:set-author-stylesheet!
  (lambda (cascade authorsheet) 
    (set-car! (list-cdr-ref cascade 2) authorsheet)))

(define scss:set-user-stylesheet!
  (lambda (cascade usersheet) 
    (set-car! cascade usersheet)))

(define scss:set-agent-stylesheet!
  (lambda (cascade agentsheet) 
    (set-car! (list-cdr-ref cascade 1) agentsheet)))

(define scss:cascade? 
  (lambda (cascade)
    (and (list? cascade) 
	 (= (length cascade) 3) 
	 (every (lambda (x) (or (null? x) (scss:stylesheet? x))) cascade))))

(define scss:stylesheet? 
  (lambda (stylesheet)
    (and (list? stylesheet)
	 (every (lambda (x) 
		  (and (list? x)
		       (>= (length x) 2)
		       (list? (car x))
		       (false-if-exception (validate-selector (list (car x))))
		       (list? (cdr x))
		       (every (lambda (y)
				(and (list? y)
				     (or (= (length y) 2)
					 (and (= (length y) 3)
					      (eq? (list-ref y 2) '!)))
				     (string? (car y))
				     (string? (cadr y))))
			      (cdr x))))
		stylesheet))))

(define scss:set-property!
  (lambda (stylesheet selector property value)
    (verify-arg-types "scss:set-property!"
		      (list scss:stylesheet? string? string? string?)
		      (list stylesheet selector property value)
		      1)
    (validate-property property value)
    (let ((sel (find (lambda (x) (equal? (caar x) selector)) stylesheet)))
      (if (not sel)
	  (append! stylesheet `((,(list selector)) (,(list property value))))
	  (let ((p (find (lambda (x) (equal? (car x) property)) (cadr sel))))
	    (if p 
		(set-car! (cdr p) value))
		(append! (cadr sel) (list (list property value))))))))

(define scss:add-ruleset!
  (lambda (stylesheet selector)
    (verify-arg-types "scss:add-ruleset!"
		      (list scss:stylesheet? string?) 
		      (list stylesheet selector)
		      1)
    (if (not (find (lambda (x) (equal? (caar x) selector)) stylesheet))
	(append! stylesheet (list (list (list selector)))))))

(define scss:remove-property!
  (lambda (stylesheet selector property) '()))
(define scss:remove-selector!
  (lambda (stylesheet selector) '()))
(define scss:remove-ruleset!
  (lambda (stylesheet selector) '()))

(define scss:color->hex 
  (lambda (color)
    (verify-arg-types "scss:color->hex" (list string?) (list color) 1)
    (let ((c (find (lambda (x) (equal? (car x) (string-downcase color))) 
		   color-table)))
      (if c (cadr c) (list)))))

(define get-prop-entry (lambda (p) (hash-ref property-hash-table p)))

(define lookup-in-cascade (lambda (cascade selector property) '()))

(define get-default (lambda (property-entry) '()))

(define get-ancestors 
  (lambda (doc node)
    (if (null? node)
	(list)
	(let ((p (get-sxml-parent doc node)))
	  (if (and p (not (null? p))) 
	      (cons p (get-ancestors doc p)) 
	      (list))))))

(define expand-stylesheet
  (lambda (stylesheet)
    (let ((ret (list)))
      (for-each 
       (lambda (x)
	 (for-each (lambda (y)
		     (let ((cx (cdr x)))
		       (or (null? cx) 
			   (set! ret (append ret (list (cons y cx)))))))
		   (car x)))
       stylesheet)
      ret)))

(define get-more-general-properties
  (lambda (prop)
    (let ((prop-bits (string-split prop #\-)))
      (cond ((<= (length prop-bits) 1) (list))
	    ((member (car prop-bits) 
		     '("background" "margin" "outline" "padding"))
	     (list (car prop-bits)))
	    ((and (equal? (car prop-bits) "list")
		  (equal? (cadr prop-bits) "style"))
	     (list "list-style"))
	    ((equal? (car prop-bits) "border")
	     (if (eqv? (length prop-bits) 2) 
		 (list "border")
		 (list (string-append "border-" (cadr prop-bits))
		       (string-append "border-" (caddr prop-bits))
		       "border")))
	    (else (list))))))

;; This function is a bit complicated.  The general idea is that for certain
;; properties, if they're not explicitly defined in the matched selector 
;; block, you can derive their value by looking at a more general property 
;; that is defined in that block.

(define get-general-property
  (lambda (sprop val oa)
    (let* ((split-matches 
	    (lambda (pattern str)
	      (let* ((lst (list))
		     (f (lambda (x) 
			  (set! lst (append 
				     lst (list (match:substring x)))))))
		(regexp-substitute/global #f pattern str f 'post)
		lst)))

	   (prop-bits (string-split sprop #\-))

	   ;; The way values are mapped to specific properties depends on the 
	   ;; number of values as per 
	   ;; http://www.w3.org/TR/CSS21/box.html#propdef-border-top-color

	   (g (lambda (pat d x)
		(let ((ml (split-matches pat x)))
		  (case (length ml)
		    ((1) (car ml)) 
		    ((2) (if (member d '("top" "bottom")) (car ml) (cadr ml)))
		    ((3) (cond ((equal? d "top") (car ml))
			       ((member d '("left" "right")) (cadr ml))
			       (else (caddr ml))))
		    ((4) (list-ref 
			  ml (list-index (lambda (y) (equal? y d))
					 '("top" "right" "bottom" "left"))))
		    (else #f)))))
 	   (h (lambda (str pattern)
		(let ((match (if (string? pattern) 
				 (string-match pattern str)
				 (regexp-exec pattern str))))
		  (if match (match:substring match) #f))))
	   (cl (lambda ()
		 (let ((l (apply scss:select-value (append oa '("color")))))
		   (if (null? l) #f l)))))
      (cond ((= (length prop-bits) 1) #f)
	    ((equal? (car prop-bits) "border")
	     (if (= (length prop-bits) 2)
		 (cond ((equal? (cadr prop-bits) "color") 
			(let ((res (h val color-regex)))
			  (if res res (cl))))
		       ((equal? (cadr prop-bits) "width")
			(h val border-width-regex))
		       ((equal? (cadr prop-bits) "style")
			(h val border-style-regex))
		       
		       ;; Else it's one of top, left, bottom, right
		       
		       (else (car b)))
		 (let* ((c (caddr prop-bits))
			(d (string-append (car prop-bits) 
					  "-" (cadr prop-bits))))
		   (cond ((equal? (caddr prop-bits) "color")
			  (let ((res (g color-regex (cadr prop-bits) val)))
			    (if res res (cl))))
			 ((equal? (caddr prop-bits) "width")
			  (g border-width-regex (cadr prop-bits) val))
			 ((equal? (caddr prop-bits) "style")
			  (g border-style-regex (cadr prop-bits) val))))))
	    ((equal? (car prop-bits) "padding")
	     (g padding-regex (cadr prop-bits) val))
	    ((equal? (car prop-bits) "margin")
	     (g margin-regex (cadr prop-bits) val))
	    ((equal? (car prop-bits) "background")
	     (cond ((equal? (cadr prop-bits) "color") (h val pcolor-regex))
		   ((equal? (cadr prop-bits) "attach") (h val pattach-regex))
		   ((equal? (cadr prop-bits) "image") (h val pimage-regex))
		   ((equal? (cadr prop-bits) "repeat") (h val prepeat-regex))
		   ;; FIX THIS!!!
		   ((equal? (cadr prop-bits) "position"))
		   (else #f)))
	    ((and (equal? (car prop-bits) "list")
		  (equal? (cadr prop-bits) "style"))
	     (cond ((equal? (caddr prop-bits) "position")
		    (h val (string-append lsposition-regex "|(inherit)")))
		   ((equal? (caddr prop-bits) "image")
		    (h val (string-append lsimage-regex "|(inherit)")))
		   ((equal? (caddr prop-bits) "type")
		    (h val (string-append lstype-regex "|(inherit)")))
		   (else #f)))
	    ((equal? (car prop-bits) "outline")
	     (cond ((equal? (cadr prop-bits) "color")
		    (h val (string-append ocolor-regex "|(inherit)")))
		   ((equal? (cadr prop-bits) "style")
		    (h val (string-append ostyle-regex "|(inherit)")))
		   ((equal? (cadr prop-bits) "width")
		    (h val (string-append owidth-regex "|(inherit)")))
		   (else #f)))
	    ((equal? (car prop-bits) "font")
	     (cond ((equal? (cadr prop-bits) "family") (h val ffamily-regex))
		   ((equal? (cadr prop-bits) "size") (h val fsize-regex))
		   ((equal? (cadr prop-bits) "style") (h val fstyle-regex))
		   ((equal? (cadr prop-bits) "variant") (h val fvariant-regex))
		   ((equal? (cadr prop-bits) "weight") (h val fweight-regex))
		   (else #f)))
	    (else #f)))))

(define lookup-values
  (lambda (cascade selector table)
    (let* ((f (lambda (sym) (lambda (x) (cons sym x))))
	   (h (lambda (x) (and (= (length (car x)) 1)
			       (or (equal? (caar x) selector)
				   (equal? (caar x) "*")))))
	   (i (lambda (sym sheet)
		(fold append
		      '()
		      (map (lambda (x)
			     (map (lambda (y) (cons sym (cons (car x) y)))
				  (cdr x)))
			   (filter h sheet)))))
	   (agent-matches (i 'agent (car cascade)))
	   (user-matches (i 'user (cadr cascade)))
	   (author-matches (i 'author (caddr cascade)))
	   (results (append '() agent-matches user-matches author-matches))
	   (sr (sort results (lambda (x y) 
			       (and (<= (calc-precedence x)
					(calc-precedence y))
				    (<= (calc-specificity (cadr x))
					(calc-specificity (cadr y)))))))
	   (order 0))
      (for-each (lambda (x) 
		  (let ((sdcy (string-downcase (caddr x)))
			(sdcv (string-downcase (cadddr x))))		    
		    (if (hash-ref property-hash-table sdcy)
			(begin
			  (hash-set! table sdcy (cons sdcy (cons sdcv order)))
			  (set! order (+ order 1))))))
		sr))))

(define selector-match?
  (lambda (sel d nodes)
    (letrec ((next-ident (lambda (sel-list)
			   (let ((r (find (lambda (x) 
					    (not (memv (string-ref x 0)
						       '(#\# #\: #\. 
							 #\+ #\>))))
					  sel-list)))
			     (if r r "*")))))
      (let* ((snn (if (null? nodes) '() (sxml-node-name (car nodes))))
	     (ni (next-ident sel))
	     (csel (false-if-exception (car sel)))
	     (srcsel (false-if-exception (string-ref csel 0))))
	(cond ((null? snn) #f)
	      ((not csel) #t)
	      ((equal? csel ":first-child")
	       (if (>= (length nodes) 2)
		   (let ((cl (find (lambda (x) 
				     (and (list x) (not (eq? (car x) '@))))
				   (cdadr nodes))))
		     (if (and cl (eq? (car nodes) (car cl)))
			 (selector-match? (cdr sel) d nodes)
			 #f))
		   #f))
	      ((string? (caar nodes)) #f)
	      ((pseudo-class? csel)
	       (if (and (or (equal? ni "*") (equal? snn ni))
			(internal-pseudo-class-handler 
			 (substring (car sel) 1) d (car nodes)))
		   (selector-match? (cdr sel) d nodes)
		   #f))
	      ((pseudo-element? csel)
	       (if (and (or (equal? ni "*") (equal? snn ni))
			(internal-pseudo-element-handler 
			 (substring (car sel) 1) d (car nodes)))
		   (selector-match? (cdr sel) d nodes)
		   #f))
	      ((eqv? srcsel #\#)
	       (if (and (or (equal? ni "*") (equal? snn ni))
			(internal-id-handler 
			 (substring (car sel) 1) d (car nodes)))
		   (selector-match? (cdr sel) d nodes)
		   #f))
	      ((eqv? srcsel #\.)
	       (letrec ((g (lambda (x)
			     (if (and (not (null? x))
				      (equal? (substring (car x) 0 1)
					      "."))
				 (cons (substring (car x) 1) 
				       (g (cdr x)))
				 '()))))
		 (let ((l (cons (substring csel 1) 
				(g (cdr sel)))))
		   (if (and (or (equal? ni "*") (equal? snn ni))
			    (internal-dot-handler l d (car nodes)))
		       (selector-match? (list-cdr-ref sel (length l)) d nodes)
		       #f))))
	      ((eqv? srcsel #\[)
	       (let* ((match (regexp-exec attr-sel-regexc 
					  (car sel)))
		      (l (match:substring match 1))
		      (t (match:substring match 15))
		      (r (match:substring match 16))
		      (v (sxml-attr-val (car nodes) l)))
		 (if (and (string? r)
			  (or (and (eqv? (string-ref r 0) #\")
				   (eqv? (string-ref r (- (string-length r) 1))
					 #\"))
			      (and (eqv? (string-ref r 0) #\')
				   (eqv? (string-ref r (- (string-length r) 1))
					 #\'))))
		     (set! r (substring r 1 (- (string-length r) 1))))
		 (if (and v (or (and (equal? t "=")
				     (equal? (cadr v) 
					     (substring 
					      r 1 (- (string-length r) 2))))
				(and (equal? t "~=")
				     (find (lambda (x) (equal? x r))
					   (string-split (cadr v) #\sp)))
				(and (equal? t "|=")
				     (> (string-length (cadr v))
					(+ (string-length r) 1))
				     (equal? (substring 
					      (cadr v) 0 
					      (+ (string-length r) 1))
					     (string-append r "-")))
				(not t)))
		     (selector-match? (cdr sel) d nodes)
		     #f)))
	      ((or (eqv? srcsel #\*) (equal? csel snn))
	       (let ((i (list-index 
			 (lambda (x)
			   (let ((nix (next-ident (cdr sel))))
			     (or (equal? nix "*")
				 (equal? (sxml-node-name x) 
					 (next-ident (cdr sel))))))
			 (cdr nodes))))
		 (cond ((null? (cdr sel)) #t)
		       (i (selector-match? (cdr sel) d 
					   (list-cdr-ref (cdr nodes) i)))
		       (else #f))))
	      ((null? sel) #t)
	      (else #f))))))

(define select-values
  (lambda (cascade node doc table)
    (let* ((a (cons node (get-ancestors doc node)))
	   (f (lambda (sym) (lambda (x) (cons sym x))))
	   (h (lambda (x) (and (not (null? (cdr x)))
			       (selector-match? (reverse (car x)) doc a))))
	   (i (lambda (sym sheet)
		(fold append
		      '()
		      (map (lambda (x)
			     (map (lambda (y) (cons sym (cons (car x) y)))
				  (cdr x)))
			   (filter h sheet)))))
	   (agent-matches (i 'agent (car cascade)))
	   (user-matches (i 'user (cadr cascade)))
	   (author-matches (i 'author (caddr cascade)))
	   (results (append '() author-matches user-matches agent-matches))
	   (sr (sort results 
		     (lambda (x y)
		       (let ((cpx (calc-precedence x))
			     (cpy (calc-precedence y)))
			 (or (< cpx cpy)
			     (and (eqv? cpx cpy)
				  (<= (calc-specificity (cadr x))
				      (calc-specificity (cadr y)))))))))
	   (order 0))
      (for-each (lambda (x) 
		  (let ((sdcy (string-downcase (caddr x)))
			(sdcv (string-downcase (cadddr x))))
		    (if (hash-ref property-hash-table sdcy)
			(begin
			  (hash-set! table sdcy (cons sdcy (cons sdcv order)))
			  (set! order (+ order 1))))))
		sr))))
  
(define get-default-prop-value
  (lambda (pe) 
    (if (or (not pe) (null? pe))
	(list)
	(fold (lambda (x y)
		(let ((z (if (equal? y "") "" (string-append " " y)))) 
		  (if (symbol? x)
		      (let ((r (get-default-prop-value 
				(get-prop-entry 
				 (symbol->string x)))))
			(if (and r (not (null? r))) (string-append r z) z))
		      (string-append x z))))
	      ""
	      (list-ref pe 1)))))

(define scss:get-default-value
  (lambda (str) 
    (verify-arg-types "scss:get-default-value" (list string?) (list str) 1)
    (get-default-prop-value (get-prop-entry (string-downcase str)))))

(define scss:inherited? 
  (lambda (str) (let ((pe (get-prop-entry str))) (and pe (list-ref pe 2)))))

(define gsds
  (lambda (d)
    (let* ((c (filter (lambda (x) (and (list? x) (not (eq? (car x) '@)))) d))
	   (lc (length c)))
      (for-each (lambda (x) (set! lc (+ lc (gsds x)))) c) lc)))

(define lookup-value
  (lambda (source selector recurse prop)
    (let* ((d (hashx-ref cascade-hash cascade-assoc cascade-hash-table source))
	   (d (if d d (let ((dh (make-hash-table 32)))
			(hashx-set! cascade-hash cascade-assoc 
				    cascade-hash-table source dh)
			dh)))
	   (pe (get-prop-entry (string-downcase prop)))
	   (e (hashq-ref d selector))
	   (e (if e e (let ((eh (make-hash-table num-css-props)))
			(lookup-values source selector eh)
			(hash-set! d selector eh)
			eh)))
	   (vs (sort (cons (hash-ref e prop)
			   (map (lambda (z) (hash-ref e z))
				(get-more-general-properties prop)))
		     (lambda (x y) 
		       (or (not y) (and x (> (cddr x) (cddr y)))))))
	   (v (if (car vs)		  
		  (if (equal? (caar vs) prop)
		      (cadar vs)
		      (get-general-property prop 
					    (cadar vs) 
					    (list source selector)))
		  #f)))
      (if v 
	  (string-downcase v) 
	  (if recurse (get-default-prop-value (get-prop-entry prop)) '())))))

(define select-value
  (lambda (source selector recurse doc prop)
    (let* ((d (hashq-ref document-hash-table doc))
	   (d (if d d (begin (let ((dh (make-weak-key-hash-table (gsds doc))))
			       (hashq-set! document-hash-table doc dh)
			       dh))))
	   (c (hashx-ref cascade-hash cascade-assoc d source))
	   (c (if c c (begin (let ((ch (make-weak-key-hash-table 16)))
			       (hashx-set! cascade-hash cascade-assoc d source 
					   ch)
			       ch))))
	   (create-hash (lambda (elt)
			  (let ((eh (make-hash-table 32)))
			    (select-values source elt doc eh)
			    (hashq-set! c elt eh)
			    eh)))
	   (pe (get-prop-entry (string-downcase prop))))
      (letrec 
	  ((f (lambda (ht elt)
		(let* ((e (hashq-ref c elt))
		       (e (if e e (create-hash elt)))
		       (sdp (string-downcase prop))
		       
		       ;; The most specific property might not be the best
		       ;; match -- look at ALL the related properties and
		       ;; derive the requested value if it's not the most
		       ;; specific.
		       
		       (vs (sort (cons (hash-ref e sdp)
				       (map (lambda (z) (hash-ref e z))
					    (get-more-general-properties sdp)))
				 (lambda (x y)
				   (or (not y)
				       (and x (> (cddr x) (cddr y)))))))
		       (v (if (car vs)
			      (if (equal? (caar vs) prop)
				  (cadar vs)
				  (get-general-property prop 
							(cadar vs)
							(list source elt doc)))
			      #f))
		       (par (get-sxml-parent d elt)))
		  (if (and recurse
			   (and par (not (null? par)))
			   (or (and (not v) pe (list-ref pe 2))
			       (equal? v "inherit")))
		      (f ht par)
		      v)))))
	(let ((val (f c selector)))
	  (if val
	      (string-downcase val)
	      (if recurse 
		  (get-default-prop-value (get-prop-entry prop)) 
		  '())))))))
      
(define scss:select-value
  (lambda (source selector . r)
    (apply (if (string? selector) lookup-value select-value)
	   (append (list source selector #t) r))))

(define scss:select-value-at-node
  (lambda (source selector . r)
    (apply (if (string? selector) lookup-value select-value)
	   (append (list source selector #f) r))))

(define scss:clear-style-cache!
  (lambda (source selector . r)
    (if (string? selector)
	(let ((d (hashx-ref cascade-hash cascade-assoc cascade-hash-table 
			    source)))
	  (if d (hash-remove! d selector)))
	(let* ((d (hashq-ref document-hash-table (car r)))) 
	  (if d (let ((c (hashx-ref cascade-hash cascade-assoc d source)))
		  (if c (hashq-remove! c selector))))))))