wch/remote_repl.R

## remote_repl.R
library(httpuv)

PORT <- 7000

app <- list(
  call = function(req) {
    page(req)
  },
  onWSOpen = function(ws) {
    ws$onMessage(function(binary, message) {
      on_message(ws, binary, message)
    })
  }
)

page <- function(req) {
  wsUrl = paste(sep='',
    '"',
    "ws://",
    ifelse(is.null(req$HTTP_HOST), req$SERVER_NAME, req$HTTP_HOST),
    '"')

  list(
    status = 200L,
    headers = list(
      'Content-Type' = 'text/html'
    ),
    body = sprintf('
<html>
<head>
<style type="text/css">
body {
  font-size: 14px;
}
pre {
  margin: 0
}
.user-input {
  color: blue;
  margin-top: 4px;
}
.user-input textarea {
  color: blue;
  vertical-align: top;
  font-family: Courier;
  font-size: 14px;
  margin: 0;
  border: 0;
  padding: 0;
  outline: none;
}

</style>
<script>
var ws = new WebSocket("ws://localhost:%s");
ws.onmessage = function(msg) {
  var msgDiv = document.createElement("pre");
  msgDiv.innerHTML = msg.data.replace(/&/g, "&amp;").replace(/\\</g, "&lt;");
  document.getElementById("output").appendChild(msgDiv);
  document.documentElement.scrollIntoView({behavior: "smooth", block: "end"});
}

function sendInput() {
  var input = document.getElementById("input");

  // Append the text
  var msgDiv = document.createElement("pre");
  msgDiv.setAttribute("class", "user-input");
  msgDiv.innerHTML = "&gt; " + input.value.replace(/&/g, "&amp;").replace(/\\</g, "&lt;");
  document.getElementById("output").appendChild(msgDiv);

  if (input.value == "") {
    // Don\'t try to eval empty line
    return;
  }
  ws.send(input.value);
  input.value = "";
}

</script>
</head>
<body>
<div id="output">
<pre>%s
</pre>
</div>
<pre class="user-input">&gt; <textarea rows=1 cols=100 id="input" autofocus></textarea>
</pre>
<script>

document.getElementById("input").addEventListener("keydown", function(event) {
  if (event.key === "Enter") {
    if (event.shiftKey) {
      // Don\'t send if Shift is down. Only increase number of rows.
      input.rows = input.rows + 1;
    } else {
      sendInput();
      event.preventDefault();
    }
  }
});


</script>
</body>
</html>
', PORT, R.version.string
    )
  )
}

on_message <- function(ws, binary, message) {
  result_txt <- capture.output({
    tryCatch(
      {
        expr <- parse(text = message)
        result <- withVisible(eval(expr, envir = .GlobalEnv))
        if (result$visible == TRUE) {
          print(result$value)
        }
      },
      error = function(e) {
        cat("Error: ", e$message)
      }
    )
  })
  result_txt <- paste(result_txt, collapse = "\n")

  ws$send(result_txt)
}


startServer("0.0.0.0", PORT, app)
browseURL(sprintf("http://localhost:%s/", PORT))

# Things to try:
# trace(on_message, edit = TRUE)
	library(httpuv)

	PORT <- 7000

	app <- list(
	call = function(req) {
	page(req)
	},
	onWSOpen = function(ws) {
	ws$onMessage(function(binary, message) {
	on_message(ws, binary, message)
	})
	}
	)

	page <- function(req) {
	wsUrl = paste(sep='',
	'"',
	"ws://",
	ifelse(is.null(req$HTTP_HOST), req$SERVER_NAME, req$HTTP_HOST),
	'"')

	list(
	status = 200L,
	headers = list(
	'Content-Type' = 'text/html'
	),
	body = sprintf('
	<html>
	<head>
	<style type="text/css">
	body {
	font-size: 14px;
	}
	pre {
	margin: 0
	}
	.user-input {
	color: blue;
	margin-top: 4px;
	}
	.user-input textarea {
	color: blue;
	vertical-align: top;
	font-family: Courier;
	font-size: 14px;
	margin: 0;
	border: 0;
	padding: 0;
	outline: none;
	}

	</style>
	<script>
	var ws = new WebSocket("ws://localhost:%s");
	ws.onmessage = function(msg) {
	var msgDiv = document.createElement("pre");
	msgDiv.innerHTML = msg.data.replace(/&/g, "&").replace(/\\</g, "<");
	document.getElementById("output").appendChild(msgDiv);
	document.documentElement.scrollIntoView({behavior: "smooth", block: "end"});
	}

	function sendInput() {
	var input = document.getElementById("input");

	// Append the text
	var msgDiv = document.createElement("pre");
	msgDiv.setAttribute("class", "user-input");
	msgDiv.innerHTML = "> " + input.value.replace(/&/g, "&").replace(/\\</g, "<");
	document.getElementById("output").appendChild(msgDiv);

	if (input.value == "") {
	// Don\'t try to eval empty line
	return;
	}
	ws.send(input.value);
	input.value = "";
	}

	</script>
	</head>
	<body>
	<div id="output">
	<pre>%s
	</pre>
	</div>
	<pre class="user-input">> <textarea rows=1 cols=100 id="input" autofocus></textarea>
	</pre>
	<script>

	document.getElementById("input").addEventListener("keydown", function(event) {
	if (event.key === "Enter") {
	if (event.shiftKey) {
	// Don\'t send if Shift is down. Only increase number of rows.
	input.rows = input.rows + 1;
	} else {
	sendInput();
	event.preventDefault();
	}
	}
	});


	</script>
	</body>
	</html>
	', PORT, R.version.string
	)
	)
	}

	on_message <- function(ws, binary, message) {
	result_txt <- capture.output({
	tryCatch(
	{
	expr <- parse(text = message)
	result <- withVisible(eval(expr, envir = .GlobalEnv))
	if (result$visible == TRUE) {
	print(result$value)
	}
	},
	error = function(e) {
	cat("Error: ", e$message)
	}
	)
	})
	result_txt <- paste(result_txt, collapse = "\n")

	ws$send(result_txt)
	}


	startServer("0.0.0.0", PORT, app)
	browseURL(sprintf("http://localhost:%s/", PORT))

	# Things to try:
	# trace(on_message, edit = TRUE)