Mercurial
comparison .cms/lib/codemirror/mode/commonlisp/index.html @ 0:78edf6b517a0 draft
24.10
author | Coffee CMS <info@coffee-cms.ru> |
---|---|
date | Fri, 11 Oct 2024 22:40:23 +0000 |
parents | |
children |
comparison
equal
deleted
inserted
replaced
-1:000000000000 | 0:78edf6b517a0 |
---|---|
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> |