|
0
|
1 <!doctype html>
|
|
|
2
|
|
|
3 <title>CodeMirror: Common Lisp mode</title>
|
|
|
4 <meta charset="utf-8"/>
|
|
|
5 <link rel=stylesheet href="../../doc/docs.css">
|
|
|
6
|
|
|
7 <link rel="stylesheet" href="../../lib/codemirror.css">
|
|
|
8 <script src="../../lib/codemirror.js"></script>
|
|
|
9 <script src="commonlisp.js"></script>
|
|
|
10 <style>.CodeMirror {background: #f8f8f8;}</style>
|
|
|
11 <div id=nav>
|
|
|
12 <a href="https://codemirror.net/5"><h1>CodeMirror</h1><img id=logo src="../../doc/logo.png" alt=""></a>
|
|
|
13
|
|
|
14 <ul>
|
|
|
15 <li><a href="../../index.html">Home</a>
|
|
|
16 <li><a href="../../doc/manual.html">Manual</a>
|
|
|
17 <li><a href="https://github.com/codemirror/codemirror5">Code</a>
|
|
|
18 </ul>
|
|
|
19 <ul>
|
|
|
20 <li><a href="../index.html">Language modes</a>
|
|
|
21 <li><a class=active href="#">Common Lisp</a>
|
|
|
22 </ul>
|
|
|
23 </div>
|
|
|
24
|
|
|
25 <article>
|
|
|
26 <h2>Common Lisp mode</h2>
|
|
|
27 <form><textarea id="code" name="code">(in-package :cl-postgres)
|
|
|
28
|
|
|
29 ;; These are used to synthesize reader and writer names for integer
|
|
|
30 ;; reading/writing functions when the amount of bytes and the
|
|
|
31 ;; signedness is known. Both the macro that creates the functions and
|
|
|
32 ;; some macros that use them create names this way.
|
|
|
33 (eval-when (:compile-toplevel :load-toplevel :execute)
|
|
|
34 (defun integer-reader-name (bytes signed)
|
|
|
35 (intern (with-standard-io-syntax
|
|
|
36 (format nil "~a~a~a~a" '#:read- (if signed "" '#:u) '#:int bytes))))
|
|
|
37 (defun integer-writer-name (bytes signed)
|
|
|
38 (intern (with-standard-io-syntax
|
|
|
39 (format nil "~a~a~a~a" '#:write- (if signed "" '#:u) '#:int bytes)))))
|
|
|
40
|
|
|
41 (defmacro integer-reader (bytes)
|
|
|
42 "Create a function to read integers from a binary stream."
|
|
|
43 (let ((bits (* bytes 8)))
|
|
|
44 (labels ((return-form (signed)
|
|
|
45 (if signed
|
|
|
46 `(if (logbitp ,(1- bits) result)
|
|
|
47 (dpb result (byte ,(1- bits) 0) -1)
|
|
|
48 result)
|
|
|
49 `result))
|
|
|
50 (generate-reader (signed)
|
|
|
51 `(defun ,(integer-reader-name bytes signed) (socket)
|
|
|
52 (declare (type stream socket)
|
|
|
53 #.*optimize*)
|
|
|
54 ,(if (= bytes 1)
|
|
|
55 `(let ((result (the (unsigned-byte 8) (read-byte socket))))
|
|
|
56 (declare (type (unsigned-byte 8) result))
|
|
|
57 ,(return-form signed))
|
|
|
58 `(let ((result 0))
|
|
|
59 (declare (type (unsigned-byte ,bits) result))
|
|
|
60 ,@(loop :for byte :from (1- bytes) :downto 0
|
|
|
61 :collect `(setf (ldb (byte 8 ,(* 8 byte)) result)
|
|
|
62 (the (unsigned-byte 8) (read-byte socket))))
|
|
|
63 ,(return-form signed))))))
|
|
|
64 `(progn
|
|
|
65 ;; This causes weird errors on SBCL in some circumstances. Disabled for now.
|
|
|
66 ;; (declaim (inline ,(integer-reader-name bytes t)
|
|
|
67 ;; ,(integer-reader-name bytes nil)))
|
|
|
68 (declaim (ftype (function (t) (signed-byte ,bits))
|
|
|
69 ,(integer-reader-name bytes t)))
|
|
|
70 ,(generate-reader t)
|
|
|
71 (declaim (ftype (function (t) (unsigned-byte ,bits))
|
|
|
72 ,(integer-reader-name bytes nil)))
|
|
|
73 ,(generate-reader nil)))))
|
|
|
74
|
|
|
75 (defmacro integer-writer (bytes)
|
|
|
76 "Create a function to write integers to a binary stream."
|
|
|
77 (let ((bits (* 8 bytes)))
|
|
|
78 `(progn
|
|
|
79 (declaim (inline ,(integer-writer-name bytes t)
|
|
|
80 ,(integer-writer-name bytes nil)))
|
|
|
81 (defun ,(integer-writer-name bytes nil) (socket value)
|
|
|
82 (declare (type stream socket)
|
|
|
83 (type (unsigned-byte ,bits) value)
|
|
|
84 #.*optimize*)
|
|
|
85 ,@(if (= bytes 1)
|
|
|
86 `((write-byte value socket))
|
|
|
87 (loop :for byte :from (1- bytes) :downto 0
|
|
|
88 :collect `(write-byte (ldb (byte 8 ,(* byte 8)) value)
|
|
|
89 socket)))
|
|
|
90 (values))
|
|
|
91 (defun ,(integer-writer-name bytes t) (socket value)
|
|
|
92 (declare (type stream socket)
|
|
|
93 (type (signed-byte ,bits) value)
|
|
|
94 #.*optimize*)
|
|
|
95 ,@(if (= bytes 1)
|
|
|
96 `((write-byte (ldb (byte 8 0) value) socket))
|
|
|
97 (loop :for byte :from (1- bytes) :downto 0
|
|
|
98 :collect `(write-byte (ldb (byte 8 ,(* byte 8)) value)
|
|
|
99 socket)))
|
|
|
100 (values)))))
|
|
|
101
|
|
|
102 ;; All the instances of the above that we need.
|
|
|
103
|
|
|
104 (integer-reader 1)
|
|
|
105 (integer-reader 2)
|
|
|
106 (integer-reader 4)
|
|
|
107 (integer-reader 8)
|
|
|
108
|
|
|
109 (integer-writer 1)
|
|
|
110 (integer-writer 2)
|
|
|
111 (integer-writer 4)
|
|
|
112
|
|
|
113 (defun write-bytes (socket bytes)
|
|
|
114 "Write a byte-array to a stream."
|
|
|
115 (declare (type stream socket)
|
|
|
116 (type (simple-array (unsigned-byte 8)) bytes)
|
|
|
117 #.*optimize*)
|
|
|
118 (write-sequence bytes socket))
|
|
|
119
|
|
|
120 (defun write-str (socket string)
|
|
|
121 "Write a null-terminated string to a stream \(encoding it when UTF-8
|
|
|
122 support is enabled.)."
|
|
|
123 (declare (type stream socket)
|
|
|
124 (type string string)
|
|
|
125 #.*optimize*)
|
|
|
126 (enc-write-string string socket)
|
|
|
127 (write-uint1 socket 0))
|
|
|
128
|
|
|
129 (declaim (ftype (function (t unsigned-byte)
|
|
|
130 (simple-array (unsigned-byte 8) (*)))
|
|
|
131 read-bytes))
|
|
|
132 (defun read-bytes (socket length)
|
|
|
133 "Read a byte array of the given length from a stream."
|
|
|
134 (declare (type stream socket)
|
|
|
135 (type fixnum length)
|
|
|
136 #.*optimize*)
|
|
|
137 (let ((result (make-array length :element-type '(unsigned-byte 8))))
|
|
|
138 (read-sequence result socket)
|
|
|
139 result))
|
|
|
140
|
|
|
141 (declaim (ftype (function (t) string) read-str))
|
|
|
142 (defun read-str (socket)
|
|
|
143 "Read a null-terminated string from a stream. Takes care of encoding
|
|
|
144 when UTF-8 support is enabled."
|
|
|
145 (declare (type stream socket)
|
|
|
146 #.*optimize*)
|
|
|
147 (enc-read-string socket :null-terminated t))
|
|
|
148
|
|
|
149 (defun skip-bytes (socket length)
|
|
|
150 "Skip a given number of bytes in a binary stream."
|
|
|
151 (declare (type stream socket)
|
|
|
152 (type (unsigned-byte 32) length)
|
|
|
153 #.*optimize*)
|
|
|
154 (dotimes (i length)
|
|
|
155 (read-byte socket)))
|
|
|
156
|
|
|
157 (defun skip-str (socket)
|
|
|
158 "Skip a null-terminated string."
|
|
|
159 (declare (type stream socket)
|
|
|
160 #.*optimize*)
|
|
|
161 (loop :for char :of-type fixnum = (read-byte socket)
|
|
|
162 :until (zerop char)))
|
|
|
163
|
|
|
164 (defun ensure-socket-is-closed (socket &key abort)
|
|
|
165 (when (open-stream-p socket)
|
|
|
166 (handler-case
|
|
|
167 (close socket :abort abort)
|
|
|
168 (error (error)
|
|
|
169 (warn "Ignoring the error which happened while trying to close PostgreSQL socket: ~A" error)))))
|
|
|
170 </textarea></form>
|
|
|
171 <script>
|
|
|
172 var editor = CodeMirror.fromTextArea(document.getElementById("code"), {lineNumbers: true});
|
|
|
173 </script>
|
|
|
174
|
|
|
175 <p><strong>MIME types defined:</strong> <code>text/x-common-lisp</code>.</p>
|
|
|
176
|
|
|
177 </article>
|
