Skip to content

Commit ba2515f

Browse files
renkun-kenrenkun-ken
committed
Rename scripts
1 parent e0c0322 commit ba2515f

File tree

3 files changed

+167
-280
lines changed

3 files changed

+167
-280
lines changed

‎R/notebook.R‎

Lines changed: 166 additions & 102 deletions
Original file line numberDiff line numberDiff line change
@@ -1,113 +1,177 @@
1-
local({
1+
requireNamespace("jsonlite")
2+
requireNamespace("callr")
3+
4+
args <- commandArgs(trailingOnly = TRUE)
5+
exprs <- parse(text = args, keep.source = FALSE)
6+
env <- new.env()
7+
for (expr in exprs) {
8+
eval(expr, env)
9+
}
10+
11+
r <- callr::r_session$new(
12+
callr::r_session_options(
13+
system_profile = TRUE, user_profile = TRUE, supervise = TRUE),
14+
wait = TRUE
15+
)
16+
17+
r$run(function() {
218
requireNamespace("jsonlite")
319
requireNamespace("svglite")
4-
args <- commandArgs(trailingOnly = TRUE)
5-
exprs <- parse(text = args, keep.source = FALSE)
6-
env <- new.env()
7-
for (expr in exprs) {
8-
eval(expr, env)
9-
}
1020

11-
null_dev_id <- c(pdf = 2L)
12-
null_dev_size <- c(7 + pi, 7 + pi)
13-
viewer_file <- NULL
14-
browser_url <- NULL
21+
.vscNotebook <- local({
22+
null_dev_id <- c(pdf = 2L)
23+
null_dev_size <- c(7 + pi, 7 + pi)
24+
viewer_file <- NULL
25+
browser_url <- NULL
1526

16-
write_log <- function(...) {
17-
cat("[", format(Sys.time(), "%Y-%m-%d %H:%M:%OS3"), "] ",
18-
..., "\n", sep = "")
19-
}
27+
options(
28+
device = function(...) {
29+
pdf(NULL,
30+
width = null_dev_size[[1L]],
31+
height = null_dev_size[[2L]],
32+
bg = "white")
33+
dev.control(displaylist = "enable")
34+
},
35+
viewer = function(url, ...) {
36+
viewer_file <<- url
37+
},
38+
page_viewer = function(url, ...) {
39+
viewer_file <<- url
40+
},
41+
browser = function(url, ...) {
42+
browser_url <<- url
43+
}
44+
)
2045

21-
options(
22-
device = function(...) {
23-
pdf(NULL,
24-
width = null_dev_size[[1L]],
25-
height = null_dev_size[[2L]],
26-
bg = "white")
27-
dev.control(displaylist = "enable")
28-
},
29-
viewer = function(url, ...) {
30-
write_log("viewer: ", url)
31-
viewer_file <<- url
32-
},
33-
page_viewer = function(url, ...) {
34-
write_log("page_viewer: ", url)
35-
viewer_file <<- url
36-
},
37-
browser = function(url, ...) {
38-
write_log("browser: ", url)
39-
browser_url <<- url
46+
check_null_dev <- function() {
47+
identical(dev.cur(), null_dev_id) &&
48+
identical(dev.size(), null_dev_size)
4049
}
41-
)
42-
43-
check_null_dev <- function() {
44-
identical(dev.cur(), null_dev_id) &&
45-
identical(dev.size(), null_dev_size)
46-
}
4750

48-
ls.str(env)
49-
while (TRUE) {
50-
write_log("Listening on port: ", env$port)
51-
con <- try(socketConnection(host = "127.0.0.1", port = env$port,
52-
blocking = TRUE, server = TRUE,
53-
open = "r+"), silent = TRUE)
54-
if (inherits(con, "try-error")) {
55-
message(con)
56-
} else {
57-
tryCatch({
58-
line <- readLines(con, n = 1)
59-
write_log(line)
60-
request <- jsonlite::fromJSON(line)
61-
viewer_file <- NULL
62-
browser_url <- NULL
63-
str <- tryCatch({
64-
expr <- parse(text = request$expr)
65-
out <- withVisible(eval(expr, globalenv()))
66-
text <- utils::capture.output(print(out$value, view = TRUE))
67-
if (check_null_dev()) {
68-
record <- recordPlot()
69-
plot_file <- tempfile(fileext = ".svg")
70-
svglite::svglite(plot_file, width = 12, height = 8)
71-
replayPlot(record)
72-
graphics.off()
73-
res <- list(
74-
type = "plot",
75-
result = plot_file
76-
)
77-
} else if (!is.null(viewer_file)) {
78-
res <- list(
79-
type = "viewer",
80-
result = viewer_file
81-
)
82-
} else if (!is.null(browser_url)) {
83-
res <- list(
84-
type = "browser",
85-
result = browser_url
86-
)
87-
} else if (out$visible) {
88-
res <- list(
89-
type = "text",
90-
result = paste0(text, collapse = "\n")
91-
)
92-
} else {
93-
res <- list(
94-
type = "text",
95-
result = ""
96-
)
97-
}
98-
res
99-
}, error = function(e) {
100-
list(
101-
type = "error",
102-
result = conditionMessage(e)
103-
)
104-
}
51+
evaluate <- function(id, expr) {
52+
viewer_file <<- NULL
53+
browser_url <<- NULL
54+
res <- tryCatch({
55+
expr <- parse(text = expr)
56+
out <- withVisible(eval(expr, globalenv()))
57+
text <- utils::capture.output(print(out$value, view = TRUE))
58+
if (check_null_dev()) {
59+
record <- recordPlot()
60+
plot_file <- tempfile(fileext = ".svg")
61+
svglite::svglite(plot_file, width = 12, height = 8)
62+
replayPlot(record)
63+
graphics.off()
64+
list(
65+
id = id,
66+
type = "plot",
67+
result = plot_file
68+
)
69+
} else if (!is.null(viewer_file)) {
70+
list(
71+
id = id,
72+
type = "viewer",
73+
result = viewer_file
74+
)
75+
} else if (!is.null(browser_url)) {
76+
list(
77+
id = id,
78+
type = "browser",
79+
result = browser_url
80+
)
81+
} else if (out$visible) {
82+
list(
83+
id = id,
84+
type = "text",
85+
result = paste0(text, collapse = "\n")
86+
)
87+
} else {
88+
list(
89+
id = id,
90+
type = "text",
91+
result = ""
92+
)
93+
}
94+
}, error = function(e) {
95+
list(
96+
id = id,
97+
type = "error",
98+
result = conditionMessage(e)
10599
)
106-
response <- jsonlite::toJSON(str, auto_unbox = TRUE, force = TRUE)
107-
writeLines(response, con)
100+
})
101+
102+
res
103+
}
104+
105+
environment()
106+
})
107+
108+
attach(environment(), name = "tools:vscNotebook")
109+
NULL
110+
})
111+
112+
con <- socketConnection(host = "127.0.0.1", port = env$port, open = "r+b")
113+
running_request <- NULL
114+
115+
while (TRUE) {
116+
response <- NULL
117+
if (socketSelect(list(con), timeout = 0)) {
118+
header <- readLines(con, 1, encoding = "UTF-8")
119+
n <- as.integer(gsub("^Content-Length\\: (\\d+)$", "\\1", header))
120+
content <- readChar(con, n, useBytes = TRUE)
121+
Encoding(content) <- "UTF-8"
122+
cat(content, "\n", sep = "")
123+
124+
request <- jsonlite::fromJSON(content, simplifyVector = FALSE)
125+
if (request$type == "eval") {
126+
response <- tryCatch({
127+
r$call(function(id, expr) {
128+
.vscNotebook$evaluate(id, expr)
129+
}, list(id = request$id, expr = request$expr))
130+
running_request <- request
131+
NULL
108132
}, error = function(e) {
109-
message(e)
110-
}, finally = close(con))
133+
list(
134+
id = request$id,
135+
type = "error",
136+
result = conditionMessage(e)
137+
)
138+
})
139+
} else if (request$type == "cancel") {
140+
r$interrupt()
111141
}
112142
}
113-
})
143+
144+
if (!is.null(running_request)) {
145+
result <- r$read()
146+
if (!is.null(result)) {
147+
print(result)
148+
if (is.list(result$result)) {
149+
response <- result$result
150+
} else {
151+
if (is.null(result$error)) {
152+
response <- list(
153+
id = running_request$id,
154+
type = "text",
155+
result = result$message
156+
)
157+
} else {
158+
response <- list(
159+
id = running_request$id,
160+
type = "error",
161+
result = conditionMessage(result$error)
162+
)
163+
}
164+
}
165+
running_request <- NULL
166+
}
167+
168+
if (!is.null(response)) {
169+
response <- jsonlite::toJSON(response,
170+
auto_unbox = TRUE, force = TRUE)
171+
cat("response: ", response, "\n")
172+
writeLines(response, con)
173+
}
174+
}
175+
176+
Sys.sleep(0.05)
177+
}

0 commit comments

Comments
 (0)