beatrina 0.8.6 → 0.8.7

package/kernel/latex.R

@@ -603,7 +603,308 @@ latex_citation_problems <- function(tex_lines, bib_lines, engine, fetch = FALSE)
 
 # ── the rapid preview ──────────────────────────────────────────────────────
 #
-# The live preview (a .tex through pandoc to HTML while you type) is answered by
-# the supervisor, host/planes/latex.mjs. It lived here while the R supervisor
-# did; it was retired with serve.R (docs/host-plan.md §13), and nothing in this
-# file's compile half used it.
+# A .tex through pandoc to HTML, fast enough to keep up with typing. This is
+# the "live rich preview" of the retired prototype (spike/latex-editor.html +
+# spike/latex-workbench.mjs, harvested and deleted 2026-09-06), which was
+# scoped here as WP5 in docs/latex-plan.md and cut for byte budget before it
+# was built. The argv is the prototype's, unchanged, because it was already
+# right; what is new is where it runs and what it is allowed to touch.
+#
+# IT IS NOT A COMPILE, and every difference follows from that. A compile is a
+# JOB — detached, streamed, minutes long, and it produces the artefact you
+# publish. This answers one request in under a second and produces something
+# to look at while you write. So it is answered in the supervisor beside
+# `cite` rather than spawned as a job child: a job that outlives the keystroke
+# that asked for it is exactly what must not happen here.
+#
+# WHAT IT MAY READ is the root's own directory and below, and nothing else.
+# TeX itself reads relative to the document, so that bound is the document's
+# own, not an invention — and it is checked after canonicalisation, because a
+# string-prefix test on an unresolved path is how confinement bugs happen
+# (spike/worker.R within_root says the same thing about the same mistake).
+
+LATEX_PREVIEW_TIMEOUT_MS <- 8000L
+LATEX_PREVIEW_MAX_SOURCE <- 2e6      # the .tex the page sends
+LATEX_PREVIEW_MAX_HTML <- 6e6        # what pandoc may print back
+LATEX_PREVIEW_MAX_IMAGE <- 1.5e6     # one figure, before base64
+LATEX_PREVIEW_MAX_ASSETS <- 8e6      # every figure together
+LATEX_PREVIEW_MAX_FILES <- 40L       # buffers, and includes followed
+LATEX_PREVIEW_DEPTH <- 6L
+
+# What an <img> can actually show. A .pdf or .eps figure is normal in a real
+# paper and cannot be inlined, so it is REPORTED rather than dropped — the
+# pane says "3 figures are only in the PDF", which is true and actionable,
+# where a blank space says nothing.
+LATEX_PREVIEW_IMAGE_TYPES <- c(png = "image/png", jpg = "image/jpeg",
+                               jpeg = "image/jpeg", gif = "image/gif",
+                               svg = "image/svg+xml", webp = "image/webp")
+
+#' Is `path` inside `dir`, after both are canonicalised?
+#'
+#' The trailing separator is load-bearing: without it, /p/figs would also
+#' admit /p/figs-private. Mirrors plugin_contained() in spike/plugins.R.
+#' @param dir Directory that bounds the read.
+#' @param path Candidate file.
+#' @return The resolved path, or "" when it is outside or absent.
+latex_within <- function(dir, path) {
+  if (!latex_scalar(dir) || !latex_scalar(path) || !dir.exists(dir)) return("")
+  root <- normalizePath(dir, winslash = "/", mustWork = TRUE)
+  full <- if (grepl("^([A-Za-z]:)?[/\\\\]", path)) path else file.path(root, path)
+  if (!file.exists(full)) return("")
+  full <- normalizePath(full, winslash = "/", mustWork = TRUE)
+  if (!identical(full, root) && !startsWith(full, paste0(root, "/"))) return("")
+  full
+}
+
+#' Pull `\input`/`\include`/`\subfile` bodies into one source, so the preview
+#' shows the whole paper rather than its first chapter.
+#'
+#' Buffers the page sent win over the disk copy, because the point of a live
+#' preview is UNSAVED text. Bounded by depth and by file count, and a file
+#' already on the stack is skipped rather than followed — an include cycle is
+#' a document someone is halfway through writing, not an attack, and it must
+#' cost a stack frame instead of the session.
+#' @param source The root's text.
+#' @param dir Directory the root lives in.
+#' @param buffers Named list of relative path -> text, from open editors.
+#' @param seen Paths already on this branch.
+#' @param depth Remaining depth.
+#' @return One string.
+latex_preview_expand <- function(source, dir, buffers = list(), seen = character(0), depth = LATEX_PREVIEW_DEPTH) {
+  if (depth <= 0L) return(source)
+  pattern <- "\\\\(?:input|include|subfile)\\{([^{}]{1,200})\\}"
+  m <- gregexpr(pattern, source, perl = TRUE)[[1L]]
+  if (identical(as.integer(m[1L]), -1L)) return(source)
+  starts <- as.integer(m)
+  lens <- attr(m, "match.length")
+  out <- character(0)
+  at <- 1L
+  for (i in seq_along(starts)) {                    # one splice per include
+    whole <- substr(source, starts[i], starts[i] + lens[i] - 1L)
+    rel <- sub(pattern, "\\1", whole, perl = TRUE)
+    if (!grepl("\\.[A-Za-z0-9]{1,5}$", rel)) rel <- paste0(rel, ".tex")
+    body <- NULL
+    if (!rel %in% seen && length(seen) < LATEX_PREVIEW_MAX_FILES) {
+      if (!is.null(buffers[[rel]])) body <- buffers[[rel]]
+      else {
+        hit <- latex_within(dir, rel)
+        if (nzchar(hit) && file.info(hit)$size <= LATEX_PREVIEW_MAX_SOURCE) {
+          body <- tryCatch(paste(readLines(hit, warn = FALSE), collapse = "\n"),
+                           error = function(e) NULL)
+        }
+      }
+    }
+    out <- c(out, substr(source, at, starts[i] - 1L),
+             if (is.null(body)) "" else
+               latex_preview_expand(body, dir, buffers, c(seen, rel), depth - 1L))
+    at <- starts[i] + lens[i]
+  }
+  paste0(paste(out, collapse = ""), substr(source, at, nchar(source)))
+}
+
+#' The .bib files a source names, resolved and bounded.
+#' @param source Expanded LaTeX.
+#' @param dir Directory that bounds the read.
+#' @return Character vector of absolute paths, possibly empty.
+latex_preview_bibliography <- function(source, dir) {
+  m <- regmatches(source, gregexpr("\\\\(?:bibliography|addbibresource)(?:\\[[^]]*\\])?\\{([^{}]{1,300})\\}",
+                                   source, perl = TRUE))[[1L]]
+  if (!length(m)) return(character(0))
+  named <- unlist(lapply(m, function(one) {
+    inner <- sub(".*\\{([^{}]*)\\}$", "\\1", one)
+    trimws(strsplit(inner, ",", fixed = TRUE)[[1L]])
+  }), use.names = FALSE)
+  named <- named[nzchar(named)]
+  named <- ifelse(grepl("\\.[A-Za-z0-9]{1,5}$", named), named, paste0(named, ".bib"))
+  found <- vapply(unique(named), function(one) latex_within(dir, one), character(1))
+  unname(found[nzchar(found)])
+}
+
+#' Turn every local `<img src>` into a data: URI.
+#'
+#' The kernel does this itself, over the HTML IT just produced, so no image
+#' path ever travels on the wire in either direction — the same rule `job_open`
+#' follows when it names a job rather than a file. `readfile` could not have
+#' served here at all: it decodes bytes as UTF-8 or Latin-1 (spike/worker.R
+#' text_from_bytes), so a PNG through it is not a PNG.
+#' @param html pandoc's output.
+#' @param dir Directory that bounds the read.
+#' @return list(html, inlined, dropped) — dropped names what could not be shown.
+latex_preview_inline <- function(html, dir) {
+  hits <- gregexpr('src="([^"]{1,400})"', html, perl = TRUE)[[1L]]
+  if (identical(as.integer(hits[1L]), -1L)) return(list(html = html, inlined = 0L, dropped = character(0)))
+  starts <- as.integer(hits)
+  lens <- attr(hits, "match.length")
+  out <- character(0)
+  at <- 1L
+  inlined <- 0L
+  budget <- LATEX_PREVIEW_MAX_ASSETS
+  dropped <- character(0)
+  for (i in seq_along(starts)) {                    # one rewrite per image
+    whole <- substr(html, starts[i], starts[i] + lens[i] - 1L)
+    src <- sub('^src="(.*)"$', "\\1", whole)
+    replacement <- whole
+    if (!grepl("^(?:data:|https?:|//)", src, perl = TRUE)) {
+      ext <- tolower(sub(".*\\.([A-Za-z0-9]+)$", "\\1", src))
+      mime <- unname(LATEX_PREVIEW_IMAGE_TYPES[ext])
+      # A figure named without its extension is what \includegraphics{fig}
+      # writes, and TeX picks the file. Try the types an <img> can show, in
+      # the order a person would expect them to win.
+      candidates <- if (identical(src, ext) || is.na(mime))
+        paste0(sub("\\.[A-Za-z0-9]+$", "", src), ".", names(LATEX_PREVIEW_IMAGE_TYPES)) else src
+      hit <- ""
+      for (cand in candidates) {                    # first existing wins
+        hit <- latex_within(dir, cand)
+        if (nzchar(hit)) { mime <- unname(LATEX_PREVIEW_IMAGE_TYPES[tolower(sub(".*\\.([A-Za-z0-9]+)$", "\\1", cand))]); break }
+      }
+      if (!nzchar(hit) || is.na(mime)) dropped <- c(dropped, basename(src))
+      else {
+        size <- file.info(hit)$size
+        if (!is.finite(size) || size > LATEX_PREVIEW_MAX_IMAGE || size > budget) {
+          dropped <- c(dropped, basename(src))
+        } else {
+          bytes <- tryCatch(readBin(hit, "raw", n = size), error = function(e) NULL)
+          if (is.null(bytes)) dropped <- c(dropped, basename(src))
+          else {
+            budget <- budget - size
+            inlined <- inlined + 1L
+            replacement <- paste0('src="data:', mime, ';base64,', jsonlite::base64_enc(bytes), '"')
+          }
+        }
+      }
+    }
+    out <- c(out, substr(html, at, starts[i] - 1L), replacement)
+    at <- starts[i] + lens[i]
+  }
+  list(html = paste0(paste(out, collapse = ""), substr(html, at, nchar(html))),
+       inlined = inlined, dropped = unique(dropped))
+}
+
+#' Highlighted code blocks as plain verbatim, for the PREVIEW only.
+#'
+#' The LaTeX export writes R chunks as fancyvrb `Highlighting` blocks
+#' (lib/md/latex.js `highlighted`) — correct for a TeX engine, but pandoc's
+#' LaTeX reader does not know `\DefineVerbatimEnvironment{Highlighting}` is
+#' verbatim and renders each block as an EMPTY div, so the preview showed a
+#' document with its code missing while the PDF was right (found by the
+#' Beatrix fork, 2026-09-15). Each block is rewritten to `\begin{verbatim}`
+#' with the token macros dropped and lib/md/latex.js CODE_CH undone. The file
+#' on disk and the compile are untouched.
+#'
+#' Escapes become sentinels BEFORE the macro braces are stripped, so a literal
+#' `{` in the code survives. A code line holding `\end{verbatim}` would close
+#' the environment early; it gains a zero-width space after the backslash,
+#' invisible in the preview.
+#'
+#' @param source LaTeX text.
+#' @return The text with every Shaded/Highlighting block replaced.
+latex_preview_code <- function(source) {
+  pattern <- paste0("(?s)(?:\\\\begin\\{Shaded\\}[ \\t]*\\n?)?",
+                    "\\\\begin\\{Highlighting\\}(?:\\[[^]\\n]*\\])?\\n?(.*?)\\n?",
+                    "\\\\end\\{Highlighting\\}(?:[ \\t]*\\n?\\\\end\\{Shaded\\})?")
+  hits <- gregexpr(pattern, source, perl = TRUE)[[1L]]
+  if (identical(as.integer(hits[1L]), -1L)) return(source)
+  blocks <- regmatches(source, list(hits))[[1L]]
+  # Order matters only for \textbackslash{}, whose braces must not be read as
+  # a {-} or stripped first; every other entry is a distinct sequence.
+  swaps <- c("\\textbackslash{}" = "\001", "\\textasciitilde{}" = "~", "\\^{}" = "^",
+             "\\textless{}" = "<", "\\textgreater{}" = ">", "{-}" = "-",
+             "\\{" = "\002", "\\}" = "\003", "\\#" = "#", "\\%" = "%",
+             "\\_" = "_", "\\&" = "&")
+  plain <- vapply(blocks, function(block) {
+    body <- sub(pattern, "\\1", block, perl = TRUE)
+    body <- Reduce(function(text, from) gsub(from, swaps[[from]], text, fixed = TRUE),
+                   names(swaps), body)
+    body <- gsub("\\\\[A-Za-z]+Tok\\{", "", body, perl = TRUE)
+    body <- gsub("[{}]", "", body, perl = TRUE)
+    body <- chartr("\001\002\003", "\\{}", body)
+    body <- gsub("\\end{verbatim}", "\\\u200bend{verbatim}", body, fixed = TRUE)
+    paste0("\\begin{verbatim}\n", body, "\n\\end{verbatim}")
+  }, character(1), USE.NAMES = FALSE)
+  regmatches(source, list(hits)) <- list(plain)
+  source
+}
+
+#' Render one LaTeX source to HTML for the preview pane.
+#'
+#' @param source The root's text, as the editor holds it.
+#' @param path Absolute path of the root, for resolving its neighbours.
+#' @param buffers Optional named list of relative path -> unsaved text.
+#' @param timeout_ms Deadline.
+#' @return list(ok, html, warnings, elapsed_ms, inlined, dropped) or
+#'   list(ok = FALSE, error).
+latex_preview <- function(source, path, buffers = list(), timeout_ms = LATEX_PREVIEW_TIMEOUT_MS) {
+  if (!latex_scalar(source)) return(list(ok = FALSE, error = "No LaTeX source to preview."))
+  if (nchar(source, type = "bytes") > LATEX_PREVIEW_MAX_SOURCE) {
+    return(list(ok = FALSE, error = "This document is too large to preview while you type."))
+  }
+  bin <- find_pandoc()
+  if (!nzchar(bin)) {
+    return(list(ok = FALSE, error = "pandoc is not installed, or CarmaR could not find it. Compile still works; only the live preview needs pandoc."))
+  }
+  dir <- if (latex_scalar(path) && file.exists(path)) dirname(normalizePath(path, winslash = "/", mustWork = TRUE)) else ""
+  keep <- list()
+  if (is.list(buffers)) {
+    names_ok <- names(buffers) %||% character(0)
+    for (nm in utils::head(names_ok[nzchar(names_ok)], LATEX_PREVIEW_MAX_FILES)) {
+      if (latex_scalar(buffers[[nm]])) keep[[nm]] <- buffers[[nm]]
+    }
+  }
+  expanded <- if (nzchar(dir)) latex_preview_expand(source, dir, keep) else source
+  expanded <- latex_preview_code(expanded)
+  started <- Sys.time()
+  args <- c("--from=latex", "--to=html5", "--mathml", "--wrap=none",
+            "--standalone", "--sandbox")
+  if (nzchar(dir)) {
+    for (bib in latex_preview_bibliography(expanded, dir)) {
+      args <- c(args, "--citeproc", paste0("--bibliography=", bib))
+    }
+  }
+  # A FILE, not stdin: processx::run has no `input` argument (it takes a path
+  # for `stdin`), and cite_run already writes its document to a 0600 temp file
+  # for the same reason. pandoc emits the figure paths unchanged either way —
+  # this function resolves them itself, against the ROOT's directory rather
+  # than the scratch one, which is what makes the temp file harmless here.
+  input <- tempfile("carmar-preview-", fileext = ".tex")
+  on.exit(unlink(input), add = TRUE)
+  writeLines(expanded, input, useBytes = TRUE)
+  Sys.chmod(input, "0600")
+  ran <- tryCatch(processx::run(
+    bin, c(args, input), timeout = timeout_ms / 1000, error_on_status = FALSE,
+    echo = FALSE, cleanup_tree = TRUE,
+    # HOME and the data dir moved aside for the same reason cite_run moves
+    # them: a render must not read or write this user's pandoc configuration.
+    env = c("current", PANDOC_DATA_DIR = tempdir(), HOME = tempdir())
+  ), error = function(e) e)
+  if (inherits(ran, "error")) {
+    msg <- conditionMessage(ran)
+    return(list(ok = FALSE, error = if (grepl("timeout", msg, ignore.case = TRUE))
+      "The preview took too long and was stopped." else paste0("preview: ", msg)))
+  }
+  if (isTRUE(ran$timeout)) return(list(ok = FALSE, error = "The preview took too long and was stopped."))
+  if (!identical(as.integer(ran$status), 0L)) {
+    first <- strsplit(ran$stderr %||% "", "\n", fixed = TRUE)[[1L]][1L] %||% ""
+    # pandoc names the file it was reading, and that file is our scratch copy.
+    # Printing "/var/folders/.../carmar-preview-8b42.tex (line 2, column 2)"
+    # at a person tells them nothing and looks like a fault in CarmaR; the
+    # line and column are the useful half, so the path becomes the document's
+    # own name. An unclosed group is the ORDINARY state of a document being
+    # typed, which is why this path is a reported note and not a failure —
+    # lib/latex-preview.js keeps the last good render behind it.
+    shown <- if (latex_scalar(path) && nzchar(path)) basename(path) else "the document"
+    first <- gsub(input, shown, first, fixed = TRUE)
+    return(list(ok = FALSE, partial = TRUE,
+                error = paste0("pandoc could not read this document",
+                               if (nzchar(first)) paste0(": ", first) else ".")))
+  }
+  html <- ran$stdout %||% ""
+  if (nchar(html, type = "bytes") > LATEX_PREVIEW_MAX_HTML) {
+    return(list(ok = FALSE, error = "The rendered preview is too large to show."))
+  }
+  figures <- if (nzchar(dir)) latex_preview_inline(html, dir)
+             else list(html = html, inlined = 0L, dropped = character(0))
+  list(ok = TRUE, html = figures$html,
+       warnings = trimws(ran$stderr %||% ""),
+       elapsed_ms = as.numeric(difftime(Sys.time(), started, units = "secs")) * 1000,
+       inlined = figures$inlined, dropped = figures$dropped)
+}

