Update of /project/lisppaste/cvsroot/lisppaste2
In directory clnet:/tmp/cvs-serv29290
Modified Files:
coloring-types.lisp
Log Message:
Haskell syntax coloring (thanks to Kristof Bastiaensen!)
--- /project/lisppaste/cvsroot/lisppaste2/coloring-types.lisp 2006/08/14 21:34:02 1.20
+++ /project/lisppaste/cvsroot/lisppaste2/coloring-types.lisp 2006/09/05 18:33:47 1.21
@@ -788,4 +788,176 @@
(if (member s *python-reserved-words* :test #'string=)
(format nil "<span class=\"symbol\">~A</span>"
s)
- s)))))
\ No newline at end of file
+ s)))))
+
+(defvar *haskell-open-parens* "([{")
+
+(defvar *haskell-close-parens* ")]}")
+
+(defvar *haskell-in-word*
+ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_0123456789")
+
+(defvar *haskell-begin-id* "abcdefghijklmnopqrstuvwxyz")
+
+(defvar *haskell-begin-cons* "ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+
+(defvar *haskell-in-symbol* "!#$%&*+./<=>?@\\^|-~:")
+
+(defvar *haskell-reserved-symbols*
+ '(".." "::" "@" "~" "=" "->" "<-" "|" "\\"))
+
+(defvar *haskell-reserved-words*
+ '("case" "class" "data" "default" "deriving" "do" "else" "if"
+ "import" "in" "infix" "infixl" "infixr" "instance" "let" "module"
+ "newtype" "of" "then" "type" "where"))
+
+(defvar *haskell-non-constituent*
+ '(#\space #\return #\tab #\newline #\{ #\} #\( #\) #\" #\[ #\]))
+
+(define-coloring-type :haskell "Haskell"
+ :modes (:normal :comment :multi-comment :string :char :identifier
+ :backquote :newline :symbol :parenlike :single-escape)
+ :default-mode :normal
+ :autodetect (lambda (text)
+ (search "haskell" text :test #'char-equal))
+ :transitions
+ (((:normal)
+ ((scan-any *haskell-in-word*)
+ (set-mode :identifier
+ :until (or (scan-any *haskell-non-constituent*)
+ (scan-any *haskell-in-symbol*))
+ :advancing nil))
+ ((scan "--")
+ (set-mode :comment
+ :until (scan-any '(#\return #\newline))
+ :advancing nil))
+ ((scan "{-")
+ (set-mode :multi-comment
+ :until (scan "-}")))
+ ((scan #\")
+ (set-mode :string
+ :until (scan #\")))
+ ((scan #\`)
+ (set-mode :backquote
+ :until (scan #\`)))
+ ((scan "'")
+ (set-mode :char
+ :until (scan #\')))
+ ((scan-any *haskell-in-symbol*)
+ (set-mode :symbol
+ :until (or (scan-any *haskell-non-constituent*)
+ (scan-any *haskell-in-word*)
+ (scan #\'))
+ :advancing nil))
+ ((or (scan-any *haskell-open-parens*)
+ (scan-any *haskell-close-parens*))
+ (set-mode :parenlike
+ :until (advance 1)
+ :advancing nil))
+ ((scan-any '(#\newline #\return))
+ (set-mode :newline
+ :until (advance 1)
+ :advancing nil)))
+ ((:string)
+ ((scan #\\)
+ (set-mode :single-escape
+ :until (advance 1))))
+ ((:char)
+ ((scan #\\)
+ (set-mode :single-escape
+ :until (advance 1)))))
+ :formatter-variables
+ ((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>")))
+ :formatters
+ (((:normal)
+ (lambda (type s)
+ (declare (ignore type))
+ (cond (beginning-of-line
+ (setq beginning-of-line nil)
+ (if (char= (elt s 0) #\space)
+ (concatenate 'string " " (subseq s 1))
+ s))
+ (t s))))
+ ((:newline)
+ (lambda (type s)
+ (declare (ignore type))
+ (setq beginning-of-line t)
+ s))
+ ((:backquote)
+ (lambda (type s)
+ (declare (ignore type))
+ (setq beginning-of-line nil)
+ (if (find (elt s 1) *haskell-begin-cons*)
+ (format nil "<span class=\"variable\">~A</span>"
+ s)
+ (format nil "<span class=\"atom\">~A</span>"
+ s))))
+ ((:comment :multi-comment)
+ (lambda (type s)
+ (declare (ignore type))
+ (setq beginning-of-line nil)
+ (format nil "<span class=\"comment\">~A</span>"
+ s)))
+ ((:string)
+ (lambda (type s)
+ (declare (ignore type))
+ (setq beginning-of-line nil)
+ (format nil "<span class=\"string\">~A</span>"
+ s)))
+ ((:char)
+ (lambda (type s)
+ (declare (ignore type))
+ (setq beginning-of-line nil)
+ (format nil "<span class=\"character\">~A</span>"
+ s)))
+ ((:identifier)
+ (lambda (type s)
+ (declare (ignore type))
+ (prog1
+ (cond ((find (elt s 0) *haskell-begin-cons*)
+ (format nil "<span class=\"variable\">~A</span>" s))
+ ((member s *haskell-reserved-words* :test #'string=)
+ (format nil "<span class=\"keyword\">~A</span>" s))
+ (beginning-of-line
+ (format nil "<span class=\"function\">~A</span>" s))
+ (t s))
+ (setq beginning-of-line nil))))
+ ((:symbol)
+ (lambda (type s)
+ (declare (ignore type))
+ (setq beginning-of-line nil)
+ (cond ((member s *haskell-reserved-symbols* :test #'string=)
+ (format nil "<span class=\"keyword\">~A</span>" s))
+ ((char= (elt s 0) #\:)
+ (format nil "<span class=\"variable\">~A</span>" s))
+ (t (format nil "<span class=\"atom\">~A</span>" s)))))
+ ((:single-escape)
+ (lambda (type s)
+ (call-formatter (cdr type) s)))
+ ((:parenlike)
+ (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))))))
\ No newline at end of file
