Find file
Fetching contributors…
Cannot retrieve contributors at this time
60 lines (48 sloc) 2 KB
;; coloring-support.lisp
(in-package :colorize)
(defun close-dangling-parenthesis (paren-counter)
"Emit enough </span> tags to account for missing close parenthesis in the source."
(format nil "~{~A~}"
(loop for i from paren-counter downto 1
collect "</span></span>")))
(defmacro format-parenthesis (paren &key
open-parens close-parens
before-paren after-paren
paren-counter)
"Macro to help emmitting parenthesis.
It will result in a string wrapping the paren in appropriate <span> or </span>
tags. The optional arguments before-paren and after-paren are
added at the begin/end of the resulting string.
Note that paren, open-parens and close-parens are evaluated once as arguments.
However, paren-counter should be a setf'able counter and is modified.
Also the before-paren and after-paren are evalulated once, however only
AFTER the paren-counter is updated. This is done to be compatible with
the boiler plate code this replaces.
There is one case it is needed, and that is when the argument to :after-paren
is the following expression
:after-paren (colorize after-paren)
In this case the after paren is colorized with the new nesting level.
This behaviour is tricky and should probably be changed."
(alexandria:once-only (paren open-parens close-parens)
`(or (when (member ,paren (coerce ,open-parens 'list))
(incf ,paren-counter)
(format nil "~A<span class=\"paren~A\">~C<span class=\"~A\">~A"
(or ,before-paren "")
(1+ (mod (- ,paren-counter 1) 6))
,paren
*css-background-class*
(or ,after-paren "")))
(when (member ,paren (coerce ,close-parens 'list))
(decf paren-counter)
(if (> 0 paren-counter)
(progn
(setf paren-counter 0)
(format nil "~A~C~A"
(or ,before-paren "")
,paren
(or ,after-paren "")))
(format nil "~A</span>~C</span>~A"
(or ,before-paren "")
,paren
(or ,after-paren ""))))
(error "Expected paren, but is neither closing paren, nor open paren."))))