package/kernel/worker.R

@@ -120,7 +120,7 @@ import_sources <- local({
   else if (length(file_arg)) {
     dirname(normalizePath(sub("^--file=", "", file_arg[1L]), mustWork = FALSE))
   } else getwd()
-  file.path(here, c("fileio.R", "sniff.R", "project.R"))
+  file.path(here, c("fileio.R", "sniff.R", "project.R", "workspace-keep.R"))
 })
 # environment(), not parent.frame(): inside a nested local() the parent frame
 # is the eval machinery's, not this file's private scope, and the functions
@@ -471,6 +471,29 @@ if (!(INPUT_SHADOW %in% search())) {
          name = INPUT_SHADOW, warn.conflicts = FALSE)
 }
 
+#' Never ask "Hit <Return> to see next plot".
+#'
+#' This worker is interactive, so a plot that turns page prompting on —
+#' tna's plot() for cliques does `par(ask = TRUE)` by default — makes the
+#' graphics engine read the console before each new page. That read is not
+#' readline(), so nothing announces it: the chunk spun forever and every
+#' chunk behind it queued (test/lab-rmd.e2e, the lab's `plot(cliques_of_two,
+#' 4)`). Every page is captured as its own figure here, so there is no page to
+#' wait for. The hooks run before the engine's check on every new page, base
+#' graphics and grid alike; a package's own `par(ask = TRUE)` is left in place
+#' and simply never gets to ask.
+#'
+#' @return Invisibly NULL.
+carmar_no_page_prompt <- function() {
+  if (isTRUE(grDevices::devAskNewPage())) grDevices::devAskNewPage(FALSE)
+  invisible(NULL)
+}
+local({
+  already <- function(hook) any(vapply(getHook(hook), identical, logical(1), carmar_no_page_prompt))
+  if (!already("before.plot.new")) setHook("before.plot.new", carmar_no_page_prompt)
+  if (!already("before.grid.newpage")) setHook("before.grid.newpage", carmar_no_page_prompt)
+})
+
 #' A function's formals as one display string, defaults included.
 #'
 #' `formals()` is NULL for primitives like `sum`; `args()` still knows their
