Skip to content
Browse files

Add a Common Lisp mode

  • Loading branch information...
1 parent d00082a commit f23da64e25b4a49c267b84dff9287c3e5a82b6f0 @marijnh marijnh committed Sep 10, 2012
Showing with 267 additions and 2 deletions.
  1. +1 −0 doc/compress.html
  2. +1 −0 index.html
  3. +2 −2 lib/codemirror.css
  4. +98 −0 mode/commonlisp/commonlisp.js
  5. +165 −0 mode/commonlisp/index.html
View
1 doc/compress.html
@@ -62,6 +62,7 @@
<option value="http://codemirror.net/mode/clike/clike.js">clike.js</option>
<option value="http://codemirror.net/mode/clojure/clojure.js">clojure.js</option>
<option value="http://codemirror.net/mode/coffeescript/coffeescript.js">coffeescript.js</option>
+ <option value="http://codemirror.net/mode/commonlisp/commonlisp.js">commonlisp.js</option>
<option value="http://codemirror.net/mode/css/css.js">css.js</option>
<option value="http://codemirror.net/mode/diff/diff.js">diff.js</option>
<option value="http://codemirror.net/mode/ecl/ecl.js">ecl.js</option>
View
1 index.html
@@ -38,6 +38,7 @@ <h2 style="margin-top: 0">Supported modes:</h2>
<li><a href="mode/clike/index.html">C, C++, C#</a></li>
<li><a href="mode/clojure/index.html">Clojure</a></li>
<li><a href="mode/coffeescript/index.html">CoffeeScript</a></li>
+ <li><a href="mode/commonlisp/index.html">Common Lisp</a></li>
<li><a href="mode/css/index.html">CSS</a></li>
<li><a href="mode/diff/index.html">diff</a></li>
<li><a href="mode/ecl/index.html">ECL</a></li>
View
4 lib/codemirror.css
@@ -145,7 +145,7 @@ div.CodeMirror-selected { background: #d9d9d9; }
.cm-s-default span.cm-error {color: #f00;}
.cm-s-default span.cm-qualifier {color: #555;}
.cm-s-default span.cm-builtin {color: #30a;}
-.cm-s-default span.cm-bracket {color: #cc7;}
+.cm-s-default span.cm-bracket {color: #997;}
.cm-s-default span.cm-tag {color: #170;}
.cm-s-default span.cm-attribute {color: #00c;}
.cm-s-default span.cm-header {color: blue;}
@@ -170,4 +170,4 @@ div.CodeMirror span.CodeMirror-nonmatchingbracket {color: #f22;}
visibility: hidden;
}
-}
+}
View
98 mode/commonlisp/commonlisp.js
@@ -0,0 +1,98 @@
+CodeMirror.defineMode("commonlisp", function (config) {
+ var assumeBody = /^with|^def|^do|^prog|case$|^cond$|bind$|when$|unless$/;
+ var numLiteral = /^(?:[+\-]?(?:\d+|\d*\.\d+)(?:[efd][+\-]?\d+)?|[+\-]?\d+(?:\/[+\-]?\d+)?|#b[+\-]?[01]+|#o[+\-]?[0-7]+|#x[+\-]?[\da-f]+)/;
+ var symbol = /[^\s'`,@()\[\]";]/;
+ var type;
+
+ function readSym(stream) {
+ while (ch = stream.next()) {
+ if (ch == "\\") stream.next();
+ else if (!symbol.test(ch)) { stream.backUp(1); break; }
+ }
+ return stream.current();
+ }
+
+ function base(stream, state) {
+ if (stream.eatSpace()) {type = "ws"; return null;}
+ if (stream.match(numLiteral)) return "number";
+ var ch = stream.next();
+ if (ch == "\\") ch = stream.next();
+
+ if (ch == '"') return (state.tokenize = inString)(stream, state);
+ else if (ch == "(") { type = "open"; return "bracket"; }
+ else if (ch == ")" || ch == "]") { type = "close"; return "bracket"; }
+ else if (ch == ";") { stream.skipToEnd(); type = "ws"; return "comment"; }
+ else if (/['`,@]/.test(ch)) return null;
+ else if (ch == "|") {
+ if (stream.skipTo("|")) { stream.next(); return "symbol"; }
+ else { stream.skipToEnd(); return "error"; }
+ } else if (ch == "#") {
+ if (stream.eat("[")) { type = "open"; return "bracket"; }
+ else if (stream.eat(/[+\-=\.]/)) return null;
+ else if (stream.match(/^\d+#/)) return null;
+ else if (stream.eat("|")) return (state.tokenize = inComment)(stream, state);
+ else if (stream.eat(":")) { readSym(stream); return "meta"; }
+ else { stream.next(); return "error"; }
+ } else {
+ var name = readSym(stream);
+ if (name == ".") return null;
+ type = "symbol";
+ if (name == "nil" || name == "t") return "atom";
+ if (name.charAt(0) == ":") return "keyword";
+ return "variable";
+ }
+ }
+
+ function inString(stream, state) {
+ var escaped = false, next;
+ while (next = stream.next()) {
+ if (next == '"' && !escaped) { state.tokenize = base; break; }
+ escaped = !escaped && next == "\\";
+ }
+ return "string";
+ }
+
+ function inComment(stream, state) {
+ var next, last;
+ while (next = stream.next()) {
+ if (next == "#" && last == "|") { state.tokenize = base; break; }
+ last = next;
+ }
+ type = "ws";
+ return "comment";
+ }
+
+ return {
+ startState: function () {
+ return {ctx: {prev: null, start: 0, indentTo: 0}, tokenize: base};
+ },
+
+ token: function (stream, state) {
+ if (stream.sol() && typeof state.ctx.indentTo != "number")
+ state.ctx.indentTo = state.ctx.start + 1;
+
+ type = null;
+ var style = state.tokenize(stream, state);
+ if (type != "ws") {
+ if (state.ctx.indentTo == null) {
+ if (type == "symbol" && assumeBody.test(stream.current()))
+ state.ctx.indentTo = state.ctx.start + config.indentUnit;
+ else
+ state.ctx.indentTo = "next";
+ } else if (state.ctx.indentTo == "next") {
+ state.ctx.indentTo = stream.column();
+ }
+ }
+ if (type == "open") state.ctx = {prev: state.ctx, start: stream.column(), indentTo: null};
+ else if (type == "close") state.ctx = state.ctx.prev;
+ return style;
+ },
+
+ indent: function (state, textAfter) {
+ var i = state.ctx.indentTo;
+ return typeof i == "number" ? i : state.ctx.start + 1;
+ }
+ };
+});
+
+CodeMirror.defineMIME("text/x-common-lisp", "commonlisp");
View
165 mode/commonlisp/index.html
@@ -0,0 +1,165 @@
+<!doctype html>
+<html>
+ <head>
+ <meta charset="utf-8">
+ <title>CodeMirror: Common Lisp mode</title>
+ <link rel="stylesheet" href="../../lib/codemirror.css">
+ <script src="../../lib/codemirror.js"></script>
+ <script src="commonlisp.js"></script>
+ <style>.CodeMirror {background: #f8f8f8;}</style>
+ <link rel="stylesheet" href="../../doc/docs.css">
+ </head>
+ <body>
+ <h1>CodeMirror: Common Lisp mode</h1>
+ <form><textarea id="code" name="code">(in-package :cl-postgres)
+
+;; These are used to synthesize reader and writer names for integer
+;; reading/writing functions when the amount of bytes and the
+;; signedness is known. Both the macro that creates the functions and
+;; some macros that use them create names this way.
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (defun integer-reader-name (bytes signed)
+ (intern (with-standard-io-syntax
+ (format nil "~a~a~a~a" '#:read- (if signed "" '#:u) '#:int bytes))))
+ (defun integer-writer-name (bytes signed)
+ (intern (with-standard-io-syntax
+ (format nil "~a~a~a~a" '#:write- (if signed "" '#:u) '#:int bytes)))))
+
+(defmacro integer-reader (bytes)
+ "Create a function to read integers from a binary stream."
+ (let ((bits (* bytes 8)))
+ (labels ((return-form (signed)
+ (if signed
+ `(if (logbitp ,(1- bits) result)
+ (dpb result (byte ,(1- bits) 0) -1)
+ result)
+ `result))
+ (generate-reader (signed)
+ `(defun ,(integer-reader-name bytes signed) (socket)
+ (declare (type stream socket)
+ #.*optimize*)
+ ,(if (= bytes 1)
+ `(let ((result (the (unsigned-byte 8) (read-byte socket))))
+ (declare (type (unsigned-byte 8) result))
+ ,(return-form signed))
+ `(let ((result 0))
+ (declare (type (unsigned-byte ,bits) result))
+ ,@(loop :for byte :from (1- bytes) :downto 0
+ :collect `(setf (ldb (byte 8 ,(* 8 byte)) result)
+ (the (unsigned-byte 8) (read-byte socket))))
+ ,(return-form signed))))))
+ `(progn
+;; This causes weird errors on SBCL in some circumstances. Disabled for now.
+;; (declaim (inline ,(integer-reader-name bytes t)
+;; ,(integer-reader-name bytes nil)))
+ (declaim (ftype (function (t) (signed-byte ,bits))
+ ,(integer-reader-name bytes t)))
+ ,(generate-reader t)
+ (declaim (ftype (function (t) (unsigned-byte ,bits))
+ ,(integer-reader-name bytes nil)))
+ ,(generate-reader nil)))))
+
+(defmacro integer-writer (bytes)
+ "Create a function to write integers to a binary stream."
+ (let ((bits (* 8 bytes)))
+ `(progn
+ (declaim (inline ,(integer-writer-name bytes t)
+ ,(integer-writer-name bytes nil)))
+ (defun ,(integer-writer-name bytes nil) (socket value)
+ (declare (type stream socket)
+ (type (unsigned-byte ,bits) value)
+ #.*optimize*)
+ ,@(if (= bytes 1)
+ `((write-byte value socket))
+ (loop :for byte :from (1- bytes) :downto 0
+ :collect `(write-byte (ldb (byte 8 ,(* byte 8)) value)
+ socket)))
+ (values))
+ (defun ,(integer-writer-name bytes t) (socket value)
+ (declare (type stream socket)
+ (type (signed-byte ,bits) value)
+ #.*optimize*)
+ ,@(if (= bytes 1)
+ `((write-byte (ldb (byte 8 0) value) socket))
+ (loop :for byte :from (1- bytes) :downto 0
+ :collect `(write-byte (ldb (byte 8 ,(* byte 8)) value)
+ socket)))
+ (values)))))
+
+;; All the instances of the above that we need.
+
+(integer-reader 1)
+(integer-reader 2)
+(integer-reader 4)
+(integer-reader 8)
+
+(integer-writer 1)
+(integer-writer 2)
+(integer-writer 4)
+
+(defun write-bytes (socket bytes)
+ "Write a byte-array to a stream."
+ (declare (type stream socket)
+ (type (simple-array (unsigned-byte 8)) bytes)
+ #.*optimize*)
+ (write-sequence bytes socket))
+
+(defun write-str (socket string)
+ "Write a null-terminated string to a stream \(encoding it when UTF-8
+support is enabled.)."
+ (declare (type stream socket)
+ (type string string)
+ #.*optimize*)
+ (enc-write-string string socket)
+ (write-uint1 socket 0))
+
+(declaim (ftype (function (t unsigned-byte)
+ (simple-array (unsigned-byte 8) (*)))
+ read-bytes))
+(defun read-bytes (socket length)
+ "Read a byte array of the given length from a stream."
+ (declare (type stream socket)
+ (type fixnum length)
+ #.*optimize*)
+ (let ((result (make-array length :element-type '(unsigned-byte 8))))
+ (read-sequence result socket)
+ result))
+
+(declaim (ftype (function (t) string) read-str))
+(defun read-str (socket)
+ "Read a null-terminated string from a stream. Takes care of encoding
+when UTF-8 support is enabled."
+ (declare (type stream socket)
+ #.*optimize*)
+ (enc-read-string socket :null-terminated t))
+
+(defun skip-bytes (socket length)
+ "Skip a given number of bytes in a binary stream."
+ (declare (type stream socket)
+ (type (unsigned-byte 32) length)
+ #.*optimize*)
+ (dotimes (i length)
+ (read-byte socket)))
+
+(defun skip-str (socket)
+ "Skip a null-terminated string."
+ (declare (type stream socket)
+ #.*optimize*)
+ (loop :for char :of-type fixnum = (read-byte socket)
+ :until (zerop char)))
+
+(defun ensure-socket-is-closed (socket &amp;key abort)
+ (when (open-stream-p socket)
+ (handler-case
+ (close socket :abort abort)
+ (error (error)
+ (warn "Ignoring the error which happened while trying to close PostgreSQL socket: ~A" error)))))
+</textarea></form>
+ <script>
+ var editor = CodeMirror.fromTextArea(document.getElementById("code"), {lineNumbers: true});
+ </script>
+
+ <p><strong>MIME types defined:</strong> <code>text/x-common-lisp</code>.</p>
+
+ </body>
+</html>

0 comments on commit f23da64

Please sign in to comment.
Something went wrong with that request. Please try again.