Skip to content

Commit e6bd1af

Browse files
renkun-kenrenkun-ken
committed
Update notebook2
1 parent dbcb1ff commit e6bd1af

2 files changed

Lines changed: 185 additions & 203 deletions

File tree

‎R/notebook2.R‎

Lines changed: 119 additions & 114 deletions
Original file line numberDiff line numberDiff line change
@@ -8,137 +8,142 @@ for (expr in exprs) {
88
eval(expr, env)
99
}
1010

11-
# r <- callr::r_session$new(
12-
# callr::r_session_options(
13-
# system_profile = TRUE, user_profile = TRUE, supervise = TRUE),
14-
# wait = TRUE
15-
# )
11+
r <- callr::r_session$new(
12+
callr::r_session_options(
13+
system_profile = TRUE, user_profile = TRUE, supervise = TRUE),
14+
wait = TRUE
15+
)
1616

17-
# r$run(function() {
18-
# requireNamespace("jsonlite")
19-
# requireNamespace("svglite")
17+
r$run(function() {
18+
requireNamespace("jsonlite")
19+
requireNamespace("svglite")
2020

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
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
2626

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-
# write_log("viewer: ", url)
37-
# viewer_file <<- url
38-
# },
39-
# page_viewer = function(url, ...) {
40-
# write_log("page_viewer: ", url)
41-
# viewer_file <<- url
42-
# },
43-
# browser = function(url, ...) {
44-
# write_log("browser: ", url)
45-
# browser_url <<- url
46-
# }
47-
# )
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+
write_log("viewer: ", url)
37+
viewer_file <<- url
38+
},
39+
page_viewer = function(url, ...) {
40+
write_log("page_viewer: ", url)
41+
viewer_file <<- url
42+
},
43+
browser = function(url, ...) {
44+
write_log("browser: ", url)
45+
browser_url <<- url
46+
}
47+
)
4848

49-
# check_null_dev <- function() {
50-
# identical(dev.cur(), null_dev_id) &&
51-
# identical(dev.size(), null_dev_size)
52-
# }
49+
check_null_dev <- function() {
50+
identical(dev.cur(), null_dev_id) &&
51+
identical(dev.size(), null_dev_size)
52+
}
5353

54-
# evaluate <- function(expr) {
55-
# tryCatch({
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-
# res <- list(
65-
# type = "plot",
66-
# result = plot_file
67-
# )
68-
# } else if (!is.null(viewer_file)) {
69-
# res <- list(
70-
# type = "viewer",
71-
# result = viewer_file
72-
# )
73-
# } else if (!is.null(browser_url)) {
74-
# res <- list(
75-
# type = "browser",
76-
# result = browser_url
77-
# )
78-
# } else if (out$visible) {
79-
# res <- list(
80-
# type = "text",
81-
# result = paste0(text, collapse = "\n")
82-
# )
83-
# } else {
84-
# res <- list(
85-
# type = "text",
86-
# result = ""
87-
# )
88-
# }
89-
# })
54+
evaluate <- function(id, uri, expr) {
55+
tryCatch({
56+
expr <- parse(text = expr)
57+
out <- withVisible(eval(expr, globalenv()))
58+
text <- utils::capture.output(print(out$value, view = TRUE))
59+
if (check_null_dev()) {
60+
record <- recordPlot()
61+
plot_file <- tempfile(fileext = ".svg")
62+
svglite::svglite(plot_file, width = 12, height = 8)
63+
replayPlot(record)
64+
graphics.off()
65+
res <- list(
66+
type = "plot",
67+
result = plot_file
68+
)
69+
} else if (!is.null(viewer_file)) {
70+
res <- list(
71+
type = "viewer",
72+
result = viewer_file
73+
)
74+
} else if (!is.null(browser_url)) {
75+
res <- list(
76+
type = "browser",
77+
result = browser_url
78+
)
79+
} else if (out$visible) {
80+
res <- list(
81+
type = "text",
82+
result = paste0(text, collapse = "\n")
83+
)
84+
} else {
85+
res <- list(
86+
type = "text",
87+
result = ""
88+
)
89+
}
90+
}, error = function(e) {
91+
res <- list(
92+
type = "error",
93+
result = conditionMessage(e)
94+
)
95+
})
9096

91-
# res
92-
# }
97+
c(id = id, uri = uri, res)
98+
}
9399

94-
# environment()
95-
# })
100+
environment()
101+
})
96102

97-
# attach(environment(), name = "tools:vscNotebook")
98-
# NULL
99-
# })
103+
attach(environment(), name = "tools:vscNotebook")
104+
NULL
105+
})
100106

101107
con <- socketConnection(host = "127.0.0.1", port = env$port, open = "r+b")
102108

103-
request_id <- 0L
104109
while (TRUE) {
110+
response <- NULL
105111
if (socketSelect(list(con), timeout = 0)) {
106112
header <- readLines(con, 1, encoding = "UTF-8")
107113
n <- as.integer(gsub("^Content-Length\\: (\\d+)$", "\\1", header))
108114
content <- readChar(con, n, useBytes = TRUE)
109115
Encoding(content) <- "UTF-8"
110-
cat("request ", request_id, ": ", content, "\n", sep = "")
111-
request_id <- request_id + 1L
116+
cat(content, "\n", sep = "")
117+
118+
request <- jsonlite::fromJSON(content, simplifyVector = FALSE)
119+
response <- tryCatch({
120+
r$call(function(id, uri, expr) {
121+
.vscNotebook$evaluate(id, uri, expr)
122+
}, request)
123+
NULL
124+
}, error = function(e) {
125+
list(
126+
id = request$id,
127+
uri = request$uri,
128+
type = "error",
129+
result = conditionMessage(e)
130+
)
131+
})
112132
}
113-
Sys.sleep(0.1)
114-
}
115133

116-
# while (TRUE) {
117-
# write_log("Listening on port: ", env$port)
118-
# con <- try(socketConnection(host = "127.0.0.1", port = env$port,
119-
# blocking = TRUE, server = TRUE,
120-
# open = "r+"), silent = TRUE)
121-
# if (inherits(con, "try-error")) {
122-
# message(con)
123-
# } else {
124-
# tryCatch({
125-
# line <- readLines(con, n = 1)
126-
# write_log(line)
127-
# request <- jsonlite::fromJSON(line)
134+
result <- r$read()
135+
if (!is.null(result)) {
136+
if (is.list(result$result)) {
137+
response <- result$result
138+
} else if (!is.null(result$error)) {
139+
message(result$error)
140+
}
141+
}
128142

129-
# str <- tryCatch({
130-
# expr <- parse(text = request$expr)
131-
# }, error = function(e) {
132-
# list(
133-
# type = "error",
134-
# result = conditionMessage(e)
135-
# )
136-
# }
137-
# )
138-
# response <- jsonlite::toJSON(str, auto_unbox = TRUE, force = TRUE)
139-
# writeLines(response, con)
140-
# }, error = function(e) {
141-
# message(e)
142-
# }, finally = close(con))
143-
# }
144-
# }
143+
if (!is.null(response)) {
144+
response <- jsonlite::toJSON(result$result,
145+
auto_unbox = TRUE, force = TRUE)
146+
writeLines(response, con)
147+
}
148+
Sys.sleep(0.1)
149+
}

0 commit comments

Comments
 (0)