@@ -1110,6 +1133,57 @@ completion_columns <- function(data, max_items = MAX_COMPLETIONS) {
   lapply(cols, function(nm) list(value = nm, type = class(df[[nm]])[1L]))
 }
 
+#' A progress callback for keep_save()/keep_resume() that emits id-less
+#' `keep_progress` frames — the supervisor broadcasts an id-less frame to every
+#' page, which is what lets the page that asked AND a page that follows a
+#' handoff both draw it. Throttled to four a second; the last one always goes.
+#' @param phase "save" or "restore".
+#' @return function(done, total, bytes, name).
+keep_progress_emitter <- function(phase) {
+  last <- 0
+  function(done, total, bytes = 0, name = "") {
+    now <- as.numeric(Sys.time())
+    if (done < total && now - last < 0.25) return(invisible(NULL))
+    last <<- now
+    emit(list(type = "keep_progress", phase = phase, done = done, total = total,
+              bytes = as.numeric(bytes %||% 0), name = as.character(name)[1L]))
+  }
+}
+
+#' "Restart, keep variables", step one: save the global environment
+#' (spike/workspace-keep.R). No deadline — Stop (the supervisor's
+#' suspend_cancel) interrupts it, and the partial copy is removed.
+#' @param id Request id.
+#' @return Invisibly NULL. Emits one `suspend` frame: token, saved, bytes,
+#'   skipped — or cancelled, or error.
+emit_suspend <- function(id) {
+  out <- tryCatch(keep_save(globalenv(), progress = keep_progress_emitter("save")),
+                  error = function(e) list(error = conditionMessage(e)),
+                  interrupt = function(i) list(cancelled = TRUE))
+  emit(c(list(type = "suspend", id = id), out))
+}
+
+#' "Restart, keep variables", step two, in the NEW worker: load the kept
+#' objects back and restore the working directory. Asked by the supervisor
+#' only, never by a page (it is not in FORWARDED), with a token the save minted.
+#' @param id Request id.
+#' @param token The kept workspace's token.
+#' @return Invisibly NULL. Emits one `resume` frame: restored, failed, skipped,
+#'   cwd — or error.
+emit_resume <- function(id, token) {
+  out <- tryCatch(keep_resume(token, globalenv(), progress = keep_progress_emitter("restore")),
+                  error = function(e) list(error = conditionMessage(e)),
+                  interrupt = function(i) list(error = "The restore was interrupted."))
+  # The directory R was in comes back too — unless it is gone (the old R's
+  # tempdir() dies with the old R), which the report then says in words.
+  if (is.character(out$wd) && nzchar(out$wd)) {
+    moved <- dir.exists(out$wd) && !inherits(try(setwd(out$wd), silent = TRUE), "try-error")
+    if (!moved) out$wd_missing <- out$wd
+  }
+  out$wd <- NULL
+  emit(c(list(type = "resume", id = id, cwd = getwd()), out))
+}
+
 #' Coerce a wire-supplied count, falling back rather than erroring: a malformed
 #' offset from a client must degrade to the default, not kill the pane.
 #'
