5 <title>CodeMirror: Common Lisp mode</title>
6 <link rel="stylesheet" href="../../lib/codemirror.css">
7 <script src="../../lib/codemirror.js"></script>
8 <script src="commonlisp.js"></script>
9 <style>.CodeMirror {background: #f8f8f8;}</style>
10 <link rel="stylesheet" href="../../doc/docs.css">
13 <h1>CodeMirror: Common Lisp mode</h1>
14 <form><textarea id="code" name="code">(in-package :cl-postgres)
16 ;; These are used to synthesize reader and writer names for integer
17 ;; reading/writing functions when the amount of bytes and the
18 ;; signedness is known. Both the macro that creates the functions and
19 ;; some macros that use them create names this way.
20 (eval-when (:compile-toplevel :load-toplevel :execute)
21 (defun integer-reader-name (bytes signed)
22 (intern (with-standard-io-syntax
23 (format nil "~a~a~a~a" '#:read- (if signed "" '#:u) '#:int bytes))))
24 (defun integer-writer-name (bytes signed)
25 (intern (with-standard-io-syntax
26 (format nil "~a~a~a~a" '#:write- (if signed "" '#:u) '#:int bytes)))))
28 (defmacro integer-reader (bytes)
29 "Create a function to read integers from a binary stream."
30 (let ((bits (* bytes 8)))
31 (labels ((return-form (signed)
33 `(if (logbitp ,(1- bits) result)
34 (dpb result (byte ,(1- bits) 0) -1)
37 (generate-reader (signed)
38 `(defun ,(integer-reader-name bytes signed) (socket)
39 (declare (type stream socket)
42 `(let ((result (the (unsigned-byte 8) (read-byte socket))))
43 (declare (type (unsigned-byte 8) result))
44 ,(return-form signed))
46 (declare (type (unsigned-byte ,bits) result))
47 ,@(loop :for byte :from (1- bytes) :downto 0
48 :collect `(setf (ldb (byte 8 ,(* 8 byte)) result)
49 (the (unsigned-byte 8) (read-byte socket))))
50 ,(return-form signed))))))
52 ;; This causes weird errors on SBCL in some circumstances. Disabled for now.
53 ;; (declaim (inline ,(integer-reader-name bytes t)
54 ;; ,(integer-reader-name bytes nil)))
55 (declaim (ftype (function (t) (signed-byte ,bits))
56 ,(integer-reader-name bytes t)))
58 (declaim (ftype (function (t) (unsigned-byte ,bits))
59 ,(integer-reader-name bytes nil)))
60 ,(generate-reader nil)))))
62 (defmacro integer-writer (bytes)
63 "Create a function to write integers to a binary stream."
64 (let ((bits (* 8 bytes)))
66 (declaim (inline ,(integer-writer-name bytes t)
67 ,(integer-writer-name bytes nil)))
68 (defun ,(integer-writer-name bytes nil) (socket value)
69 (declare (type stream socket)
70 (type (unsigned-byte ,bits) value)
73 `((write-byte value socket))
74 (loop :for byte :from (1- bytes) :downto 0
75 :collect `(write-byte (ldb (byte 8 ,(* byte 8)) value)
78 (defun ,(integer-writer-name bytes t) (socket value)
79 (declare (type stream socket)
80 (type (signed-byte ,bits) value)
83 `((write-byte (ldb (byte 8 0) value) socket))
84 (loop :for byte :from (1- bytes) :downto 0
85 :collect `(write-byte (ldb (byte 8 ,(* byte 8)) value)
89 ;; All the instances of the above that we need.
100 (defun write-bytes (socket bytes)
101 "Write a byte-array to a stream."
102 (declare (type stream socket)
103 (type (simple-array (unsigned-byte 8)) bytes)
105 (write-sequence bytes socket))
107 (defun write-str (socket string)
108 "Write a null-terminated string to a stream \(encoding it when UTF-8
109 support is enabled.)."
110 (declare (type stream socket)
113 (enc-write-string string socket)
114 (write-uint1 socket 0))
116 (declaim (ftype (function (t unsigned-byte)
117 (simple-array (unsigned-byte 8) (*)))
119 (defun read-bytes (socket length)
120 "Read a byte array of the given length from a stream."
121 (declare (type stream socket)
124 (let ((result (make-array length :element-type '(unsigned-byte 8))))
125 (read-sequence result socket)
128 (declaim (ftype (function (t) string) read-str))
129 (defun read-str (socket)
130 "Read a null-terminated string from a stream. Takes care of encoding
131 when UTF-8 support is enabled."
132 (declare (type stream socket)
134 (enc-read-string socket :null-terminated t))
136 (defun skip-bytes (socket length)
137 "Skip a given number of bytes in a binary stream."
138 (declare (type stream socket)
139 (type (unsigned-byte 32) length)
144 (defun skip-str (socket)
145 "Skip a null-terminated string."
146 (declare (type stream socket)
148 (loop :for char :of-type fixnum = (read-byte socket)
149 :until (zerop char)))
151 (defun ensure-socket-is-closed (socket &key abort)
152 (when (open-stream-p socket)
154 (close socket :abort abort)
156 (warn "Ignoring the error which happened while trying to close PostgreSQL socket: ~A" error)))))
159 var editor = CodeMirror.fromTextArea(document.getElementById("code"), {lineNumbers: true});
162 <p><strong>MIME types defined:</strong> <code>text/x-common-lisp</code>.</p>