forked from Shiloh/githaven
178 lines
6.5 KiB
HTML
178 lines
6.5 KiB
HTML
|
<!doctype html>
|
||
|
|
|
||
|
|
<title>CodeMirror: Common Lisp mode</title>
|
||
|
|
<meta charset="utf-8"/>
|
||
|
|
<link rel=stylesheet href="../../doc/docs.css">
|
||
|
|
|
||
|
|
<link rel="stylesheet" href="../../lib/codemirror.css">
|
||
|
|
<script src="../../lib/codemirror.js"></script>
|
||
|
|
<script src="commonlisp.js"></script>
|
||
|
|
<style>.CodeMirror {background: #f8f8f8;}</style>
|
||
|
|
<div id=nav>
|
||
|
|
<a href="http://codemirror.net"><h1>CodeMirror</h1><img id=logo src="../../doc/logo.png"></a>
|
||
|
|
|
||
|
|
<ul>
|
||
|
|
<li><a href="../../index.html">Home</a>
|
||
|
|
<li><a href="../../doc/manual.html">Manual</a>
|
||
|
|
<li><a href="https://github.com/codemirror/codemirror">Code</a>
|
||
|
|
</ul>
|
||
|
|
<ul>
|
||
|
|
<li><a href="../index.html">Language modes</a>
|
||
|
|
<li><a class=active href="#">Common Lisp</a>
|
||
|
|
</ul>
|
||
|
|
</div>
|
||
|
|
|
||
|
|
<article>
|
||
|
|
<h2>Common Lisp mode</h2>
|
||
|
|
<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 &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>
|
||
|
|
|
||
|
|
</article>
|