Skip to content


Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tree: bf7ab7f7e0
Fetching contributors…

Cannot retrieve contributors at this time

253 lines (232 sloc) 6.141 kb
; From
; if you want more just use "strings"
(define-constant +css-properties+ '(
:test 'equalp)
;; Write CSS like this: (("p.asdfsaf" "p + p") :property "value" :property "value")
(defun validate-properties (properties)
(loop for (property) on properties by #'cddr
when (keywordp property) do
(assert (member property +css-properties+) (property))))
(defun css-output-properties (properties)
(append (list " {")
(css-output-properties-form properties)
(list "}" #\Newline)))
(defgeneric css-output-selector-form (selector properties))
(defmethod css-output-selector-form ((str string) properties)
(append (list str)
(css-output-properties properties)))
(defun css-selector-form-to-string (form)
(cond ((symbolp form)
(assert (and (eql #\< (char (symbol-name form) 0)) (fboundp form)) (form) "Misspelled? ~A" form)
(subseq (symbol-name form) 1))
(t form)))
(defmethod css-output-selector-form ((sym symbol) properties)
(css-output-selector-form (css-selector-form-to-string sym) properties))
(defmethod css-output-selector-form ((l list) properties)
(case (first l)
(rest l)
(css-output-properties properties)))
(loop for form in (rest l)
append (css-output-selector-form form properties)))
(loop for once = t then nil
for form in l
unless once collect ","
collect (css-selector-form-to-string form))
(css-output-properties properties)))))
(defgeneric css-output-property-form (property value))
(defun css-output-property-value-form (value)
(loop for v in (force-list value) for once = t then nil unless once collect " " collect v))
(defmethod css-output-property-form (property value)
(list* (if (keywordp property)
(string-downcase (symbol-name property))
": "
(css-output-property-value-form value)))
(defun css-output-property-under-different-names (names value)
(loop for p in names
for once = nil then t
(css-output-property-form p value)
unless once collect ";"))
(defmethod css-output-property-form ((property (eql :x-opacity)) value)
(check-type value (real 0 1))
(css-output-property-under-different-names '("opacity" "-moz-opacity") value)
(list ";")
(css-output-property-form "filter" (strcat "alpha(opacity=" (floor (* 100 value)) ")"))))
(defmethod css-output-property-form ((property (eql :x-column-gap)) value)
(css-output-property-under-different-names '("-moz-column-gap" "column-gap") value))
(defmethod css-output-property-form ((property (eql :x-column-width)) value)
(css-output-property-under-different-names '("-moz-column-width" "column-width") value))
(defun css-output-properties-form (properties)
(loop for (property value) on properties by #'cddr
append (css-output-property-form property value)
collect ";"))
(defmacro css-html-style (&body selector-properties)
(flet ((validate (selector properties)
(declare (ignore selector))
(validate-properties properties)))
`(<style :type "text/css"
,@(loop for sp in selector-properties
for selector = (first sp)
for properties = (rest sp)
(validate selector properties)
append (css-output-selector-form selector properties))))))
(defmacro css-attrib (&rest properties)
(validate-properties properties)
(with-sendbuf ()
,@(css-output-properties-form properties))))
Jump to Line
Something went wrong with that request. Please try again.