279 lines
10 KiB
Plaintext
279 lines
10 KiB
Plaintext
|
;; Copyright (c) Rich Hickey. All rights reserved.
|
||
|
|
;; The use and distribution terms for this software are covered by the
|
||
|
|
;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
|
||
|
|
;; which can be found in the file epl-v10.html at the root of this distribution.
|
||
|
|
;; By using this software in any fashion, you are agreeing to be bound by
|
||
|
|
;; the terms of this license.
|
||
|
|
;; You must not remove this notice, or any other, from this software.
|
||
|
|
|
||
|
|
(ns ^{:doc "Receive - Eval - Print - Loop
|
||
|
|
|
||
|
|
Receive a block of JS (presumably generated by a ClojureScript compiler)
|
||
|
|
Evaluate it naively
|
||
|
|
Print the result of evaluation to a string
|
||
|
|
Send the resulting string back to the server Loop!"
|
||
|
|
|
||
|
|
:author "Bobby Calderwood and Alex Redington"}
|
||
|
|
clojure.browser.repl
|
||
|
|
(:require [goog.dom :as gdom]
|
||
|
|
[goog.object :as gobj]
|
||
|
|
[goog.array :as garray]
|
||
|
|
[goog.json :as json]
|
||
|
|
[goog.userAgent.product :as product]
|
||
|
|
[clojure.browser.net :as net]
|
||
|
|
[clojure.browser.event :as event]
|
||
|
|
;; repl-connection callback will receive goog.require('cljs.repl')
|
||
|
|
;; and monkey-patched require expects to be able to derive it
|
||
|
|
;; via goog.basePath, so this namespace should be compiled together
|
||
|
|
;; with clojure.browser.repl:
|
||
|
|
[cljs.repl]))
|
||
|
|
|
||
|
|
(goog-define HOST "localhost")
|
||
|
|
(goog-define PORT 9000)
|
||
|
|
|
||
|
|
(def ^:dynamic *repl* nil)
|
||
|
|
|
||
|
|
;; these two defs are top-level so we can use them for printing
|
||
|
|
(def xpc-connection (atom nil))
|
||
|
|
(def parent-connected? (atom false))
|
||
|
|
|
||
|
|
;; captures any printing that occurs *before* we actually have a connection
|
||
|
|
(def print-queue (array))
|
||
|
|
|
||
|
|
(defn flush-print-queue! [conn]
|
||
|
|
(doseq [str print-queue]
|
||
|
|
(net/transmit conn :print
|
||
|
|
(json/serialize
|
||
|
|
#js {"repl" *repl*
|
||
|
|
"str" str})))
|
||
|
|
(garray/clear print-queue))
|
||
|
|
|
||
|
|
(defn repl-print [data]
|
||
|
|
(.push print-queue (pr-str data))
|
||
|
|
(when @parent-connected?
|
||
|
|
(flush-print-queue! @xpc-connection)))
|
||
|
|
|
||
|
|
(set! *print-newline* true)
|
||
|
|
(set-print-fn! repl-print)
|
||
|
|
(set-print-err-fn! repl-print)
|
||
|
|
|
||
|
|
(defn get-ua-product []
|
||
|
|
(cond
|
||
|
|
product/SAFARI :safari
|
||
|
|
product/CHROME :chrome
|
||
|
|
product/FIREFOX :firefox
|
||
|
|
product/IE :ie))
|
||
|
|
|
||
|
|
(defn evaluate-javascript
|
||
|
|
"Process a single block of JavaScript received from the server"
|
||
|
|
[conn block]
|
||
|
|
(let [result
|
||
|
|
(try
|
||
|
|
{:status :success
|
||
|
|
:value (str (js* "eval(~{block})"))}
|
||
|
|
(catch :default e
|
||
|
|
{:status :exception
|
||
|
|
:value (cljs.repl/error->str e)}))]
|
||
|
|
(pr-str result)))
|
||
|
|
|
||
|
|
(defn send-result [connection url data]
|
||
|
|
(net/transmit connection url "POST" data nil 0))
|
||
|
|
|
||
|
|
(defn send-print
|
||
|
|
"Send data to be printed in the REPL. If there is an error, try again
|
||
|
|
up to 10 times."
|
||
|
|
([url data]
|
||
|
|
(send-print url data 0))
|
||
|
|
([url data n]
|
||
|
|
(let [conn (net/xhr-connection)]
|
||
|
|
(event/listen conn :error
|
||
|
|
(fn [_]
|
||
|
|
(if (< n 10)
|
||
|
|
(send-print url data (inc n))
|
||
|
|
(.log js/console (str "Could not send " data " after " n " attempts.")))))
|
||
|
|
(net/transmit conn url "POST" data nil 0))))
|
||
|
|
|
||
|
|
(def order (atom 0))
|
||
|
|
|
||
|
|
(defn wrap-message [repl t data]
|
||
|
|
(pr-str
|
||
|
|
{:repl repl
|
||
|
|
:type t
|
||
|
|
:content data
|
||
|
|
:order (swap! order inc)}))
|
||
|
|
|
||
|
|
(defn start-evaluator
|
||
|
|
"Start the REPL server connection process. This process runs inside the
|
||
|
|
embedded iframe."
|
||
|
|
[url]
|
||
|
|
(if-let [repl-connection (net/xpc-connection)]
|
||
|
|
(let [connection (net/xhr-connection)
|
||
|
|
repl-connected? (atom false)
|
||
|
|
try-handshake (fn try-handshake []
|
||
|
|
(when-not @repl-connected?
|
||
|
|
(net/transmit repl-connection :start-handshake nil)))]
|
||
|
|
(net/connect repl-connection try-handshake)
|
||
|
|
|
||
|
|
(net/register-service repl-connection
|
||
|
|
:ack-handshake
|
||
|
|
(fn [_]
|
||
|
|
(when-not @repl-connected?
|
||
|
|
(reset! repl-connected? true)
|
||
|
|
;; Now that we're connected to the parent, we can start talking to
|
||
|
|
;; the server.
|
||
|
|
(send-result connection
|
||
|
|
url (wrap-message nil :ready "ready")))))
|
||
|
|
|
||
|
|
(event/listen connection
|
||
|
|
:error
|
||
|
|
(fn [e]
|
||
|
|
(reset! repl-connected? false)
|
||
|
|
(net/transmit repl-connection :reconnect nil)
|
||
|
|
(js/setTimeout try-handshake 1000)))
|
||
|
|
|
||
|
|
(event/listen connection
|
||
|
|
:success
|
||
|
|
(fn [e]
|
||
|
|
(net/transmit
|
||
|
|
repl-connection
|
||
|
|
:evaluate-javascript
|
||
|
|
(.getResponseText (.-currentTarget e) ()))))
|
||
|
|
|
||
|
|
(net/register-service repl-connection
|
||
|
|
:send-result
|
||
|
|
(fn [json]
|
||
|
|
(let [obj (json/parse json)
|
||
|
|
repl (gobj/get obj "repl")
|
||
|
|
result (gobj/get obj "result")]
|
||
|
|
(send-result connection url
|
||
|
|
(wrap-message repl :result result)))))
|
||
|
|
|
||
|
|
(net/register-service repl-connection
|
||
|
|
:print
|
||
|
|
(fn [json]
|
||
|
|
(let [obj (json/parse json)
|
||
|
|
repl (gobj/get obj "repl")
|
||
|
|
str (gobj/get obj "str")]
|
||
|
|
(send-print url (wrap-message repl :print str))))))
|
||
|
|
(js/alert "No 'xpc' param provided to child iframe.")))
|
||
|
|
|
||
|
|
(def load-queue nil)
|
||
|
|
|
||
|
|
(defn bootstrap
|
||
|
|
"Reusable browser REPL bootstrapping. Patches the essential functions
|
||
|
|
in goog.base to support re-loading of namespaces after page load."
|
||
|
|
[]
|
||
|
|
;; Monkey-patch goog.provide if running under optimizations :none - David
|
||
|
|
(when-not js/COMPILED
|
||
|
|
(set! (.-require__ js/goog) js/goog.require)
|
||
|
|
;; suppress useless Google Closure error about duplicate provides
|
||
|
|
(set! (.-isProvided_ js/goog) (fn [name] false))
|
||
|
|
;; provide cljs.user
|
||
|
|
(goog/constructNamespace_ "cljs.user")
|
||
|
|
(set! (.-writeScriptTag__ js/goog)
|
||
|
|
(fn [src opt_sourceText]
|
||
|
|
;; the page is already loaded, we can no longer leverage document.write
|
||
|
|
;; instead construct script tag elements and append them to the body
|
||
|
|
;; of the page, to avoid parallel script loading enforce sequential
|
||
|
|
;; load with a simple load queue
|
||
|
|
(let [loaded (atom false)
|
||
|
|
onload (fn []
|
||
|
|
(when (and load-queue (false? @loaded))
|
||
|
|
(swap! loaded not)
|
||
|
|
(if (zero? (alength load-queue))
|
||
|
|
(set! load-queue nil)
|
||
|
|
(.apply js/goog.writeScriptTag__ nil (.shift load-queue)))))]
|
||
|
|
(.appendChild js/document.body
|
||
|
|
(as-> (.createElement js/document "script") script
|
||
|
|
(doto script
|
||
|
|
(gobj/set "type" "text/javascript")
|
||
|
|
(gobj/set "onload" onload)
|
||
|
|
(gobj/set "onreadystatechange" onload)) ;; IE
|
||
|
|
(if (nil? opt_sourceText)
|
||
|
|
(doto script (gobj/set "src" src))
|
||
|
|
(doto script (gdom/setTextContent opt_sourceText))))))))
|
||
|
|
;; queue or load
|
||
|
|
(set! (.-writeScriptTag_ js/goog)
|
||
|
|
(fn [src opt_sourceText]
|
||
|
|
(if load-queue
|
||
|
|
(.push load-queue #js [src opt_sourceText])
|
||
|
|
(do
|
||
|
|
(set! load-queue #js [])
|
||
|
|
(js/goog.writeScriptTag__ src opt_sourceText)))))
|
||
|
|
;; In the latest Closure library implementation, there is no goog.writeScriptTag_,
|
||
|
|
;; to monkey-patch. The behavior of interest is instead in goog.Dependency.prototype.load,
|
||
|
|
;; which first checks and uses CLOSURE_IMPORT_SCRIPT if defined. So we hook our desired
|
||
|
|
;; behavior here.
|
||
|
|
(when goog/debugLoader_
|
||
|
|
(set! js/CLOSURE_IMPORT_SCRIPT (.-writeScriptTag_ js/goog)))
|
||
|
|
;; we must reuse Closure library dev time dependency management, under namespace
|
||
|
|
;; reload scenarios we simply delete entries from the correct private locations
|
||
|
|
(set! (.-require js/goog)
|
||
|
|
(fn [src reload]
|
||
|
|
(when (= reload "reload-all")
|
||
|
|
(set! (.-cljsReloadAll_ js/goog) true))
|
||
|
|
(let [reload? (or reload (.-cljsReloadAll_ js/goog))]
|
||
|
|
(when reload?
|
||
|
|
(if (some? goog/debugLoader_)
|
||
|
|
(let [path (.getPathFromDeps_ goog/debugLoader_ src)]
|
||
|
|
(gobj/remove (.-written_ goog/debugLoader_) path)
|
||
|
|
(gobj/remove (.-written_ goog/debugLoader_)
|
||
|
|
(str js/goog.basePath path)))
|
||
|
|
(let [path (gobj/get js/goog.dependencies_.nameToPath src)]
|
||
|
|
(gobj/remove js/goog.dependencies_.visited path)
|
||
|
|
(gobj/remove js/goog.dependencies_.written path)
|
||
|
|
(gobj/remove js/goog.dependencies_.written
|
||
|
|
(str js/goog.basePath path)))))
|
||
|
|
(let [ret (.require__ js/goog src)]
|
||
|
|
(when (= reload "reload-all")
|
||
|
|
(set! (.-cljsReloadAll_ js/goog) false))
|
||
|
|
;; handle requires from Closure Library goog.modules
|
||
|
|
(if (js/goog.isInModuleLoader_)
|
||
|
|
(js/goog.module.getInternal_ src)
|
||
|
|
ret)))))))
|
||
|
|
|
||
|
|
(defn connect
|
||
|
|
"Connects to a REPL server from an HTML document. After the
|
||
|
|
connection is made, the REPL will evaluate forms in the context of
|
||
|
|
the document that called this function."
|
||
|
|
[repl-server-url]
|
||
|
|
(let [connected? (atom false)
|
||
|
|
repl-connection (net/xpc-connection {:peer_uri repl-server-url})]
|
||
|
|
(swap! xpc-connection (constantly repl-connection))
|
||
|
|
(net/register-service repl-connection
|
||
|
|
:start-handshake
|
||
|
|
(fn [_]
|
||
|
|
;; Child will keep retrying, but we only want
|
||
|
|
;; to ack once.
|
||
|
|
(when-not @connected?
|
||
|
|
(reset! connected? true)
|
||
|
|
(reset! parent-connected? true)
|
||
|
|
(net/transmit repl-connection :ack-handshake nil)
|
||
|
|
(flush-print-queue! repl-connection))))
|
||
|
|
(net/register-service repl-connection
|
||
|
|
:reconnect
|
||
|
|
(fn [_]
|
||
|
|
(reset! connected? false)
|
||
|
|
(reset! parent-connected? false)))
|
||
|
|
(net/register-service repl-connection
|
||
|
|
:evaluate-javascript
|
||
|
|
(fn [json]
|
||
|
|
(let [obj (json/parse json)
|
||
|
|
repl (gobj/get obj "repl")
|
||
|
|
form (gobj/get obj "form")]
|
||
|
|
(net/transmit
|
||
|
|
repl-connection
|
||
|
|
:send-result
|
||
|
|
(json/serialize
|
||
|
|
#js {"repl" repl
|
||
|
|
"result"
|
||
|
|
(binding [*repl* repl]
|
||
|
|
(evaluate-javascript repl-connection form))})))))
|
||
|
|
(net/connect repl-connection
|
||
|
|
(constantly nil)
|
||
|
|
(fn [iframe]
|
||
|
|
(set! (.-display (.-style iframe))
|
||
|
|
"none")))
|
||
|
|
(bootstrap)
|
||
|
|
repl-connection))
|