├── .gitignore ├── .travis.yml ├── README.md ├── remote-js-test.asd ├── remote-js.asd ├── src └── remote-js.lisp └── t └── remote-js.lisp /.gitignore: -------------------------------------------------------------------------------- 1 | *.fasl 2 | *.dx32fsl 3 | *.dx64fsl 4 | *.lx32fsl 5 | *.lx64fsl 6 | *.x86f 7 | *~ 8 | .#* -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: common-lisp 2 | sudo: false 3 | 4 | env: 5 | global: 6 | - PATH=~/.roswell/bin:$PATH 7 | - ROSWELL_BRANCH=master 8 | - ROSWELL_INSTALL_DIR=$HOME/.roswell 9 | - COVERAGE_EXCLUDE=t 10 | matrix: 11 | - LISP=sbcl-bin COVERALLS=true 12 | 13 | addons: 14 | apt: 15 | packages: 16 | - xfvb 17 | 18 | install: 19 | # Roswell & coveralls 20 | - curl -L https://raw.githubusercontent.com/snmsts/roswell/$ROSWELL_BRANCH/scripts/install-for-ci.sh | sh 21 | - git clone https://github.com/fukamachi/cl-coveralls ~/lisp/cl-coveralls 22 | # Clone some libraries 23 | - git clone https://github.com/ParenBook/trivial-ws ~/lisp/trivial-ws 24 | # Set up a virtual X framebuffer 25 | - export DISPLAY=:99.0 26 | - sh -e /etc/init.d/xvfb start 27 | - sleep 3 # give xvfb time to start 28 | 29 | cache: 30 | directories: 31 | - $HOME/.roswell 32 | - $HOME/.config/common-lisp 33 | 34 | before_script: 35 | - ros --version 36 | - ros config 37 | 38 | script: 39 | - ros -e '(ql:quickload (list :cl-coveralls))' 40 | -e '(ql:quickload :remote-js-test)' 41 | -e '(setf fiveam:*debug-on-error* t 42 | fiveam:*debug-on-failure* t)' 43 | -e '(remote-js-test:run-tests)' 44 | 45 | notifications: 46 | email: 47 | - eudoxiahp@gmail.com 48 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # remote-js 2 | 3 | [![Build Status](https://travis-ci.org/ceramic/remote-js.svg?branch=master)](https://travis-ci.org/ceramic/remote-js) 4 | 5 | Send JavaScript from Common Lisp to a browser. 6 | 7 | # Overview 8 | 9 | # Usage 10 | 11 | ## Simple Example 12 | 13 | First, we create a context object: 14 | 15 | ```lisp 16 | (defvar ctx (remote-js:make-context)) 17 | ``` 18 | 19 | Then we start the WebSockets server: 20 | 21 | ```lisp 22 | (remote-js:start ctx) 23 | ``` 24 | 25 | Now, remote-js gives us a function that generates the HTML of a simple page that 26 | connects to this context and notifies it when it's connected. We write the HTML 27 | to `~/test.html`: 28 | 29 | ```lisp 30 | (with-open-file (stream (merge-pathnames #p"test.html" (user-homedir-pathname)) 31 | :direction :output 32 | :if-exists :supersede 33 | :if-does-not-exist :create) 34 | (write-string (remote-js:html ctx) stream)) 35 | ``` 36 | 37 | Open the file in your browser. Now you can do: 38 | 39 | ```lisp 40 | (remote-js:eval ctx "alert('hello!')") 41 | ``` 42 | 43 | And you will see the alert box pop up in your browser. 44 | 45 | ## Talking to the server 46 | 47 | remote-js defines a function in the generated HTML, `RemoteJS.send`, which takes 48 | a string and sends it to the server. You can specify a callback for receiving 49 | messages like this: 50 | 51 | ```lisp 52 | (defvar ctx (remote-js:make-context 53 | :callback #'(lambda (message) (format t "Received: ~A~%" message)))) 54 | ``` 55 | 56 | Then, start everything and generate the HTML file again: 57 | 58 | ```lisp 59 | (remote-js:start ctx) 60 | (with-open-file (stream (merge-pathnames #p"test.html" (user-homedir-pathname)) 61 | :direction :output 62 | :if-exists :supersede 63 | :if-does-not-exist :create) 64 | (write-string (remote-js:html ctx) stream)) 65 | ``` 66 | 67 | And open `test.html` in your browser. 68 | 69 | Now you can send messages to the server like this: 70 | 71 | ```lisp 72 | CL-USER> (remote-js:eval ctx "RemoteJS.send('hi!')") 73 | Received: hi! 74 | ``` 75 | 76 | **Note:** when a client connects to the server, it sends the string 77 | `remote-js:+connected-message+`. 78 | 79 | # Tests 80 | 81 | The tests use [trivial-open-browser][tob], and running them will open your 82 | default browser to a temporary file. 83 | 84 | # License 85 | 86 | Copyright (c) 2016 Fernando Borretti 87 | 88 | Licensed under the MIT License. 89 | 90 | [tob]: http://quickdocs.org/trivial-open-browser/ 91 | -------------------------------------------------------------------------------- /remote-js-test.asd: -------------------------------------------------------------------------------- 1 | (defsystem remote-js-test 2 | :author "Fernando Borretti " 3 | :license "MIT" 4 | :depends-on (:remote-js 5 | :fiveam 6 | :trivial-open-browser 7 | :bordeaux-threads) 8 | :components ((:module "t" 9 | :serial t 10 | :components 11 | ((:file "remote-js"))))) 12 | -------------------------------------------------------------------------------- /remote-js.asd: -------------------------------------------------------------------------------- 1 | (defsystem remote-js 2 | :author "Fernando Borretti " 3 | :maintainer "Fernando Borretti " 4 | :license "MIT" 5 | :version "0.1" 6 | :homepage "https://github.com/ceramic/remote-js" 7 | :bug-tracker "https://github.com/ceramic/remote-js/issues" 8 | :source-control (:git "git@github.com:ceramic/remote-js.git") 9 | :depends-on (:trivial-ws 10 | :cl-markup 11 | :find-port) 12 | :components ((:module "src" 13 | :serial t 14 | :components 15 | ((:file "remote-js")))) 16 | :description "Send JavaScript from Common Lisp to a browser." 17 | :long-description 18 | #.(uiop:read-file-string 19 | (uiop:subpathname *load-pathname* "README.md")) 20 | :in-order-to ((test-op (test-op remote-js-test)))) 21 | -------------------------------------------------------------------------------- /src/remote-js.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (defpackage remote-js 3 | (:use :cl) 4 | (:shadow :eval) 5 | (:export :context 6 | :context-address 7 | :context-port 8 | :context-server 9 | :context-running-p 10 | :make-context 11 | :start 12 | :stop 13 | :+connected-message+ 14 | :js 15 | :html 16 | :eval 17 | :buffered-context 18 | :make-buffered-context 19 | :context-connected-p) 20 | (:documentation "The main package.")) 21 | (in-package :remote-js) 22 | 23 | (defparameter +default-callback+ 24 | #'(lambda (message) 25 | (declare (ignore message)) 26 | nil)) 27 | 28 | (defclass context () 29 | ((address :reader context-address 30 | :initarg :address 31 | :initform trivial-ws:+default-address+ 32 | :type string 33 | :documentation "The address the WebSockets server will run on.") 34 | (port :reader context-port 35 | :initarg :port 36 | :initform (find-port:find-port) 37 | :type integer 38 | :documentation "The port the WebSockets server will run on.") 39 | (timeout :reader context-timeout 40 | :initarg :timeout 41 | :initform trivial-ws:+default-timeout+ 42 | :type integer 43 | :documentation "The number of seconds after which the WebSockets server will disconnect an inactive client.") 44 | (server :accessor context-server 45 | :initarg :server 46 | :documentation "The trivial-websockets server.") 47 | (handler :accessor context-handler 48 | :initarg :handler 49 | :initform nil 50 | :documentation "The server handler.") 51 | (runningp :accessor context-running-p 52 | :initform nil 53 | :documentation "Whether the server is running.") 54 | (record :accessor context-record-p 55 | :initarg :recordp 56 | :initform nil 57 | :type boolean 58 | :documentation "Whether or not to record sent HTML.") 59 | (callback :accessor context-callback 60 | :initarg :callback 61 | :initform +default-callback+ 62 | :documentation "The function that is called when the client sends a 63 | message.")) 64 | (:documentation "A context object.")) 65 | 66 | (defun server-for-context (context) 67 | (trivial-ws:make-server 68 | :on-connect #'(lambda (server) 69 | (declare (ignore server))) 70 | :on-disconnect #'(lambda (server) 71 | (declare (ignore server))) 72 | :on-message #'(lambda (server message) 73 | (declare (ignore server)) 74 | (funcall (context-callback context) message)))) 75 | 76 | (defun make-context (&key 77 | (address trivial-ws:+default-address+) 78 | (port (find-port:find-port)) 79 | (timeout trivial-ws:+default-timeout+) 80 | (callback +default-callback+) 81 | recordp) 82 | "Create a context object." 83 | (let ((ctx (make-instance 'context 84 | :address address 85 | :port port 86 | :timeout timeout 87 | :recordp recordp 88 | :callback callback))) 89 | (setf (context-server ctx) (server-for-context ctx)) 90 | ctx)) 91 | 92 | (defgeneric start (context) 93 | (:documentation "Start the WebSockets server.") 94 | 95 | (:method ((context context)) 96 | (with-slots (address port server handler runningp) context 97 | (setf handler (trivial-ws:start server port :address address) 98 | runningp t)))) 99 | 100 | (defgeneric stop (context) 101 | (:documentation "Stop the WebSockets server.") 102 | 103 | (:method ((context context)) 104 | (with-slots (handler runningp) context 105 | (when runningp 106 | (trivial-ws:stop handler) 107 | (setf runningp nil))))) 108 | 109 | (defparameter +connected-message+ "connected") 110 | 111 | (defparameter +script-template+ 112 | "window.RemoteJS = {}; 113 | var RemoteJS = window.RemoteJS; 114 | 115 | RemoteJS.send = function(data) { 116 | RemoteJS.ws.send(data); 117 | }; 118 | 119 | RemoteJS.connect = function() { 120 | var ws = new WebSocket(\"ws://~A:~D/\"); 121 | 122 | ws.onmessage = function(evt) { 123 | (1, eval)(evt.data); 124 | }; 125 | 126 | ws.onopen = function() { 127 | RemoteJS.send('~A'); 128 | }; 129 | 130 | ws.onclose = function() { 131 | setTimeout(RemoteJS.connect, 1); 132 | }; 133 | 134 | RemoteJS.ws = ws; 135 | }; 136 | 137 | RemoteJS.connect();") 138 | 139 | (defgeneric js (context) 140 | (:documentation "Return the JS for this context.") 141 | 142 | (:method ((context context)) 143 | (format nil +script-template+ 144 | (context-address context) 145 | (context-port context) 146 | +connected-message+))) 147 | 148 | (defgeneric html (context) 149 | (:documentation "Return the HTML for this context.") 150 | 151 | (:method ((context context)) 152 | (markup:html5 153 | (:head 154 | (:meta :charset "utf-8") 155 | (:meta :http-equiv "X-UA-Compatible" :content "IE=edge") 156 | (:meta :name "viewport" :content "width=device-width, initial-scale=1")) 157 | (:body 158 | (:script (cl-markup:raw (js context))))))) 159 | 160 | (defgeneric eval (context string) 161 | (:documentation "Send some JavaScript to evaluate remotely. Return the 162 | string.") 163 | 164 | (:method ((context context) string) 165 | (when (context-record-p context) 166 | (format t "JS: ~A~%" string)) 167 | (let ((client (first (trivial-ws:clients (context-server context))))) 168 | (if client 169 | (progn 170 | (trivial-ws:send client string) 171 | string) 172 | (error "No client connected"))))) 173 | 174 | ;;; Buffered context 175 | 176 | (defclass buffered-context (context) 177 | ((%callback) 178 | (connected :accessor context-connected-p 179 | :initform nil 180 | :documentation "Whether or not the client is connected.") 181 | (buffer :accessor context-buffer 182 | :initarg :buffer 183 | :initform nil 184 | :type list 185 | :documentation "A list of JavaScript strings to evaluate.")) 186 | (:documentation "The buffered context stores evaluation commands in a buffer 187 | until a client connects, then sends all of them at once.")) 188 | 189 | (defmethod initialize-instance :after ((context buffered-context) &key) 190 | ;; FIXME: is this portable? 191 | (with-slots (callback %callback connected) context 192 | ;; Copy the user-provided callback 193 | (setf %callback callback) 194 | ;; Wrap the callback in a callback that detects the connection message 195 | (setf callback 196 | #'(lambda (message) 197 | (if (string= message +connected-message+) 198 | (setf connected t) 199 | (funcall %callback message)))))) 200 | 201 | (defun make-buffered-context (&key 202 | (address trivial-ws:+default-address+) 203 | (port (find-port:find-port)) 204 | (callback +default-callback+) 205 | (timeout trivial-ws:+default-timeout+) 206 | recordp) 207 | "Create a buffered context object." 208 | (let ((ctx (make-instance 'buffered-context 209 | :address address 210 | :port port 211 | :timeout timeout 212 | :recordp recordp 213 | :callback callback))) 214 | (setf (context-server ctx) (server-for-context ctx)) 215 | ctx)) 216 | 217 | (defmethod eval ((context buffered-context) string) 218 | "Send JavaScript to evaluate, if the buffer is connected. Otherwise, add the code to the buffer. 219 | 220 | If there's anything in the buffer and the client is connected, send it all in 221 | order before evaluating the string." 222 | (with-slots (connected buffer) context 223 | (if connected 224 | ;; The client is connected. 225 | (progn 226 | ;; Do we have a backlog? 227 | (when buffer 228 | ;; Send it all 229 | (mapcar #'(lambda (message) 230 | (call-next-method context message)) 231 | ;; In order! 232 | (reverse buffer)) 233 | ;; Clean the buffer 234 | (setf buffer nil)) 235 | ;; Evalutate the string 236 | (call-next-method)) 237 | ;; The client is not connected, add this to the buffer 238 | (push string buffer))) 239 | string) 240 | -------------------------------------------------------------------------------- /t/remote-js.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (defpackage remote-js-test 3 | (:use :cl :fiveam) 4 | (:export :run-tests)) 5 | (in-package :remote-js-test) 6 | 7 | (def-suite tests 8 | :description "remote-js tests.") 9 | (in-suite tests) 10 | 11 | (test context 12 | (let ((received nil) 13 | (ctx) 14 | (file (asdf:system-relative-pathname :remote-js #p"t/test.html"))) 15 | (finishes 16 | (setf ctx (remote-js:make-context 17 | :recordp t 18 | :callback #'(lambda (message) 19 | (setf received message))))) 20 | (finishes 21 | (remote-js:start ctx)) 22 | (finishes 23 | (with-open-file (stream file 24 | :direction :output 25 | :if-exists :supersede 26 | :if-does-not-exist :create) 27 | (write-string (remote-js:html ctx) stream))) 28 | (finishes 29 | (bt:make-thread 30 | #'(lambda () 31 | (uiop:run-program (format nil "chromium-browser 'file://~A'" (namestring file)))))) 32 | (sleep 1) 33 | (is 34 | (stringp (remote-js:eval ctx "RemoteJS.send('test')"))) 35 | (sleep 0.1) 36 | (is-true 37 | (string= received "test")) 38 | (finishes (remote-js:eval ctx "var test='global'")) 39 | (sleep 0.1) 40 | (finishes (remote-js:eval ctx "RemoteJS.send(test)")) 41 | (sleep 0.1) 42 | (is-true 43 | (string= received "global")) 44 | (finishes 45 | (delete-file file)) 46 | (finishes 47 | (remote-js:stop ctx)))) 48 | 49 | (defun run-tests () 50 | (run! 'tests)) 51 | --------------------------------------------------------------------------------