File modules/editor/codemirror/mode/commonlisp/index.html

Last commit: Sun Dec 17 01:14:09 2017 +0100	Jan Dankert	Integration eines weiteren Code-Editors: Codemirror. Demnächst müssen wir hier mal aufräumen und andere Editoren rauswerfen.


     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="http://codemirror.net"><h1>CodeMirror</h1><img id=logo src="../../doc/logo.png"></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/codemirror">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 &amp;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>



Download modules/editor/codemirror/mode/commonlisp/index.html


History
Sun, 17 Dec 2017 01:14:09 +0100	Jan Dankert	Integration eines weiteren Code-Editors: Codemirror. Demnächst müssen wir hier mal aufräumen und andere Editoren rauswerfen.