├── .gitignore ├── .travis.yml ├── README.md ├── src └── swank-protocol.lisp ├── swank-protocol-test.asd ├── swank-protocol.asd └── t └── swank-protocol.lisp /.gitignore: -------------------------------------------------------------------------------- 1 | *.fasl 2 | *.dx32fsl 3 | *.dx64fsl 4 | *.lx32fsl 5 | *.lx64fsl 6 | *.x86f 7 | *~ 8 | .#* -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: common-lisp 2 | sudo: required 3 | 4 | env: 5 | matrix: 6 | - LISP=sbcl COVERALLS=true 7 | 8 | install: 9 | # Install cl-travis 10 | - curl https://raw.githubusercontent.com/luismbo/cl-travis/master/install.sh | bash 11 | # coveralls.io 12 | - git clone https://github.com/fukamachi/cl-coveralls ~/lisp/cl-coveralls 13 | 14 | script: 15 | - cl -l fiveam -l cl-coveralls 16 | -e '(setf fiveam:*debug-on-error* t)' 17 | -e '(setf *debugger-hook* 18 | (lambda (c h) 19 | (declare (ignore c h)) 20 | (uiop:quit -1)))' 21 | -e '(coveralls:with-coveralls (:exclude (list "t")) 22 | (ql:quickload :swank-protocol-test))' 23 | 24 | notifications: 25 | email: 26 | - eudoxiahp@gmail.com 27 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # swank-protocol 2 | 3 | [![Build Status](https://travis-ci.org/eudoxia0/swank-protocol.svg?branch=master)](https://travis-ci.org/eudoxia0/swank-protocol) 4 | [![Coverage Status](https://coveralls.io/repos/eudoxia0/swank-protocol/badge.svg?branch=master)](https://coveralls.io/r/eudoxia0/swank-protocol?branch=master) 5 | [![Quicklisp](http://quickdocs.org/badge/swank-protocol.svg)](http://quickdocs.org/swank-protocol/) 6 | 7 | A low-level client for the [Swank][swank] server of [SLIME][slime]. 8 | 9 | # Overview 10 | 11 | swank-protocol is a small, low-level client for Swank. It handles connections 12 | and reading/writing messages. 13 | 14 | This is not a full client for Swank, it's a permissively-licensed library for 15 | building Swank clients. It doesn't match requests to responses, it doesn't 16 | asynchronously read responses and events from Swank. It just takes care of the 17 | low level details: Connecting, sending messages down the socket, reading and 18 | parsing incoming events and responses, and optionally logging. 19 | 20 | # Usage 21 | 22 | First, load everything: 23 | 24 | ``` 25 | (ql:quickload :swank-protocol) 26 | ``` 27 | 28 | Run this to start a Swank server on `localhost:5000`: 29 | 30 | ```lisp 31 | (setf swank:*configure-emacs-indentation* nil) 32 | 33 | (let ((swank::*loopback-interface* (uiop:hostname))) 34 | (swank:create-server :port 5000 :dont-close t)) 35 | ``` 36 | 37 | Now we connect: 38 | 39 | ``` 40 | (defparameter connection 41 | (swank-protocol:make-connection (uiop:hostname) 42 | 5000)) 43 | 44 | (swank-protocol:connect connection) 45 | ``` 46 | 47 | Now we can start sending requests: 48 | 49 | ```lisp 50 | (swank-protocol:request-connection-info connection) 51 | ``` 52 | 53 | And reading responses: 54 | 55 | ```lisp 56 | (swank-protocol:read-message connection) 57 | ``` 58 | 59 | For instance, let's create a REPL. First, we require some modules: 60 | 61 | ```lisp 62 | (swank-protocol:request-swank-require connection 63 | '(swank-presentations swank-repl)) 64 | (swank-protocol:request-init-presentations connection) 65 | ``` 66 | 67 | (Don't worry about the symbols' package) 68 | 69 | Now we actually create it: 70 | 71 | ```lisp 72 | (swank-protocol:request-create-repl connection) 73 | ``` 74 | 75 | Now we can send things for evaluation: 76 | 77 | ```lisp 78 | (swank-protocol:request-listener-eval connection "(+ 2 2)") 79 | ``` 80 | 81 | And receive the results: 82 | 83 | ```lisp 84 | (swank-protocol:read-all-messages connection) 85 | ``` 86 | 87 | # API 88 | 89 | ## `connection` 90 | 91 | The `connection` class has the following readers: 92 | 93 | * `connection-hostname`: The Swank server's hostname. 94 | * `connection-port`: The Swank server's port. 95 | 96 | And the following accessors: 97 | 98 | * `connection-request-count`: The integer ID of the last request sent to the 99 | Swank server. Starts at zero. 100 | * `connection-package`: The package where things are evaluated. This should be 101 | changed when you send a request to Swank to change the current package. 102 | * `connection-thread`: This is the keyword ID of the thread to execute things 103 | in. `t` is used by default to tell Swank to pick the default thread. 104 | * `connection-log-p`: Whether to log messages as they are read/written. 105 | * `connection-logging-stream`: The stream to log things to, by default, 106 | `*error-output*`. 107 | 108 | Instances of `connection` can be created with `make-connection`: 109 | 110 | ```lisp 111 | ;; A regular connection 112 | (make-connection "my-hostname" "1234") 113 | 114 | ;; A connection with logging 115 | (make-connection "my-test-server" "1234" :logp t) 116 | ``` 117 | 118 | The `connect` function connects to the Swank server and returns t. 119 | 120 | ## Input/Output 121 | 122 | After connecting, you can do two things: Send messages or read them. 123 | 124 | To write messages, you can use `emacs-rex`, which takes a connection and an 125 | S-expression to send to Swank. Implicit in this request, and stored in the 126 | `connection` object, are two bits of information: The current package and the 127 | request ID. 128 | 129 | To read messages, you use `read-message`, which takes a connection and reads the 130 | next message coming from Swank. The result is an S-expression. 131 | 132 | ## High-level Functions 133 | 134 | There are higher-level convenience functions that call `emacs-rex`, to minimize 135 | repetition and error: 136 | 137 | ### `connection-info` 138 | 139 | Requests connection information. The matching response is a plist with 140 | connection information. 141 | 142 | Example response: 143 | 144 | ```lisp 145 | (:return 146 | (:ok 147 | (:pid 1234 148 | :style :spawn 149 | :encoding (:coding-systems ("utf-8-unix" "iso-latin-1-unix")) 150 | :lisp-implementation (:type "SBCL" :name "sbcl" :version "1.2.9" :program "/usr/local/bin/sbcl") 151 | :machine (:instance "laptop" :type "X86-64" :version "Intel(R) Core(TM) i5-2410M CPU @ 2.30GHz") 152 | :features (:bordeaux-threads ... :x86-64) 153 | :modules ("SWANK-REPL" ... "uiop") 154 | :package (:name "COMMON-LISP-USER" :prompt "CL-USER") 155 | :version "2014-12-23")) 156 | 1) 157 | ``` 158 | 159 | # See Also 160 | 161 | * [swank-client][s-c]: A more complete client, but GPL-licensed. 162 | * [Swank protocol description][description] 163 | 164 | [slime]: https://common-lisp.net/project/slime/ 165 | [swank]: https://github.com/slime/slime/tree/master/swank 166 | [s-c]: https://github.com/brown/swank-client 167 | [description]: https://github.com/astine/swank-client/blob/master/swank-description.markdown 168 | 169 | # License 170 | 171 | Copyright (c) 2015 Fernando Borretti 172 | 173 | Licensed under the MIT License. 174 | -------------------------------------------------------------------------------- /src/swank-protocol.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (defpackage swank-protocol 3 | (:use :cl) 4 | (:export :connection 5 | :make-connection 6 | :connection-hostname 7 | :connection-port 8 | :connection-request-count 9 | :connection-package 10 | :connection-thread 11 | :connection-log-p 12 | :connection-logging-stream) 13 | (:export :connect 14 | :read-message-string 15 | :send-message-string 16 | :message-waiting-p 17 | :emacs-rex 18 | :request-connection-info 19 | :request-swank-require 20 | :request-init-presentations 21 | :request-create-repl 22 | :request-listener-eval 23 | :request-invoke-restart 24 | :request-throw-to-toplevel 25 | :request-input-string 26 | :request-input-string-newline 27 | :read-message 28 | :read-all-messages) 29 | (:documentation "Low-level implementation of a client for the Swank protocol.")) 30 | (in-package :swank-protocol) 31 | 32 | ;;; Prevent reader errors 33 | 34 | (eval-when (:compile-toplevel :load-toplevel) 35 | (swank:swank-require '(swank-presentations swank-repl))) 36 | 37 | ;;; Encoding and decoding messages 38 | 39 | (defun encode-integer (integer) 40 | "Encode an integer to a 0-padded 16-bit hexadecimal string." 41 | (format nil "~6,'0,X" integer)) 42 | 43 | (defun decode-integer (string) 44 | "Decode a string representing a 0-padded 16-bit hex string to an integer." 45 | (parse-integer string :radix 16)) 46 | 47 | ;;; Converting messages between string and octet-vector by UTF-8 encoding 48 | 49 | (defun string-to-octets (string) 50 | #+sbcl (sb-ext:string-to-octets string :external-format :utf-8) 51 | #+allegro (excl:string-to-octets string :external-format :utf8) 52 | #+ccl (ccl:encode-string-to-octets string :external-format :utf-8) 53 | #+clisp (ext:convert-string-to-bytes string charset:utf-8) 54 | #-(or sbcl allegro ccl clisp) 55 | (babel:string-to-octets string :encoding :utf-8)) 56 | 57 | (defun octets-to-string (octets) 58 | #+sbcl (sb-ext:octets-to-string octets :external-format :utf-8) 59 | #+allegro (excl:octets-to-string octets :external-format :utf8) 60 | #+ccl (ccl:decode-string-from-octets octets :external-format :utf-8) 61 | #+clisp (ext:convert-string-from-bytes octets charset:utf-8) 62 | #-(or sbcl allegro ccl clisp) 63 | (babel:octets-to-string octets :encoding :utf-8)) 64 | 65 | ;; Writing and reading messages to/from streams 66 | 67 | (defun write-message-to-stream (stream message) 68 | "Write a string to a stream, prefixing it with length information for Swank." 69 | (let* ((message-octets (string-to-octets message)) 70 | (length-octets (string-to-octets (encode-integer (1+ (length message-octets))))) 71 | (payload (make-array (+ 6 (length message-octets) 1) 72 | :element-type '(unsigned-byte 8)))) 73 | (replace payload length-octets) 74 | (replace payload message-octets :start1 6) 75 | (setf (aref payload (1- (length payload))) (char-code #\Newline)) 76 | (write-sequence payload stream))) 77 | 78 | (defun read-message-from-stream (stream) 79 | "Read a string from a string. 80 | 81 | Parses length information to determine how many characters to read." 82 | (let ((length-buffer (make-array 6 :element-type '(unsigned-byte 8)))) 83 | (read-sequence length-buffer stream) 84 | (let* ((length (decode-integer (octets-to-string length-buffer))) 85 | (buffer (make-array length :element-type '(unsigned-byte 8)))) 86 | (read-sequence buffer stream) 87 | (octets-to-string buffer)))) 88 | 89 | ;;; Data 90 | 91 | (defclass connection () 92 | ((hostname :reader connection-hostname 93 | :initarg :hostname 94 | :type string 95 | :documentation "The host to connect to.") 96 | (port :reader connection-port 97 | :initarg :port 98 | :type integer 99 | :documentation "The port to connect to.") 100 | ;; Internal 101 | (socket :accessor connection-socket 102 | :type usocket:stream-usocket 103 | :documentation "The usocket socket.") 104 | (request-count :accessor connection-request-count 105 | :initform 0 106 | :type integer 107 | :documentation "A number that is increased and sent along with every request.") 108 | (read-count :accessor connection-read-count 109 | :initform 0 110 | :type integer 111 | :documentation "Counter of the number of times read is called in the server's REPL.") 112 | (package :accessor connection-package 113 | :initform "COMMON-LISP-USER" 114 | :type string 115 | :documentation "The name of the connection's package.") 116 | (thread :accessor connection-thread 117 | :initform t 118 | :documentation "The current thread.") 119 | ;; Logging 120 | (logp :accessor connection-log-p 121 | :initarg :logp 122 | :initform nil 123 | :type boolean 124 | :documentation "Whether or not to log connection requests.") 125 | (logging-stream :accessor connection-logging-stream 126 | :initarg :logging-stream 127 | :initform *error-output* 128 | :type stream 129 | :documentation "The stream to log to.")) 130 | (:documentation "A connection to a remote Lisp.")) 131 | 132 | (defun make-connection (hostname port &key (logp nil)) 133 | "Create a connection to a remote Swank server." 134 | (make-instance 'connection 135 | :hostname hostname 136 | :port port 137 | :logp logp)) 138 | 139 | (defmethod connect ((connection connection)) 140 | "Connect to the remote server. Returns t." 141 | (with-slots (hostname port) connection 142 | (let ((socket (usocket:socket-connect hostname 143 | port 144 | :element-type '(unsigned-byte 8)))) 145 | (setf (connection-socket connection) socket))) 146 | t) 147 | 148 | (defun log-message (connection format-string &rest arguments) 149 | "Log a message." 150 | (when (connection-log-p connection) 151 | (apply #'format (cons (connection-logging-stream connection) 152 | (cons format-string 153 | arguments))))) 154 | 155 | (defun read-message-string (connection) 156 | "Read a message string from a Swank connection. 157 | 158 | This function will block until it reads everything. Consider message-waiting-p 159 | to check if input is available." 160 | (with-slots (socket) connection 161 | (let ((stream (usocket:socket-stream socket))) 162 | (when (usocket:wait-for-input socket :timeout 5) 163 | (let ((msg (read-message-from-stream stream))) 164 | (log-message connection "~%Read: ~A~%" msg) 165 | msg))))) 166 | 167 | (defun send-message-string (connection message) 168 | "Send a message string to a Swank connection." 169 | (with-slots (socket) connection 170 | (let ((stream (usocket:socket-stream socket))) 171 | (write-message-to-stream stream message) 172 | (force-output stream) 173 | (log-message connection "~%Sent: ~A~%" message) 174 | message))) 175 | 176 | (defun message-waiting-p (connection) 177 | "t if there's a message in the connection waiting to be read, nil otherwise." 178 | (if (usocket:wait-for-input (connection-socket connection) 179 | :ready-only t 180 | :timeout 0) 181 | t 182 | nil)) 183 | 184 | ;;; Sending messages 185 | 186 | (defmacro with-swank-syntax (() &body body) 187 | `(with-standard-io-syntax 188 | (let ((*package* (find-package :swank-io-package)) 189 | (*print-case* :downcase) 190 | (*print-readably* nil)) 191 | ,@body))) 192 | 193 | (defun emacs-rex (connection form) 194 | "(R)emote (E)xecute S-e(X)p. 195 | 196 | Send an S-expression command to Swank to evaluate. The resulting response must 197 | be read with read-response." 198 | (with-slots (package thread) connection 199 | (let ((msg (concatenate 'string 200 | "(:emacs-rex " 201 | (with-swank-syntax () 202 | (prin1-to-string form)) 203 | " " 204 | (prin1-to-string package) 205 | " " 206 | (if (eq (first form) 207 | 'swank-repl:listener-eval) 208 | ":repl-thread" 209 | (prin1-to-string thread)) 210 | " " 211 | (write-to-string 212 | (incf (connection-request-count connection))) 213 | ")"))) 214 | (send-message-string connection msg)))) 215 | 216 | (defun request-connection-info (connection) 217 | "Request that Swank provide connection information." 218 | (emacs-rex connection `(swank:connection-info))) 219 | 220 | (defun request-swank-require (connection requirements) 221 | "Request that the Swank server load contrib modules. `requirements` must be a list of symbols, e.g. '(swank-repl swank-media)." 222 | (emacs-rex connection 223 | `(swank:swank-require ',(loop for item in requirements collecting 224 | (intern (symbol-name item) 225 | (find-package :swank-io-package)))))) 226 | 227 | (defun request-init-presentations (connection) 228 | "Request that Swank initiate presentations." 229 | (emacs-rex connection `(swank:init-presentations))) 230 | 231 | (defun request-create-repl (connection) 232 | "Request that Swank create a new REPL." 233 | (prog1 234 | (emacs-rex connection `(swank-repl:create-repl nil :coding-system "utf-8-unix")) 235 | (setf (connection-thread connection) 1))) 236 | 237 | (defun request-listener-eval (connection string) 238 | "Request that Swank evaluate a string of code in the REPL." 239 | (emacs-rex connection `(swank-repl:listener-eval ,string))) 240 | 241 | (defun request-invoke-restart (connection debug-level restart-number) 242 | "Invoke a restart." 243 | (emacs-rex connection `(swank:invoke-nth-restart-for-emacs ,debug-level 244 | ,restart-number))) 245 | 246 | (defun request-throw-to-toplevel (connection) 247 | "Leave the debugger." 248 | (emacs-rex connection `(swank:throw-to-toplevel))) 249 | 250 | (defun request-input-string (connection string) 251 | "Send a string to the server's standard input." 252 | (with-slots (package thread) connection 253 | (let ((msg (concatenate 'string 254 | "(:emacs-return-string " 255 | (prin1-to-string 256 | (connection-thread connection)) 257 | " " 258 | (prin1-to-string 259 | (incf (connection-read-count connection))) 260 | " " 261 | (prin1-to-string string) 262 | ")"))) 263 | (send-message-string connection msg)))) 264 | 265 | (defun request-input-string-newline (connection string) 266 | "Send a string to the server's standard input with a newline at the end." 267 | (request-input-string connection 268 | (concatenate 'string 269 | string 270 | (string #\Newline)))) 271 | 272 | ;;; Reading/parsing messages 273 | 274 | (defun read-message (connection) 275 | "Read an arbitrary message from a connection." 276 | (with-swank-syntax () 277 | (read-from-string (read-message-string connection)))) 278 | 279 | (defun read-all-messages (connection) 280 | (loop while (message-waiting-p connection) collecting 281 | (read-message connection))) 282 | -------------------------------------------------------------------------------- /swank-protocol-test.asd: -------------------------------------------------------------------------------- 1 | (defsystem swank-protocol-test 2 | :author "Fernando Borretti " 3 | :license "MIT" 4 | :depends-on (:swank-protocol 5 | :fiveam 6 | :external-program 7 | :alexandria) 8 | :components ((:module "t" 9 | :serial t 10 | :components 11 | ((:file "swank-protocol"))))) 12 | -------------------------------------------------------------------------------- /swank-protocol.asd: -------------------------------------------------------------------------------- 1 | (defsystem swank-protocol 2 | :author "Fernando Borretti " 3 | :maintainer "Fernando Borretti " 4 | :license "MIT" 5 | :version "0.1" 6 | :homepage "https://github.com/eudoxia0/swank-protocol" 7 | :bug-tracker "https://github.com/eudoxia0/swank-protocol/issues" 8 | :source-control (:git "git@github.com:eudoxia0/swank-protocol.git") 9 | :depends-on (:usocket 10 | :swank 11 | (:feature (:not (:or :sbcl :allegro :ccl :clisp)) :babel)) 12 | :components ((:module "src" 13 | :serial t 14 | :components 15 | ((:file "swank-protocol")))) 16 | :description "A low-level Swank client." 17 | :long-description 18 | #.(uiop:read-file-string 19 | (uiop:subpathname *load-pathname* "README.md")) 20 | :in-order-to ((test-op (test-op swank-protocol-test)))) 21 | -------------------------------------------------------------------------------- /t/swank-protocol.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (defpackage swank-protocol-test 3 | (:use :cl :fiveam)) 4 | (in-package :swank-protocol-test) 5 | 6 | ;;; Utilities 7 | 8 | (defparameter *hostname* "0.0.0.0") 9 | 10 | (defparameter *impl* 11 | (if (uiop:getenv "TRAVIS") 12 | "cl" 13 | "sbcl")) 14 | 15 | (defun read-all-from-stream (stream) 16 | "Read characters from a stream into a string until EOF." 17 | (concatenate 'string 18 | (loop for byte = (read-char-no-hang stream nil nil) 19 | while byte collecting byte))) 20 | 21 | (defmacro with-swank-lisp ((port) &body body) 22 | (alexandria:with-gensyms (code process) 23 | `(let* ((,code (list "(asdf:load-system :swank)" 24 | "(setf swank:*configure-emacs-indentation* nil)" 25 | (format nil 26 | "(let ((swank::*loopback-interface* ~S)) 27 | (swank:create-server :port ~D :dont-close t))" 28 | *hostname* 29 | ,port) 30 | "(print 'done)")) 31 | (,process (external-program:start "sbcl" (list "--noinform") 32 | :input :stream 33 | :output :stream))) 34 | ;; Send input 35 | (let ((stream (external-program:process-input-stream ,process))) 36 | (loop for form in ,code do 37 | (write-string form stream) 38 | (write-char #\Newline stream) 39 | (finish-output stream))) 40 | ;; Wait until done 41 | (flet ((process-stdout () 42 | (read-all-from-stream 43 | (external-program:process-output-stream ,process)))) 44 | (let ((output (process-stdout))) 45 | (loop until (search "DONE" output) do 46 | (let ((new-output (process-stdout))) 47 | (setf output (concatenate 'string output new-output)))))) 48 | (when (uiop:getenv "TRAVIS") 49 | (sleep 5)) 50 | ;; Run the code 51 | (unwind-protect 52 | (progn 53 | ,@body) 54 | (external-program:signal-process ,process :killed))))) 55 | 56 | (defparameter *port* 40000) 57 | 58 | (defmacro with-connection ((conn) &body body) 59 | (let ((port (gensym))) 60 | `(let ((,port (incf *port*))) 61 | (with-swank-lisp (,port) 62 | (let ((,conn (swank-protocol:make-connection *hostname* 63 | ,port 64 | :logp t))) 65 | (is-true 66 | (swank-protocol:connect ,conn)) 67 | ,@body))))) 68 | 69 | (defmacro with-response ((conn name request) &body body) 70 | (let ((response-string (gensym))) 71 | `(progn 72 | (is 73 | (stringp ,request)) 74 | (let* ((,response-string (swank-protocol:read-message ,conn)) 75 | (,name (parse-response ,response-string))) 76 | ,@body)))) 77 | 78 | (defmacro with-repl ((conn) &body body) 79 | `(progn 80 | ;; Require everything 81 | (with-response (conn resp (swank-protocol:request-swank-require 82 | conn 83 | '(swank-presentations swank-repl))) 84 | ;; Read all messages 85 | (sleep 0.1) 86 | (let ((messages (swank-protocol:read-all-messages conn))) 87 | t)) 88 | ;; Create REPL 89 | (with-response (,conn resp (swank-protocol:request-init-presentations ,conn)) 90 | (is 91 | (equal (getf resp :request-id) 2))) 92 | (with-response (,conn resp (swank-protocol:request-create-repl ,conn)) 93 | (is 94 | (equal (getf resp :request-id) 3))) 95 | ,@body)) 96 | 97 | (defun parse-response (response) 98 | "Parse a response from read-event into a more manageable format." 99 | (list :status (first (second response)) 100 | :value (second (second response)) 101 | :request-id (first (last response)))) 102 | 103 | (defun parse-debug (message) 104 | "Parse a debug message into something more manageable." 105 | (destructuring-bind (thread level condition restarts stack conts) 106 | (rest message) 107 | (declare (ignore conts)) 108 | (list :thread thread 109 | :level level 110 | :condition (remove-if #'null condition) 111 | :restarts (loop for restart in restarts collecting 112 | (list :id (first restart) 113 | :text (second restart))) 114 | :stack (loop for frame in stack collecting 115 | (list :id (first frame) 116 | :text (second frame)))))) 117 | 118 | ;;; Tests 119 | 120 | (def-suite tests 121 | :description "swank-protocol tests.") 122 | (in-suite tests) 123 | 124 | (test encoding/decoding 125 | (is 126 | (equal (swank-protocol::encode-integer 1) 127 | "000001")) 128 | (is 129 | (equal (swank-protocol::decode-integer "000001") 130 | 1)) 131 | (loop for num in (list 1 10 100 1000 2000 1000000) do 132 | (is 133 | (equal (swank-protocol::decode-integer (swank-protocol::encode-integer num)) 134 | num)))) 135 | 136 | (test (connect :depends-on encoding/decoding) 137 | (with-connection (conn) 138 | ;; Do nothing 139 | t)) 140 | 141 | (test (basic-requests :depends-on connect) 142 | (with-connection (conn) 143 | (is-false 144 | (swank-protocol:message-waiting-p conn)) 145 | (is-true 146 | (stringp 147 | (swank-protocol:send-message-string 148 | conn 149 | "(:emacs-rex (swank:connection-info) \"COMMON-LISP-USER\" t 1)"))) 150 | (is-true 151 | (progn 152 | (sleep 0.1) ;; Ensure the reply has been sent 153 | (swank-protocol:message-waiting-p conn))) 154 | (let ((resp (swank-protocol:read-message-string conn))) 155 | (is 156 | (stringp resp)) 157 | (is-false 158 | (swank-protocol:message-waiting-p conn))))) 159 | 160 | (test (connection-info :depends-on basic-requests) 161 | (with-connection (conn) 162 | (with-response (conn resp (swank-protocol:request-connection-info conn)) 163 | (is 164 | (equal (getf resp :request-id) 1)) 165 | (is 166 | (equal (getf resp :status) :ok)) 167 | (is 168 | (equal (getf (getf resp :value) :style) 169 | :spawn))) 170 | (with-response (conn resp (swank-protocol:request-swank-require conn 171 | '(swank-repl))) 172 | (is 173 | (equal (getf resp :request-id) 2)) 174 | (is 175 | (equal (getf resp :status) :ok))))) 176 | 177 | (test (repl :depends-on basic-requests) 178 | (with-connection (conn) 179 | (with-repl (conn) 180 | ;; Evaluate 181 | (finishes 182 | (swank-protocol:request-listener-eval conn "(+ 2 2)")) 183 | ;; Wait for all the presentations to show 184 | (sleep 0.1) 185 | (let ((messages (swank-protocol:read-all-messages conn))) 186 | (is 187 | (equal (length messages) 5)) 188 | (is 189 | (equal (list :presentation-start 190 | :write-string 191 | :presentation-end 192 | :write-string 193 | :return) 194 | (loop for i from 0 to 4 collecting 195 | (first (nth i messages))))))))) 196 | 197 | (test (debugging :depends-on repl) 198 | (with-connection (conn) 199 | (with-repl (conn) 200 | ;; Trigger an error 201 | (finishes 202 | (swank-protocol:request-listener-eval conn "(error \"first\")")) 203 | ;; Read debugging messages 204 | (let ((debug-msg (swank-protocol:read-message conn))) 205 | (is 206 | (equal (first debug-msg) 207 | :debug)) 208 | (let ((info (parse-debug debug-msg))) 209 | (is (equal (getf info :thread) 210 | 1)) 211 | (is 212 | (equal (getf info :level) 213 | 1)) 214 | (is 215 | (every #'stringp (getf info :condition))))) 216 | (let ((debug-msg (swank-protocol:read-message conn))) 217 | (is 218 | (equal (first debug-msg) 219 | :debug-activate))) 220 | ;; Leave the debugger 221 | (swank-protocol:request-throw-to-toplevel conn) 222 | ;; Read messages 223 | (let ((message (swank-protocol:read-message conn))) 224 | (is (equal (first message) 225 | :return)) 226 | (is (equal (first (second message)) 227 | :abort)) 228 | (is (equal (second (second message)) 229 | "NIL"))) 230 | (let ((message (swank-protocol:read-message conn))) 231 | (is 232 | (equal (first message) 233 | :debug-return)) 234 | (is 235 | (equal (second message) 236 | 1)) 237 | (is 238 | (equal (third message) 239 | 1))) 240 | ;; Read return/abort message 241 | (let ((message (swank-protocol:read-message conn))) 242 | (is (equal (first message) 243 | :return)) 244 | (is (equal (first (second message)) 245 | :abort))) 246 | ;; Send some regular code 247 | (finishes 248 | (swank-protocol:request-listener-eval conn "(+ 1 1)")) 249 | ;; Read messages 250 | (sleep 0.1) 251 | (let ((messages (swank-protocol:read-all-messages conn))) 252 | (is 253 | (equal (length messages) 5)) 254 | (is 255 | (equal (list :presentation-start 256 | :write-string 257 | :presentation-end 258 | :write-string 259 | :return) 260 | (loop for i from 0 to 4 collecting 261 | (first (nth i messages)))))) 262 | ;; Send another error to verify the debug level 263 | (finishes 264 | (swank-protocol:request-listener-eval conn "(error \"second\")")) 265 | ;; Read debug info 266 | (let ((message (swank-protocol:read-message conn))) 267 | (is 268 | (equal (first message) 269 | :debug)) 270 | (let ((info (parse-debug message))) 271 | (is (equal (getf info :thread) 272 | 1)))) 273 | (let ((message (swank-protocol:read-message conn))) 274 | (is 275 | (equal (first message) 276 | :debug-activate)) 277 | (is 278 | (equal (second message) 279 | 1)) 280 | (is 281 | (equal (third message) 282 | 1))) 283 | ;; Leave the debugger 284 | (swank-protocol:request-throw-to-toplevel conn) 285 | ;; Read return 286 | (let ((message (swank-protocol:read-message conn))) 287 | (is 288 | (equal (first message) 289 | :return))) 290 | ;; Read debug-return message 291 | (let ((message (swank-protocol:read-message conn))) 292 | (is 293 | (equal (first message) 294 | :debug-return)) 295 | (is 296 | (equal (second message) 297 | 1)) 298 | (is 299 | (equal (third message) 300 | 1))) 301 | (let ((message (swank-protocol:read-message conn))) 302 | (is 303 | (equal (first message) 304 | :return)))))) 305 | 306 | (test (restarts :depends-on debugging) 307 | (with-connection (conn) 308 | (with-repl (conn) 309 | ;; Trigger an error 310 | (finishes 311 | (swank-protocol:request-listener-eval conn "(error \"message\")")) 312 | ;; Read debugging messages 313 | (let ((debug-msg (swank-protocol:read-message conn))) 314 | (is 315 | (equal (first debug-msg) 316 | :debug)) 317 | (let ((info (parse-debug debug-msg))) 318 | (is (equal (getf info :thread) 319 | 1)) 320 | (is 321 | (equal (getf info :level) 322 | 1)) 323 | (is 324 | (every #'stringp (getf info :condition))))) 325 | (let ((debug-msg (swank-protocol:read-message conn))) 326 | (is 327 | (equal (first debug-msg) 328 | :debug-activate))) 329 | ;; Invoke a restart 330 | (finishes 331 | (swank-protocol:request-invoke-restart conn 1 2)) 332 | ;; Read all messages 333 | (sleep 0.1) 334 | (let ((messages (swank-protocol:read-all-messages conn))))))) 335 | 336 | (test (standard-input :depends-on repl) 337 | (with-connection (conn) 338 | (with-repl (conn) 339 | ;; Call READ 340 | (finishes 341 | (swank-protocol:request-listener-eval conn "(read)")) 342 | ;; Read the request for input message 343 | (let ((message (swank-protocol:read-message conn))) 344 | (is 345 | (equal (first message) 346 | :read-string)) 347 | (is 348 | (equal (second message) 349 | 1)) 350 | (is 351 | (equal (third message) 352 | 1))) 353 | ;; Send some input 354 | (finishes 355 | (swank-protocol:request-input-string-newline conn "1")) 356 | ;; Wait for all the presentations to show 357 | (sleep 0.1) 358 | (let ((messages (swank-protocol:read-all-messages conn))) 359 | (is 360 | (equal (length messages) 361 | 5)) 362 | (is 363 | (equal (list :presentation-start 364 | :write-string 365 | :presentation-end 366 | :write-string 367 | :return) 368 | (loop for i from 0 to 4 collecting 369 | (first (nth i messages))))))))) 370 | 371 | (run! 'tests) 372 | --------------------------------------------------------------------------------