[Lisppaste-cvs] CVS update: lisppaste2/colorize.lisp lisppaste2/coloring-types.lisp
Brian Mastenbrook
bmastenbrook at common-lisp.net
Fri Jun 11 14:34:34 UTC 2004
Update of /project/lisppaste/cvsroot/lisppaste2
In directory common-lisp.net:/home/bmastenbrook/lisppaste2
Modified Files:
colorize.lisp coloring-types.lisp
Log Message:
C/C++/Java support
Date: Fri Jun 11 07:34:34 2004
Author: bmastenbrook
Index: lisppaste2/colorize.lisp
diff -u lisppaste2/colorize.lisp:1.2 lisppaste2/colorize.lisp:1.3
--- lisppaste2/colorize.lisp:1.2 Thu Jun 3 07:17:04 2004
+++ lisppaste2/colorize.lisp Fri Jun 11 07:34:34 2004
@@ -16,7 +16,9 @@
(autodetect-function :initarg :autodetect-function :accessor coloring-type-autodetect-function
:initform (constantly nil))
(parent-type :initarg :parent-type :accessor coloring-type-parent-type
- :initform nil)))
+ :initform nil)
+ (visible :initarg :visible :accessor coloring-type-visible
+ :initform t)))
(defun find-coloring-type (type)
(if (typep type 'coloring-type)
@@ -28,13 +30,14 @@
(find name *coloring-types*
:key #'cdr
:test #'(lambda (name type)
- (funcall (coloring-type-autodetect-function type) name)))))
+ (and (coloring-type-visible type)
+ (funcall (coloring-type-autodetect-function type) name))))))
(defun coloring-types ()
- (mapcar #'(lambda (type-pair)
- (cons (car type-pair)
- (coloring-type-fancy-name (cdr type-pair))))
- *coloring-types*))
+ (loop for type-pair in *coloring-types*
+ if (coloring-type-visible (cdr type-pair))
+ collect (cons (car type-pair)
+ (coloring-type-fancy-name (cdr type-pair)))))
(defun (setf find-coloring-type) (new-value type)
(if new-value
@@ -115,7 +118,8 @@
(defvar *formatter-local-variables*)
(defmacro define-coloring-type (name fancy-name &key modes default-mode transitions formatters
- autodetect parent formatter-variables (formatter-after-hook '(constantly "")))
+ autodetect parent formatter-variables (formatter-after-hook '(constantly ""))
+ invisible)
(with-gensyms (parent-type term type string current-mode position position-foobage mode-wait new-position advance)
`(let ((,parent-type (or (find-coloring-type ,parent)
(and ,parent
@@ -129,6 +133,7 @@
,@(if autodetect
`(:autodetect-function ,autodetect))
:parent-type ,parent-type
+ :visible (not ,invisible)
:formatter-initial-values (lambda nil
(list* ,@(mapcar #'(lambda (e)
`(cons ',(car e) ,(second e)))
@@ -183,16 +188,17 @@
(values ,position-foobage ,advance)))))
)))))))))))
+(defun full-transition-table (coloring-type-object)
+ (let ((parent (coloring-type-parent-type coloring-type-object)))
+ (if parent
+ (append (coloring-type-transition-functions coloring-type-object)
+ (full-transition-table parent))
+ (coloring-type-transition-functions coloring-type-object))))
+
(defun scan-string (coloring-type string)
(let* ((coloring-type-object (or (find-coloring-type coloring-type)
(error "No such coloring type: ~S" coloring-type)))
- (parent (coloring-type-parent-type coloring-type-object))
- (transitions (append
- (coloring-type-transition-functions
- coloring-type-object)
- (if parent
- (coloring-type-transition-functions
- parent))))
+ (transitions (full-transition-table coloring-type-object))
(result nil)
(low-bound 0)
(current-mode (coloring-type-default-mode coloring-type-object))
Index: lisppaste2/coloring-types.lisp
diff -u lisppaste2/coloring-types.lisp:1.5 lisppaste2/coloring-types.lisp:1.6
--- lisppaste2/coloring-types.lisp:1.5 Fri Jun 4 07:09:51 2004
+++ lisppaste2/coloring-types.lisp Fri Jun 11 07:34:34 2004
@@ -230,3 +230,171 @@
(format nil "<a href=\"~A\" class=\"symbol\">~A</a>"
result (call-parent-formatter))
(call-parent-formatter)))))))
+
+(defvar *c-open-parens* "([{")
+(defvar *c-close-parens* ")]}")
+
+(defvar *c-reserved-words*
+ '("auto" "break" "case" "char" "const"
+ "continue" "default" "do" "double" "else"
+ "enum" "extern" "float" "for" "goto"
+ "if" "int" "long" "register" "return"
+ "short" "signed" "sizeof" "static" "struct"
+ "switch" "typedef" "union" "unsigned" "void"
+ "volatile" "while" "__restrict" "_Bool"))
+
+(define-coloring-type :basic-c "Basic C"
+ :modes (:normal :comment :word-ish :paren-ish :string :char :single-escape :preprocessor)
+ :default-mode :normal
+ :invisible t
+ :transitions
+ ((:normal
+ ((scan-any "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_0123456789")
+ (set-mode :word-ish
+ :until (scan-any '(#\space #\return #\tab #\newline #\. #\/ #\- #\* #\+ #\{ #\} #\( #\) #\' #\" #\[ #\] #\< #\> #\#))
+ :advancing nil))
+ ((scan "/*")
+ (set-mode :comment
+ :until (scan "*/")))
+
+ ((or
+ (scan-any *c-open-parens*)
+ (scan-any *c-close-parens*))
+ (set-mode :paren-ish
+ :until (advance 1)
+ :advancing nil))
+ ((scan #\")
+ (set-mode :string
+ :until (scan #\")))
+ ((or (scan "'\\")
+ (scan #\'))
+ (set-mode :character
+ :until (advance 2))))
+ (:string
+ ((scan #\\)
+ (set-mode :single-escape
+ :until (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>")))
+ :formatters
+ ((:normal
+ (lambda (type s)
+ (declare (ignore type))
+ s))
+ (:comment
+ (lambda (type s)
+ (declare (ignore type))
+ (format nil "<span class=\"comment\">~A</span>"
+ s)))
+ (:string
+ (lambda (type s)
+ (declare (ignore type))
+ (format nil "<span class=\"string\">~A</span>"
+ s)))
+ (:character
+ (lambda (type s)
+ (declare (ignore type))
+ (format nil "<span class=\"character\">~A</span>"
+ s)))
+ (:single-escape
+ (lambda (type s)
+ (call-formatter (cdr type) s)))
+ (: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))))
+ (:word-ish
+ (lambda (type s)
+ (declare (ignore type))
+ (if (member s *c-reserved-words* :test #'string=)
+ (format nil "<span class=\"symbol\">~A</span>" s)
+ s)))
+ ))
+
+(define-coloring-type :c "C"
+ :parent :basic-c
+ :transitions
+ ((:normal
+ ((scan #\#)
+ (set-mode :preprocessor
+ :until (scan-any '(#\return #\newline))))))
+ :formatters
+ ((:preprocessor
+ (lambda (type s)
+ (declare (ignore type))
+ (format nil "<span class=\"special\">~A</span>" s)))))
+
+(defvar *c++-reserved-words*
+ '("asm" "auto" "bool" "break" "case"
+ "catch" "char" /*class*/ "const" "const_cast"
+ "continue" "default" "delete" "do" "double"
+ "dynamic_cast" "else" "enum" "explicit" "export"
+ "extern" "false" "float" "for" "friend"
+ "goto" "if" "inline" "int" "long"
+ "mutable" "namespace" "new" "operator" "private"
+ "protected" "public" "register" "reinterpret_cast" "return"
+ "short" "signed" "sizeof" "static" "static_cast"
+ "struct" "switch" "template" "this" "throw"
+ "true" "try" "typedef" "typeid" "typename"
+ "union" "unsigned" "using" "virtual" "void"
+ "volatile" "wchar_t" "while"))
+
+(define-coloring-type :c++ "C++"
+ :parent :c
+ :transitions
+ ((:normal
+ ((scan "//")
+ (set-mode :comment
+ :until (scan-any '(#\return #\newline))))))
+ :formatters
+ ((:word-ish
+ (lambda (type s)
+ (declare (ignore type))
+ (if (member s *c++-reserved-words* :test #'string=)
+ (format nil "<span class=\"symbol\">~A</span>"
+ s)
+ s)))))
+
+(defvar *java-reserved-words*
+ '("abstract" "boolean" "break" "byte" "case"
+ "catch" "char" "class" "const" "continue"
+ "default" "do" "double" "else" "extends"
+ "final" "finally" "float" "for" "goto"
+ "if" "implements" "import" "instanceof" "int"
+ "interface" "long" "native" "new" "package"
+ "private" "protected" "public" "return" "short"
+ "static" "strictfp" "super" "switch" "synchronized"
+ "this" "throw" "throws" "transient" "try"
+ "void" "volatile" "while"))
+
+(define-coloring-type :java "Java"
+ :parent :c++
+ :formatters
+ ((:word-ish
+ (lambda (type s)
+ (declare (ignore type))
+ (if (member s *java-reserved-words* :test #'string=)
+ (format nil "<span class=\"symbol\">~A</span>"
+ s)
+ s)))))
More information about the Lisppaste-cvs
mailing list