to-be-integrated/third-party/codemirror-3.15/mode/commonlisp/index.html

   1 <!doctype html>
   2 <html>
   3   <head>
   4     <meta charset="utf-8">
   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">
  11   </head>
  12   <body>
  13     <h1>CodeMirror: Common Lisp mode</h1>
  14     <form><textarea id="code" name="code">(in-package :cl-postgres)
  15
  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)))))
  27
  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)
  32                (if signed
  33                    `(if (logbitp ,(1- bits) result)
  34                         (dpb result (byte ,(1- bits) 0) -1)
  35                         result)
  36                    `result))
  37              (generate-reader (signed)
  38                `(defun ,(integer-reader-name bytes signed) (socket)
  39                   (declare (type stream socket)
  40                            #.*optimize*)
  41                   ,(if (= bytes 1)
  42                        `(let ((result (the (unsigned-byte 8) (read-byte socket))))
  43                           (declare (type (unsigned-byte 8) result))
  44                           ,(return-form signed))
  45                        `(let ((result 0))
  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))))))
  51       `(progn
  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)))
  57          ,(generate-reader t)
  58          (declaim (ftype (function (t) (unsigned-byte ,bits))
  59                          ,(integer-reader-name bytes nil)))
  60          ,(generate-reader nil)))))
  61
  62 (defmacro integer-writer (bytes)
  63   "Create a function to write integers to a binary stream."
  64   (let ((bits (* 8 bytes)))
  65     `(progn
  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)
  71                  #.*optimize*)
  72         ,@(if (= bytes 1)
  73               `((write-byte value socket))
  74               (loop :for byte :from (1- bytes) :downto 0
  75                     :collect `(write-byte (ldb (byte 8 ,(* byte 8)) value)
  76                                socket)))
  77         (values))
  78       (defun ,(integer-writer-name bytes t) (socket value)
  79         (declare (type stream socket)
  80                  (type (signed-byte ,bits) value)
  81                  #.*optimize*)
  82         ,@(if (= bytes 1)
  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)
  86                                socket)))
  87         (values)))))
  88
  89 ;; All the instances of the above that we need.
  90
  91 (integer-reader 1)
  92 (integer-reader 2)
  93 (integer-reader 4)
  94 (integer-reader 8)
  95
  96 (integer-writer 1)
  97 (integer-writer 2)
  98 (integer-writer 4)
  99
 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)
 104            #.*optimize*)
 105   (write-sequence bytes socket))
 106
 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)
 111            (type string string)
 112            #.*optimize*)
 113   (enc-write-string string socket)
 114   (write-uint1 socket 0))
 115
 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
 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)
 133            #.*optimize*)
 134   (enc-read-string socket :null-terminated t))
 135
 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)
 140            #.*optimize*)
 141   (dotimes (i length)
 142     (read-byte socket)))
 143
 144 (defun skip-str (socket)
 145   "Skip a null-terminated string."
 146   (declare (type stream socket)
 147            #.*optimize*)
 148   (loop :for char :of-type fixnum = (read-byte socket)
 149         :until (zerop char)))
 150
 151 (defun ensure-socket-is-closed (socket &amp;key abort)
 152   (when (open-stream-p socket)
 153     (handler-case
 154         (close socket :abort abort)
 155       (error (error)
 156         (warn "Ignoring the error which happened while trying to close PostgreSQL socket: ~A" error)))))
 157 </textarea></form>
 158     <script>
 159       var editor = CodeMirror.fromTextArea(document.getElementById("code"), {lineNumbers: true});
 160     </script>
 161
 162     <p><strong>MIME types defined:</strong> <code>text/x-common-lisp</code>.</p>
 163
 164   </body>
 165 </html>