Mercurial
diff .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 |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/.cms/lib/codemirror/mode/commonlisp/index.html Fri Oct 11 22:40:23 2024 +0000 @@ -0,0 +1,177 @@ +<!doctype html> + +<title>CodeMirror: Common Lisp mode</title> +<meta charset="utf-8"/> +<link rel=stylesheet href="../../doc/docs.css"> + +<link rel="stylesheet" href="../../lib/codemirror.css"> +<script src="../../lib/codemirror.js"></script> +<script src="commonlisp.js"></script> +<style>.CodeMirror {background: #f8f8f8;}</style> +<div id=nav> + <a href="https://codemirror.net/5"><h1>CodeMirror</h1><img id=logo src="../../doc/logo.png" alt=""></a> + + <ul> + <li><a href="../../index.html">Home</a> + <li><a href="../../doc/manual.html">Manual</a> + <li><a href="https://github.com/codemirror/codemirror5">Code</a> + </ul> + <ul> + <li><a href="../index.html">Language modes</a> + <li><a class=active href="#">Common Lisp</a> + </ul> +</div> + +<article> +<h2>Common Lisp mode</h2> +<form><textarea id="code" name="code">(in-package :cl-postgres) + +;; These are used to synthesize reader and writer names for integer +;; reading/writing functions when the amount of bytes and the +;; signedness is known. Both the macro that creates the functions and +;; some macros that use them create names this way. +(eval-when (:compile-toplevel :load-toplevel :execute) + (defun integer-reader-name (bytes signed) + (intern (with-standard-io-syntax + (format nil "~a~a~a~a" '#:read- (if signed "" '#:u) '#:int bytes)))) + (defun integer-writer-name (bytes signed) + (intern (with-standard-io-syntax + (format nil "~a~a~a~a" '#:write- (if signed "" '#:u) '#:int bytes))))) + +(defmacro integer-reader (bytes) + "Create a function to read integers from a binary stream." + (let ((bits (* bytes 8))) + (labels ((return-form (signed) + (if signed + `(if (logbitp ,(1- bits) result) + (dpb result (byte ,(1- bits) 0) -1) + result) + `result)) + (generate-reader (signed) + `(defun ,(integer-reader-name bytes signed) (socket) + (declare (type stream socket) + #.*optimize*) + ,(if (= bytes 1) + `(let ((result (the (unsigned-byte 8) (read-byte socket)))) + (declare (type (unsigned-byte 8) result)) + ,(return-form signed)) + `(let ((result 0)) + (declare (type (unsigned-byte ,bits) result)) + ,@(loop :for byte :from (1- bytes) :downto 0 + :collect `(setf (ldb (byte 8 ,(* 8 byte)) result) + (the (unsigned-byte 8) (read-byte socket)))) + ,(return-form signed)))))) + `(progn +;; This causes weird errors on SBCL in some circumstances. Disabled for now. +;; (declaim (inline ,(integer-reader-name bytes t) +;; ,(integer-reader-name bytes nil))) + (declaim (ftype (function (t) (signed-byte ,bits)) + ,(integer-reader-name bytes t))) + ,(generate-reader t) + (declaim (ftype (function (t) (unsigned-byte ,bits)) + ,(integer-reader-name bytes nil))) + ,(generate-reader nil))))) + +(defmacro integer-writer (bytes) + "Create a function to write integers to a binary stream." + (let ((bits (* 8 bytes))) + `(progn + (declaim (inline ,(integer-writer-name bytes t) + ,(integer-writer-name bytes nil))) + (defun ,(integer-writer-name bytes nil) (socket value) + (declare (type stream socket) + (type (unsigned-byte ,bits) value) + #.*optimize*) + ,@(if (= bytes 1) + `((write-byte value socket)) + (loop :for byte :from (1- bytes) :downto 0 + :collect `(write-byte (ldb (byte 8 ,(* byte 8)) value) + socket))) + (values)) + (defun ,(integer-writer-name bytes t) (socket value) + (declare (type stream socket) + (type (signed-byte ,bits) value) + #.*optimize*) + ,@(if (= bytes 1) + `((write-byte (ldb (byte 8 0) value) socket)) + (loop :for byte :from (1- bytes) :downto 0 + :collect `(write-byte (ldb (byte 8 ,(* byte 8)) value) + socket))) + (values))))) + +;; All the instances of the above that we need. + +(integer-reader 1) +(integer-reader 2) +(integer-reader 4) +(integer-reader 8) + +(integer-writer 1) +(integer-writer 2) +(integer-writer 4) + +(defun write-bytes (socket bytes) + "Write a byte-array to a stream." + (declare (type stream socket) + (type (simple-array (unsigned-byte 8)) bytes) + #.*optimize*) + (write-sequence bytes socket)) + +(defun write-str (socket string) + "Write a null-terminated string to a stream \(encoding it when UTF-8 +support is enabled.)." + (declare (type stream socket) + (type string string) + #.*optimize*) + (enc-write-string string socket) + (write-uint1 socket 0)) + +(declaim (ftype (function (t unsigned-byte) + (simple-array (unsigned-byte 8) (*))) + read-bytes)) +(defun read-bytes (socket length) + "Read a byte array of the given length from a stream." + (declare (type stream socket) + (type fixnum length) + #.*optimize*) + (let ((result (make-array length :element-type '(unsigned-byte 8)))) + (read-sequence result socket) + result)) + +(declaim (ftype (function (t) string) read-str)) +(defun read-str (socket) + "Read a null-terminated string from a stream. Takes care of encoding +when UTF-8 support is enabled." + (declare (type stream socket) + #.*optimize*) + (enc-read-string socket :null-terminated t)) + +(defun skip-bytes (socket length) + "Skip a given number of bytes in a binary stream." + (declare (type stream socket) + (type (unsigned-byte 32) length) + #.*optimize*) + (dotimes (i length) + (read-byte socket))) + +(defun skip-str (socket) + "Skip a null-terminated string." + (declare (type stream socket) + #.*optimize*) + (loop :for char :of-type fixnum = (read-byte socket) + :until (zerop char))) + +(defun ensure-socket-is-closed (socket &key abort) + (when (open-stream-p socket) + (handler-case + (close socket :abort abort) + (error (error) + (warn "Ignoring the error which happened while trying to close PostgreSQL socket: ~A" error))))) +</textarea></form> + <script> + var editor = CodeMirror.fromTextArea(document.getElementById("code"), {lineNumbers: true}); + </script> + + <p><strong>MIME types defined:</strong> <code>text/x-common-lisp</code>.</p> + + </article>