index.html 6.5 KB

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