@@ -3308,13 +3382,13 @@ if (identical(unname(Sys.info()[["sysname"]]), "Darwin") &&
 # Advertising the vocabulary lets a client know instantly. Kernels older than
 # this simply omit the field, and clients fall back to probing.
 #
-# A fresh worker is a fresh R, always. Until 7.59 a "Restart into" handoff
-# asked this worker to `save.image()` and the successor's first worker loaded
-# it back (`workspace_save` / CARMAR_RESTORE_WORKSPACE / a `restored` field
-# here). That is gone by decision — the owner's "restore work has been
-# abysmally bad and almost invariably a failure" — and the rule is: a session
-# is a process you can see; open → R starts, close → R stops, restart → a
-# fresh R. The saved document is the record. Do not add a restore path back.
+# A worker starts as a fresh R. Until 7.59 a "Restart into" handoff asked this
+# worker to `save.image()` and the successor loaded one file back inside a
+# deadline; that failed on large sessions and was removed ("restore work has
+# been abysmally bad"). Since 0.8.5 "Restart, keep variables" is an explicit
+# choice built differently (spike/workspace-keep.R): the page asks `suspend`
+# with no deadline, the new worker is asked `resume` by the supervisor after
+# `ready`, one file per object, and the report names what did not come back.
 emit(list(type = "ready", pid = Sys.getpid(), r = R.version.string, cwd = getwd(),
           # I(): a single library path must still ship as an array.
           home = R.home(), libs = I(.libPaths()),
@@ -3329,7 +3403,7 @@ emit(list(type = "ready", pid = Sys.getpid(), r = R.version.string, cwd = getwd(
                          "help", "hover", "wd", "files", "sniff",
                          "import", "readfile", "writefile", "writefiles_atomic", "view", "colstats",
                          "mkdir", "renamepath", "deletepath", "copypath", "revealpath",
-                         "rm",
+                         "rm", "suspend",
                          if (identical(WORKER_MODE, "interactive")) "debug_breaks"))))
 # (No package count here on purpose: installed.packages() reads every
 # package's DESCRIPTION — 0.3–1.8 s on a big library — and no client ever
@@ -3379,6 +3453,8 @@ carmar_dispatch <- function(cmd) {
   if (identical(cmd$type, "doctor"))   emit_doctor(cmd$id)
   if (identical(cmd$type, "complete")) emit_complete(cmd$id, cmd$line, cmd$cursor,
                                                      fn = cmd$fn, data = cmd$data)
+  if (identical(cmd$type, "suspend"))  emit_suspend(cmd$id)
+  if (identical(cmd$type, "resume"))   emit_resume(cmd$id, cmd$token)
   if (identical(cmd$type, "packages")) emit_packages(cmd$id, cmd$scope)
   if (identical(cmd$type, "package_action")) emit_package_action(cmd$id, cmd$action, cmd$name, cmd$lib)
   if (identical(cmd$type, "package_help")) emit_package_help(cmd$id, cmd$name)

package/kernel/workspace-keep.R

@@ -0,0 +1,188 @@
+# workspace-keep.R — "Restart, keep variables": the global environment carried
+# across a restart, the way RStudio carries it.
+#
+# Sourced into the WORKER's private scope (worker.R's import_sources), and
+# testable without a worker: spike/test-workspace-keep.R sources this file
+# alone.
+#
+# This replaces a removed design, and the difference is the point. Until 7.59
+# a restart ran save.image() inside a handoff with a deadline and load()ed one
+# file back; large sessions missed the deadline, one unreadable object sank the
+# whole file, and nothing said what was lost. The owner removed it ("restore
+# work has been abysmally bad"). What is here instead:
+#
+#   * NO DEADLINE. The save is a worker command like any other: progress frames
+#     while it runs, Interrupt (Stop) cancels it, and the restart only happens
+#     once the save has answered.
+#   * ONE FILE PER OBJECT. An object that fails to save or to load is that
+#     object, named in the report — never the whole workspace.
+#   * PACKAGES ARE NOT RECORDED. A notebook's library() calls live in its setup
+#     chunk, and the page runs setup before the first chunk of a fresh R
+#     (lib/document-execution.js) — RStudio's own answer, and the reason this
+#     file keeps variables only.
+#   * WHAT CANNOT TRAVEL IS SAID. A connection or an external pointer
+#     serialises to a dead handle; it is skipped at save time and listed.
+#
+# Known limit, stated rather than hidden: objects are saved separately, so two
+# objects that SHARE an environment (R6 objects pointing at one another) come
+# back as copies that no longer share it.
+#
+# The token names a directory under the keep root and is the only thing that
+# travels: the page and the supervisor never pass a path, so a resume can only
+# ever read a directory this code wrote.
+
+#' Where kept workspaces live: 0700, per user. `CARMAR_KEEP_DIR` relocates it
+#' for tests.
+#' @return A directory path (not created).
+keep_root <- function() {
+  env <- Sys.getenv("CARMAR_KEEP_DIR", "")
+  if (nzchar(env)) env else file.path(tools::R_user_dir("carmar", "data"), "kept-workspace")
+}
+
+KEEP_TOKEN_RE <- "^[0-9]{14}-[0-9a-f]{16}$"
+
+#' Is `x` a token this file could have minted?
+#' @param x Anything the wire delivered.
+#' @return TRUE for one well-formed token.
+keep_token_ok <- function(x) {
+  is.character(x) && length(x) == 1L && !is.na(x) && grepl(KEEP_TOKEN_RE, x)
+}
+
+#' A fresh token: a timestamp (sorts, and ages out) plus 64 random bits.
+#' @return A token matching KEEP_TOKEN_RE.
+keep_token_new <- function() {
+  bytes <- tryCatch({
+    con <- file("/dev/urandom", "rb", raw = TRUE)
+    on.exit(close(con), add = TRUE)
+    readBin(con, "raw", n = 8L)
+  }, error = function(e) as.raw(sample.int(256L, 8L, replace = TRUE) - 1L))
+  paste0(format(Sys.time(), "%Y%m%d%H%M%S"), "-", paste(format(bytes), collapse = ""))
+}
+
+#' Why an object cannot travel, or NULL when it can.
+#'
+#' A connection is an integer index into THIS process's connection table, and
+#' an external pointer is an address in this process's memory: both serialise
+#' without complaint and come back as something that looks right and is dead.
+#' @param x The object.
+#' @return NULL, or a short phrase for the report.
+keep_unsaveable <- function(x) {
+  if (inherits(x, "connection")) return("a connection (a file or URL handle)")
+  if (inherits(x, "DBIConnection")) return("a database connection")
+  if (typeof(x) == "externalptr") return("an external pointer")
+  NULL
+}
+
+#' Delete kept workspaces older than `max_age_s` — a restart that never
+#' resumed (a crash, a closed laptop) must not keep a copy of someone's data
+#' forever.
+#' @param root The keep root.
+#' @param max_age_s Age in seconds.
+#' @return Invisibly, the tokens removed.
+keep_prune <- function(root = keep_root(), max_age_s = 86400) {
+  if (!dir.exists(root)) return(invisible(character(0)))
+  tokens <- Filter(keep_token_ok, list.files(root))
+  old <- Filter(function(t) {
+    age <- as.numeric(difftime(Sys.time(), file.info(file.path(root, t))$mtime, units = "secs"))
+    isTRUE(age > max_age_s)
+  }, tokens)
+  invisible(vapply(old, function(t) { unlink(file.path(root, t), recursive = TRUE); t }, character(1)))
+}
+
+#' Save every object of `env` into a new kept workspace.
+#'
+#' @param env The environment to keep (the worker passes globalenv()).
+#' @param progress function(done, total, bytes, name) called after each object.
+#' @param root The keep root.
+#' @return list(token, saved, bytes, skipped = list of {name, why}).
+#'   An interrupt removes the partial directory and propagates, so the caller
+#'   reports "cancelled" and nothing half-written is ever resumed.
+keep_save <- function(env = globalenv(), progress = function(...) NULL, root = keep_root()) {
+  stopifnot("`env` must be an environment" = is.environment(env))
+  dir.create(root, recursive = TRUE, showWarnings = FALSE, mode = "0700")
+  Sys.chmod(root, mode = "0700")
+  keep_prune(root)
+  token <- keep_token_new()
+  dir <- file.path(root, token)
+  dir.create(dir, mode = "0700")
+  names_ <- sort(ls(env, all.names = TRUE))
+  total <- length(names_)
+  bytes <- 0
+  done <- FALSE
+  on.exit(if (!done) unlink(dir, recursive = TRUE), add = TRUE)
+  # Objects are indexed, never named, on disk: an object name may hold any
+  # character, and a file name must not.
+  entries <- lapply(seq_along(names_), function(i) {
+    name <- names_[[i]]
+    value <- get(name, envir = env, inherits = FALSE)
+    why <- keep_unsaveable(value)
+    entry <- if (!is.null(why)) list(name = name, status = "skipped", why = why)
+    else {
+      file <- sprintf("%06d.rds", i)
+      failed <- tryCatch({ saveRDS(value, file.path(dir, file), compress = FALSE); NULL },
+                         error = function(e) conditionMessage(e))
+      if (is.null(failed)) {
+        bytes <<- bytes + file.size(file.path(dir, file))
+        list(name = name, status = "saved", file = file, class = class(value)[1L])
+      } else {
+        unlink(file.path(dir, file))
+        list(name = name, status = "skipped", why = paste("could not be saved:", failed))
+      }
+    }
+    progress(i, total, bytes, name)
+    entry
+  })
+  manifest <- list(version = 1L, created = format(Sys.time(), "%Y-%m-%dT%H:%M:%S"),
+                   wd = getwd(), entries = entries)
+  writeLines(jsonlite::toJSON(manifest, auto_unbox = TRUE), file.path(dir, "manifest.json"))
+  Sys.chmod(list.files(dir, full.names = TRUE), mode = "0600")
+  done <- TRUE
+  status <- vapply(entries, `[[`, "", "status")
+  list(token = token, saved = sum(status == "saved"), bytes = bytes,
+       skipped = lapply(entries[status == "skipped"], function(e) list(name = e$name, why = e$why)))
+}
+
+#' Load a kept workspace into `env`, then delete it.
+#'
+#' Each object is read on its own; one that fails is reported and the rest
+#' still arrive. The directory is removed afterwards whatever happened — a
+#' kept workspace is used once.
+#' @param token A token from keep_save().
+#' @param env Where the objects go (the worker passes globalenv()).
+#' @param progress function(done, total, bytes, name) called after each object
+#'   (the same shape keep_save() calls, so one callback serves both; bytes is 0).
+#' @param root The keep root.
+#' @return list(restored, failed = list of {name, why}, skipped = the save's
+#'   skips, carried so the one report says everything), or list(error).
+keep_resume <- function(token, env = globalenv(), progress = function(...) NULL, root = keep_root()) {
+  if (!keep_token_ok(token)) return(list(error = "That is not a kept workspace."))
+  dir <- file.path(root, token)
+  manifest_file <- file.path(dir, "manifest.json")
+  if (!file.exists(manifest_file)) {
+    return(list(error = "The kept workspace is gone — it was already restored or removed."))
+  }
+  on.exit(unlink(dir, recursive = TRUE), add = TRUE)
+  manifest <- tryCatch(jsonlite::fromJSON(manifest_file, simplifyVector = FALSE),
+                       error = function(e) NULL)
+  if (is.null(manifest) || !is.list(manifest$entries)) {
+    return(list(error = "The kept workspace's record could not be read."))
+  }
+  saved <- Filter(function(e) identical(e$status, "saved"), manifest$entries)
+  total <- length(saved)
+  outcomes <- lapply(seq_along(saved), function(i) {
+    e <- saved[[i]]
+    # The file name is re-checked, never trusted: only NNNNNN.rds inside dir.
+    why <- if (!is.character(e$file) || !grepl("^[0-9]{6}\\.rds$", e$file)) "its record is malformed"
+    else tryCatch({
+      assign(e$name, readRDS(file.path(dir, e$file)), envir = env)
+      NULL
+    }, error = function(err) conditionMessage(err))
+    progress(i, total, 0, e$name)
+    if (is.null(why)) NULL else list(name = e$name, why = paste("could not be restored:", why))
+  })
+  failed <- Filter(Negate(is.null), outcomes)
+  skipped <- lapply(Filter(function(e) identical(e$status, "skipped"), manifest$entries),
+                    function(e) list(name = e$name, why = e$why))
+  list(restored = total - length(failed), failed = failed, skipped = skipped,
+       wd = if (is.character(manifest$wd)) manifest$wd else "")
+}

package/package.json

@@ -1,6 +1,6 @@
 {
   "name": "beatrina",
-  "version": "0.8.6",
+  "version": "0.8.7",
   "description": "Beatrina is a modern, powerful, feature-rich integrated development environment (IDE) for R, Python, and JavaScript.",
   "type": "module",
   "bin": {
@@ -24,7 +24,7 @@
     "lib",
     "check",
     "build-info.json",
-    "carmar_V0.8.6.html",
+    "carmar_V0.8.7.html",
     "README.md",
     "LICENSE",
     "NOTICES"