Browse files

Fixed issue with too many closing parenthesis.

For this a macro is introduced, which replaces the boiler plate of the
emmitting of parenthesis.
The macro will not emmit closing </span> tags, for non-matched closing parenthesis.
  • Loading branch information...
1 parent da7e292 commit a5417e7dde87113894a71a3c0ac89afca269609a @woudshoo woudshoo committed Apr 12, 2013
Showing with 100 additions and 106 deletions.
  1. +59 −0 coloring-support.lisp
  2. +38 −104 coloring-types.lisp
  3. +3 −2 colorize.asd
View
59 coloring-support.lisp
@@ -0,0 +1,59 @@
+;; 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."))))
+
View
142 coloring-types.lisp
@@ -87,9 +87,7 @@
(advance 1))))))))
:formatter-variables ((paren-counter 0))
:formatter-after-hook (lambda nil
- (format nil "~{~A~}"
- (loop for i from paren-counter downto 1
- collect "</span></span>")))
+ (close-dangling-parenthesis paren-counter))
:formatters
(((:normal :first-char-on-line)
(lambda (type s)
@@ -107,24 +105,14 @@
(if paren-pos
(let ((before-paren (subseq s 0 paren-pos))
(after-paren (subseq s (1+ paren-pos)))
- (paren (elt s paren-pos))
- (open nil)
- (count 0))
- (when (member paren *open-parens* :test #'char=)
- (setf count (mod paren-counter 6))
- (incf paren-counter)
- (setf open t))
- (when (member paren *close-parens* :test #'char=)
- (decf paren-counter))
- (if open
- (format nil "~A<span class=\"paren~A\">~C<span class=\"~A\">~A"
- before-paren
- (1+ count)
- paren *css-background-class*
- (color-parens after-paren))
- (format nil "~A</span>~C</span>~A"
- before-paren
- paren (color-parens after-paren))))
+ (paren (elt s paren-pos)))
+
+ (format-parenthesis paren
+ :open-parens *open-parens*
+ :close-parens *close-parens*
+ :paren-counter paren-counter
+ :before-paren before-paren
+ :after-paren (color-parens after-paren)))
s))))
(color-parens s))))
((:symbol :escaped-symbol)
@@ -226,7 +214,7 @@
(call-parent-formatter))))
((:symbol :escaped-symbol)
(lambda (type s)
- (declare (ignore type))
+ (declare (ignore type s))
(call-parent-formatter)))))
(define-coloring-type :elisp "Emacs Lisp"
@@ -317,9 +305,7 @@
:formatter-variables
((paren-counter 0))
:formatter-after-hook (lambda nil
- (format nil "~{~A~}"
- (loop for i from paren-counter downto 1
- collect "</span></span>")))
+ (close-dangling-parenthesis paren-counter))
:formatters
((:normal
(lambda (type s)
@@ -346,24 +332,12 @@
(:paren-ish
(lambda (type s)
(declare (ignore type))
- (let ((open nil)
- (count 0))
- (if (eql (length s) 1)
- (progn
- (when (member (elt s 0) (coerce *c-open-parens* 'list))
- (setf open t)
- (setf count (mod paren-counter 6))
- (incf paren-counter))
- (when (member (elt s 0) (coerce *c-close-parens* 'list))
- (setf open nil)
- (decf paren-counter)
- (setf count (mod paren-counter 6)))
- (if open
- (format nil "<span class=\"paren~A\">~A<span class=\"~A\">"
- (1+ count) s *css-background-class*)
- (format nil "</span>~A</span>"
- s)))
- s))))
+ (if (eql (length s) 1)
+ (format-parenthesis (elt s 0)
+ :open-parens *c-open-parens*
+ :close-parens *c-close-parens*
+ :paren-counter paren-counter)
+ s)))
(:word-ish
(lambda (type s)
(declare (ignore type))
@@ -594,9 +568,7 @@
:formatter-variables
((paren-counter 0))
:formatter-after-hook (lambda nil
- (format nil "~{~A~}"
- (loop for i from paren-counter downto 1
- collect "</span></span>")))
+ (close-dangling-parenthesis paren-counter))
:formatters
(((:normal :first-char-on-line)
(lambda (type s)
@@ -648,24 +620,12 @@
(:paren-ish
(lambda (type s)
(declare (ignore type))
- (let ((open nil)
- (count 0))
- (if (eql (length s) 1)
- (progn
- (when (member (elt s 0) (coerce *erlang-open-parens* 'list))
- (setf open t)
- (setf count (mod paren-counter 6))
- (incf paren-counter))
- (when (member (elt s 0) (coerce *erlang-close-parens* 'list))
- (setf open nil)
- (decf paren-counter)
- (setf count (mod paren-counter 6)))
- (if open
- (format nil "<span class=\"paren~A\">~A<span class=\"~A\">"
- (1+ count) s *css-background-class*)
- (format nil "</span>~A</span>"
- s)))
- s))))
+ (if (eql (length s) 1)
+ (format-parenthesis (elt s 0)
+ :open-parens *erlang-open-parens*
+ :close-parens *erlang-open-parens*
+ :paren-counter paren-counter)
+ s)))
(:word-ish
(lambda (type s)
(declare (ignore type))
@@ -755,24 +715,12 @@
(:paren-ish
(lambda (type s)
(declare (ignore type))
- (let ((open nil)
- (count 0))
- (if (eql (length s) 1)
- (progn
- (when (member (elt s 0) (coerce *c-open-parens* 'list))
- (setf open t)
- (setf count (mod paren-counter 6))
- (incf paren-counter))
- (when (member (elt s 0) (coerce *c-close-parens* 'list))
- (setf open nil)
- (decf paren-counter)
- (setf count (mod paren-counter 6)))
- (if open
- (format nil "<span class=\"paren~A\">~A<span class=\"~A\">"
- (1+ count) s *css-background-class*)
- (format nil "</span>~A</span>"
- s)))
- s))))
+ (if (eql (length s) 1)
+ (format-parenthesis (elt s 0)
+ :open-parens *c-open-parens*
+ :close-parens *c-close-parens*
+ :paren-counter paren-counter)
+ s)))
(:def
(lambda (type s)
(declare (ignore type))
@@ -868,9 +816,7 @@ class=\"keyword\">~A</span>"
((paren-counter 0)
(beginning-of-line t))
:formatter-after-hook (lambda nil
- (format nil "~{~A~}"
- (loop for i from paren-counter downto 1
- collect "</span></span>")))
+ (close-dangling-parenthesis paren-counter))
:formatters
(((:normal)
(lambda (type s)
@@ -942,24 +888,12 @@ class=\"keyword\">~A</span>"
(lambda (type s)
(declare (ignore type))
(setq beginning-of-line nil)
- (let ((open nil)
- (count 0))
- (if (eql (length s) 1)
- (progn
- (when (find (elt s 0) *haskell-open-parens*)
- (setf open t)
- (setf count (mod paren-counter 6))
- (incf paren-counter))
- (when (find (elt s 0) *haskell-close-parens*)
- (setf open nil)
- (decf paren-counter)
- (setf count (mod paren-counter 6)))
- (if open
- (format nil "<span class=\"paren~A\">~A<span class=\"~A\">"
- (1+ count) s *css-background-class*)
- (format nil "</span>~A</span>"
- s)))
- s))))))
+ (if (eql (length s) 1)
+ (format-parenthesis (elt s 0)
+ :open-parens *haskell-open-parens*
+ :close-parens *haskell-close-parens*
+ :paren-counter paren-counter)
+ s)))))
(define-coloring-type :diff "Unified Context Diff"
:default-mode :first-char-on-line
@@ -1084,4 +1018,4 @@ class=\"keyword\">~A</span>"
((:oops)
(lambda (type s)
(declare (ignore type))
- (format nil "<span class=\"syntaxerror\">~A</span>" s)))))
+ (format nil "<span class=\"syntaxerror\">~A</span>" s)))))
View
5 colorize.asd
@@ -12,7 +12,7 @@
:maintainer "Brit Butler <redline6561@gmail.com>"
:version "0.9"
:licence "MIT"
- :depends-on (:html-encode :split-sequence)
+ :depends-on (:html-encode :split-sequence :alexandria)
:components ((:file "colorize-package")
(:file "coloring-css" :depends-on ("colorize-package"))
(:file "colorize" :depends-on ("colorize-package" "coloring-css"))
@@ -21,4 +21,5 @@
(:file "r5rs-lookup")
(:file "elisp-lookup")
(:file "coloring-types"
- :depends-on ("colorize" "clhs-lookup"))))
+ :depends-on ("colorize" "clhs-lookup" "coloring-support"))
+ (:file "coloring-support" :depends-on ("colorize"))))

0 comments on commit a5417e7

Please sign in to comment.