1# 2# Api.R 3# 4# Copyright (C) 2021 by RStudio, PBC 5# 6# Unless you have received this program directly from RStudio pursuant 7# to the terms of a commercial license agreement with RStudio, then 8# this program is licensed to you under the terms of version 3 of the 9# GNU Affero General Public License. This program is distributed WITHOUT 10# ANY EXPRESS OR IMPLIED WARRANTY, INCLUDING THOSE OF NON-INFRINGEMENT, 11# MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. Please refer to the 12# AGPL (http://www.gnu.org/licenses/agpl-3.0.txt) for more details. 13# 14# 15 16# Create environment to store data for registerChunkCallback and unregisterChunkCallback 17.rs.setVar("notebookChunkCallbacks", new.env(parent = emptyenv())) 18 19# Create environment to store data for command callbacks 20.rs.setVar("commandCallbacks", new.env(parent = emptyenv())) 21 22# list of API events (keep in sync with RStudioApiRequestEvent.java) 23.rs.setVar("api.eventTypes", list( 24 TYPE_UNKNOWN = 0L, 25 TYPE_GET_EDITOR_SELECTION = 1L, 26 TYPE_SET_EDITOR_SELECTION = 2L, 27 TYPE_DOCUMENT_ID = 3L, 28 TYPE_DOCUMENT_OPEN = 4L, 29 TYPE_DOCUMENT_NEW = 5L, 30 TYPE_FILES_PANE_NAVIGATE = 6L 31)) 32 33# list of potential event targets 34.rs.setVar("api.eventTargets", list( 35 TYPE_UNKNOWN = 0L, 36 TYPE_ACTIVE_WINDOW = 1L, 37 TYPE_ALL_WINDOWS = 2L 38)) 39 40.rs.addApiFunction("restartSession", function(command = NULL) { 41 command <- as.character(command) 42 invisible(.rs.restartR(command)) 43}) 44 45.rs.addApiFunction("initializeProject", function(path = getwd()) 46{ 47 path <- .rs.ensureScalarCharacter(path) 48 49 # if this is an existing file ... 50 if (file.exists(path)) 51 { 52 # ... and it's an .Rproj file, then just return that (don't 53 # re-initialize the project) 54 if (grepl("[.]Rproj$", path)) 55 return(.rs.normalizePath(path, winslash = "/")) 56 57 # ... and it's not a directory, bail 58 if (!utils::file_test("-d", path)) 59 { 60 fmt <- "file '%s' exists and is not a directory" 61 stop(sprintf(fmt, .rs.createAliasedPath(path))) 62 } 63 } 64 65 # otherwise, assume we've received the path to a directory, and 66 # attempt to initialize a project within that directory 67 .rs.ensureDirectory(path) 68 69 # NOTE: list.files() will fail on Windows for paths containing 70 # characters not representable in the current locale, so we instead 71 # change to the requested directory, list files, and then build the 72 # full paths 73 rProjFiles <- (function() { 74 75 # move to project path 76 owd <- setwd(path) 77 on.exit(setwd(owd), add = TRUE) 78 79 # list files in path 80 file.path(path, list.files(pattern = "[.]Rproj$")) 81 82 })() 83 84 # if we already have a .Rproj file, just return that 85 if (length(rProjFiles)) 86 return(.rs.normalizePath(rProjFiles[[1]], winslash = "/")) 87 88 # otherwise, attempt to create a new .Rproj file, and return 89 # the path to the generated file 90 rProjFile <- file.path( 91 normalizePath(path, mustWork = TRUE, winslash = "/"), 92 paste(basename(path), "Rproj", sep = ".") 93 ) 94 95 success <- .Call( 96 "rs_writeProjectFile", 97 rProjFile, 98 PACKAGE = "(embedding)" 99 ) 100 101 if (!success) 102 { 103 fmt <- "failed to initialize RStudio project in directory '%s'" 104 stop(sprintf(fmt, .rs.createAliasedPath(path))) 105 } 106 107 return(rProjFile) 108 109}) 110 111.rs.addApiFunction("openProject", function(path = NULL, 112 newSession = FALSE) 113{ 114 # default to current project directory (note that this can be 115 # NULL if the user is not within an RStudio project) 116 if (is.null(path)) 117 path <- .rs.getProjectDirectory() 118 119 path <- .rs.ensureScalarCharacter(path) 120 121 # attempt to initialize project if necessary 122 rProjFile <- .rs.api.initializeProject(path) 123 124 # request that we open this project 125 invisible( 126 .Call("rs_requestOpenProject", 127 rProjFile, 128 newSession, 129 PACKAGE = "(embedding)") 130 ) 131}) 132 133.rs.addApiFunction("versionInfo", function() { 134 info <- list() 135 info$citation <- .Call("rs_rstudioCitation", PACKAGE = "(embedding)") 136 info$mode <- .Call("rs_rstudioProgramMode", PACKAGE = "(embedding)") 137 info$edition <- .Call("rs_rstudioEdition", PACKAGE = "(embedding)") 138 info$version <- .Call("rs_rstudioVersion", PACKAGE = "(embedding)") 139 info$version <- base::package_version(info$version) 140 info$long_version <- .Call("rs_rstudioLongVersion", PACKAGE = "(embedding)") 141 info$release_name <- .Call("rs_rstudioReleaseName", PACKAGE = "(embedding)") 142 info 143}) 144 145.rs.addApiFunction("diagnosticsReport", function() { 146 invisible(.Call("rs_sourceDiagnostics", PACKAGE = "(embedding)")) 147}) 148 149 150.rs.addApiFunction("previewRd", function(rdFile) { 151 152 if (!is.character(rdFile) || (length(rdFile) != 1)) 153 stop("rdFile must be a single element character vector.") 154 if (!file.exists(rdFile)) 155 stop("The specified rdFile ' ", rdFile, "' does not exist.") 156 157 invisible(.Call("rs_previewRd", rdFile, PACKAGE = "(embedding)")) 158 159}) 160 161.rs.addApiFunction("viewer", function(url, height = NULL) { 162 163 if (!is.character(url) || (length(url) != 1)) 164 stop("url must be a single element character vector.") 165 166 if (identical(height, "maximize")) 167 height <- -1 168 169 if (!is.null(height) && (!is.numeric(height) || (length(height) != 1))) 170 stop("height must be a single element numeric vector or 'maximize'.") 171 172 invisible(.Call("rs_viewer", url, height, PACKAGE = "(embedding)")) 173}) 174 175 176.rs.addApiFunction("savePlotAsImage", function( 177 file, 178 format = c("png", "jpeg", "bmp", "tiff", "emf", "svg", "eps"), 179 width, 180 height) { 181 182 file <- path.expand(file) 183 format <- match.arg(format) 184 if (!is.numeric(width)) 185 stop("width argument mut be numeric", call. = FALSE) 186 if (!is.numeric(height)) 187 stop("height argument mut be numeric", call. = FALSE) 188 189 invisible(.Call("rs_savePlotAsImage", file, format, width, height, PACKAGE = "(embedding)")) 190}) 191 192.rs.addApiFunction("sourceMarkers", function(name, 193 markers, 194 basePath = NULL, 195 autoSelect = c("none", "first", "error")) { 196 197 # validate name 198 if (!is.character(name)) 199 stop("name parameter is specified or invalid: ", name, call. = FALSE) 200 201 # validate autoSelect 202 autoSelect = match.arg(autoSelect) 203 204 # normalize basePath 205 if (!is.null(basePath)) 206 basePath <- .rs.normalizePath(basePath, mustWork = TRUE) 207 208 if (is.data.frame(markers)) { 209 210 cols <- colnames(markers) 211 212 if (!"type" %in% cols || !is.character(markers$type)) 213 stop("markers type field is unspecified or invalid", call. = FALSE) 214 if (!"file" %in% cols || !is.character(markers$file)) 215 stop("markers file field is unspecified or invalid", call. = FALSE) 216 if (!"line" %in% cols || !is.numeric(markers$line)) 217 stop("markers line field is unspecified or invalid", call. = FALSE) 218 if (!"column" %in% cols || !is.numeric(markers$column)) 219 stop("markers column field is unspecified or invalid", call. = FALSE) 220 if (!"message" %in% cols || !is.character(markers$message)) 221 stop("markers message field is unspecified or invalid", call. = FALSE) 222 223 # normalize paths 224 markers$file <- .rs.normalizePath(markers$file, mustWork = TRUE) 225 226 # check for html 227 markers$messageHTML <- inherits(markers$message, "html") 228 229 } else if (is.list(markers)) { 230 markers <- lapply(markers, function(marker) { 231 markerTypes <- c("error", "warning", "box", "info", "style", "usage") 232 if (is.null(marker$type) || (!marker$type %in% markerTypes)) 233 stop("Invalid marker type (", marker$type, ")", call. = FALSE) 234 if (!is.character(marker$file)) 235 stop("Marker file is unspecified or invalid: ", marker$file, call. = FALSE) 236 if (!is.numeric(marker$line)) 237 stop("Marker line is unspecified or invalid", marker$line, call. = FALSE) 238 if (!is.numeric(marker$column)) 239 stop("Marker column is unspecified or invalid", marker$line, call. = FALSE) 240 if (!is.character(marker$message)) 241 stop("Marker message is unspecified or invalid: ", marker$message, call. = FALSE) 242 243 marker$type <- .rs.scalar(marker$type) 244 marker$file <- .rs.scalar(.rs.normalizePath(marker$file, mustWork = TRUE)) 245 marker$line <- .rs.scalar(as.numeric(marker$line)) 246 marker$column <- .rs.scalar(as.numeric(marker$column)) 247 marker$message <- .rs.scalar(marker$message) 248 marker$messageHTML <- .rs.scalar(inherits(marker$message, "html")) 249 250 marker 251 }) 252 } else { 253 stop("markers was not a data.frame or a list", call. = FALSE) 254 } 255 256 # validate basePath 257 if (is.null(basePath)) 258 basePath <- "" 259 else if (!is.character(basePath)) 260 stop("basePath parameter is not of type character", call. = FALSE) 261 262 invisible(.Call("rs_sourceMarkers", name, markers, basePath, autoSelect, PACKAGE = "(embedding)")) 263}) 264 265.rs.addApiFunction("navigateToFile", function(filePath = character(0), 266 line = -1L, 267 col = -1L, 268 moveCursor = TRUE) 269{ 270 # validate file argument 271 hasFile <- !is.null(filePath) && length(filePath) > 0 272 if (hasFile && !is.character(filePath)) { 273 stop("filePath must be a character") 274 } 275 if (hasFile && !file.exists(filePath)) { 276 stop(filePath, " does not exist.") 277 } 278 279 # transform numeric line, column values to integer 280 if (is.numeric(line)) 281 line <- as.integer(line) 282 283 if (is.numeric(col)) 284 col <- as.integer(col) 285 286 # validate line/col arguments 287 if (!is.integer(line) || length(line) != 1 || 288 !is.integer(col) || length(col) != 1) { 289 stop("line and column must be numeric values.") 290 } 291 292 if (hasFile) 293 { 294 # expand and alias for client 295 filePath <- .rs.normalizePath(filePath, winslash = "/", mustWork = TRUE) 296 homeDir <- path.expand("~") 297 if (identical(substr(filePath, 1, nchar(homeDir)), homeDir)) { 298 filePath <- file.path("~", substring(filePath, nchar(homeDir) + 2)) 299 } 300 } 301 302 # if we're requesting navigation without a specific cursor position, 303 # then use a separate API (this allows the API to work regardless of 304 # whether we're in source or visual mode) 305 if (identical(line, -1L) && identical(col, -1L)) 306 return(invisible(.Call("rs_fileEdit", filePath, PACKAGE = "(embedding)"))) 307 308 # send event to client 309 .rs.enqueClientEvent("jump_to_function", list( 310 file_name = .rs.scalar(filePath), 311 line_number = .rs.scalar(line), 312 column_number = .rs.scalar(col), 313 move_cursor = .rs.scalar(moveCursor))) 314 315 invisible(NULL) 316}) 317 318.rs.addFunction("validateAndTransformLocation", function(location) 319{ 320 invalidRangeMsg <- "'ranges' should be a list of 4-element integer vectors" 321 322 # allow a single range (then validate that it's a true range after) 323 if (!is.list(location) || inherits(location, "document_range")) 324 location <- list(location) 325 326 ranges <- lapply(location, function(el) { 327 328 # detect proxy Inf object 329 if (identical(el, Inf)) 330 el <- c(Inf, 0, Inf, 0) 331 332 # detect positions (2-element vectors) and transform them to ranges 333 n <- length(el) 334 if (n == 2 && is.numeric(el)) 335 el <- c(el, el) 336 337 # detect document_ranges and transform 338 if (is.list(el) && all(c("start", "end") %in% names(el))) 339 el <- c(el$start, el$end) 340 341 # validate we have a range-like object 342 if (length(el) != 4 || !is.numeric(el) || any(is.na(el))) 343 stop(invalidRangeMsg, call. = FALSE) 344 345 # transform out-of-bounds values appropriately 346 el[el < 1] <- 1 347 el[is.infinite(el)] <- NA 348 349 # transform from 1-based to 0-based indexing for server 350 result <- as.integer(el) - 1L 351 352 # treat NAs as end of row / column 353 result[is.na(result)] <- as.integer(2 ^ 31 - 1) 354 355 result 356 }) 357 358 ranges 359}) 360 361.rs.addFunction("enqueEditorClientEvent", function(type, data) 362{ 363 eventData <- list(type = .rs.scalar(type), data = data) 364 .rs.enqueClientEvent("editor_command", eventData) 365}) 366 367.rs.addApiFunction("insertText", function(location, text, id = "") 368{ 369 invalidTextMsg <- "'text' should be a character vector" 370 invalidLengthMsg <- "'text' should either be length 1, or same length as 'ranges'" 371 372 if (is.null(id)) 373 id <- "" 374 375 if (!is.character(id)) 376 stop("'id' must be NULL or a character vector of length one") 377 378 # allow calls of the form: 379 # 380 # insertText("foo") 381 # insertText(text = "foo") 382 # 383 # in such cases, we replace the current selection. we pass an empty range 384 # and let upstream interpret this as a request to replace the current 385 # selection. 386 if (missing(location)) 387 location <- NULL 388 389 if (missing(text)) 390 text <- NULL 391 392 if (is.null(text) && is.character(location)) 393 { 394 return(.rs.api.selectionSet(value = location, id = id)) 395 } 396 else if (is.null(location) && is.character(text)) 397 { 398 return(.rs.api.selectionSet(value = text, id = id)) 399 } 400 else if (length(location) == 0) 401 { 402 return() 403 } 404 405 ranges <- .rs.validateAndTransformLocation(location) 406 if (!is.character(text)) 407 stop(invalidTextMsg, call. = FALSE) 408 409 if (length(text) != 1 && length(ranges) != length(text)) 410 stop(invalidLengthMsg, call. = FALSE) 411 412 # sort the ranges in decreasing order -- this way, we can 413 # ensure the replacements occur correctly (except in the 414 # case of overlaps) 415 if (length(ranges)) { 416 idx <- order(unlist(lapply(ranges, `[[`, 1))) 417 418 ranges <- ranges[idx] 419 if (length(text) != 1) 420 text <- text[idx] 421 } 422 423 data <- list(ranges = ranges, text = text, id = .rs.scalar(id)) 424 .rs.enqueEditorClientEvent("replace_ranges", data) 425 invisible(data) 426}) 427 428.rs.addApiFunction("setSelectionRanges", function(ranges, id = "") 429{ 430 ranges <- .rs.validateAndTransformLocation(ranges) 431 data <- list(ranges = ranges, id = .rs.scalar(id)) 432 .rs.enqueEditorClientEvent("set_selection_ranges", data) 433 invisible(data) 434}) 435 436# NOTE: Kept for backwards compatibility with older versions 437# of the 'rstudioapi' package -- it is superceded by 438# '.rs.getLastActiveEditorContext()'. 439.rs.addApiFunction("getActiveDocumentContext", function() { 440 .Call("rs_getEditorContext", 0L, PACKAGE = "(embedding)") 441}) 442 443.rs.addApiFunction("getLastActiveEditorContext", function() { 444 .Call("rs_getEditorContext", 0L, PACKAGE = "(embedding)") 445}) 446 447.rs.addApiFunction("getConsoleEditorContext", function() { 448 .Call("rs_getEditorContext", 1L, PACKAGE = "(embedding)") 449}) 450 451.rs.addApiFunction("getSourceEditorContext", function() { 452 .Call("rs_getEditorContext", 2L, PACKAGE = "(embedding)") 453}) 454 455.rs.addApiFunction("getActiveProject", function() { 456 .rs.getProjectDirectory() 457}) 458 459.rs.addApiFunction("sendToConsole", function(code, 460 echo = TRUE, 461 execute = TRUE, 462 focus = TRUE) 463{ 464 if (!is.character(code)) 465 stop("'code' should be a character vector", call. = FALSE) 466 467 code <- paste(code, collapse = "\n") 468 data <- list( 469 code = .rs.scalar(code), 470 echo = .rs.scalar(as.logical(echo)), 471 execute = .rs.scalar(as.logical(execute)), 472 focus = .rs.scalar(as.logical(focus)), 473 language = "R" 474 ) 475 476 .rs.enqueClientEvent("send_to_console", data) 477 invisible(data) 478}) 479 480.rs.addApiFunction("askForPassword", function(prompt) { 481 .rs.askForPassword(prompt) 482}) 483 484.rs.addFunction("dialogIcon", function(name = NULL) { 485 486 icons <- list( 487 info = 1, 488 warning = 2, 489 error = 3, 490 question = 4 491 ) 492 493 if (is.null(name)) 494 icons 495 else 496 icons[[name]] 497 498}) 499 500.rs.addApiFunction("showDialog", function(title, message, url = "") { 501 502 # ensure URL is a string 503 if (is.null(url) || is.na(url)) 504 url <- "" 505 506 .Call("rs_showDialog", 507 title = title, 508 message = message, 509 dialogIcon = .rs.dialogIcon("info"), 510 prompt = FALSE, 511 promptDefault = "", 512 ok = "OK", 513 cancel = "Cancel", 514 url = url, 515 PACKAGE = "(embedding)") 516}) 517 518.rs.addApiFunction("updateDialog", function(...) 519{ 520 scalarValues <- lapply(list(...), .rs.scalar) 521 .rs.enqueClientEvent("update_new_connection_dialog", scalarValues) 522 523 invisible(NULL) 524}) 525 526.rs.addApiFunction("showPrompt", function(title, message, default = "") { 527 528 # ensure default is a string 529 if (is.null(default) || is.na(default)) 530 default <- "" 531 532 .Call("rs_showDialog", 533 title = title, 534 message = message, 535 dialogIcon = .rs.dialogIcon("info"), 536 prompt = TRUE, 537 promptDefault = default, 538 ok = "OK", 539 cancel = "Cancel", 540 url = "", 541 PACKAGE = "(embedding)") 542}) 543 544.rs.addApiFunction("showQuestion", function(title, message, ok = "OK", cancel = "Cancel") { 545 546 # fix up ok, cancel 547 if (is.null(ok) || is.na(ok)) 548 ok <- "OK" 549 550 if (is.null(cancel) || is.na(cancel)) 551 cancel <- "Cancel" 552 553 .Call("rs_showDialog", 554 title = title, 555 message = message, 556 dialogIcon = .rs.dialogIcon("question"), 557 prompt = FALSE, 558 promptDefault = NULL, 559 ok = ok, 560 cancel = cancel, 561 url = NULL, 562 PACKAGE = "(embedding)") 563}) 564 565.rs.addApiFunction("writePreference", function(name, value) { 566 .rs.writeApiPref(name, value) 567}) 568 569.rs.addApiFunction("readPreference", function(name, default = NULL) { 570 value <- .rs.readApiPref(name) 571 if (is.null(value)) default else value 572}) 573 574.rs.addApiFunction("writeRStudioPreference", function(name, value) { 575 .rs.writeUiPref(name, value) 576}) 577 578.rs.addApiFunction("readRStudioPreference", function(name, default = NULL) { 579 value <- .rs.readUiPref(name) 580 if (is.null(value)) default else value 581}) 582 583.rs.addApiFunction("setPersistentValue", function(name, value) { 584 invisible(.Call("rs_setPersistentValue", name, value)) 585}) 586 587.rs.addApiFunction("getPersistentValue", function(name) { 588 .Call("rs_getPersistentValue", name) 589}) 590 591.rs.addApiFunction("documentId", function(allowConsole = TRUE) { 592 593 payload <- list( 594 allow_console = .rs.scalar(allowConsole) 595 ) 596 597 request <- .rs.api.createRequest( 598 type = .rs.api.eventTypes$TYPE_DOCUMENT_ID, 599 sync = TRUE, 600 target = .rs.api.eventTargets$TYPE_ACTIVE_WINDOW, 601 payload = payload 602 ) 603 604 response <- .rs.api.sendRequest(request) 605 response$id 606 607}) 608 609.rs.addApiFunction("documentContents", function(id = NULL) { 610 611 # resolve id 612 id <- .rs.nullCoalesce(id, .rs.api.documentId(allowConsole = FALSE)) 613 614 # retrieve properties 615 properties <- .Call("rs_documentProperties", 616 as.character(id), 617 TRUE, 618 PACKAGE = "(embedding)") 619 620 # extract contents as UTF-8 621 contents <- properties$contents 622 Encoding(contents) <- "UTF-8" 623 624 # return 625 contents 626}) 627 628.rs.addApiFunction("documentPath", function(id = NULL) { 629 630 # resolve document id 631 id <- .rs.nullCoalesce(id, .rs.api.documentId(allowConsole = FALSE)) 632 if (is.null(id)) 633 return(NULL) 634 635 # read document properties 636 properties <- .Call("rs_documentProperties", 637 id, 638 FALSE, 639 PACKAGE = "(embedding)") 640 641 # return document path 642 properties$path 643 644}) 645 646.rs.addApiFunction("documentSave", function(id = NULL) { 647 648 # resolve document id 649 id <- .rs.nullCoalesce(id, .rs.api.documentId(allowConsole = FALSE)) 650 if (is.null(id)) 651 return(TRUE) 652 653 # attempt document save 654 .Call("rs_requestDocumentSave", id, PACKAGE = "(embedding)") 655 656}) 657 658.rs.addApiFunction("documentSaveAll", function() { 659 .Call("rs_requestDocumentSave", NULL, PACKAGE = "(embedding)") 660}) 661 662.rs.addApiFunction("documentNew", function(type, 663 code, 664 row = 0, 665 column = 0, 666 execute = FALSE) 667{ 668 type <- switch( 669 type, 670 rmd = "r_markdown", 671 rmarkdown = "r_markdown", 672 sql = "sql", 673 "r_script" 674 ) 675 676 payload <- list( 677 type = .rs.scalar(type), 678 code = .rs.scalar(paste(code, collapse = "\n")), 679 row = .rs.scalar(as.integer(row)), 680 column = .rs.scalar(as.integer(column)), 681 execute = .rs.scalar(execute) 682 ) 683 684 request <- .rs.api.createRequest( 685 type = .rs.api.eventTypes$TYPE_DOCUMENT_NEW, 686 sync = TRUE, 687 target = .rs.api.eventTargets$TYPE_ACTIVE_WINDOW, 688 payload = payload 689 ) 690 691 response <- .rs.api.sendRequest(request) 692 response$id 693}) 694 695.rs.addApiFunction("documentOpen", function(path) { 696 697 payload <- list( 698 path = .rs.scalar(path) 699 ) 700 701 request <- .rs.api.createRequest( 702 type = .rs.api.eventTypes$TYPE_DOCUMENT_OPEN, 703 sync = TRUE, 704 target = .rs.api.eventTargets$TYPE_ACTIVE_WINDOW, 705 payload = payload 706 ) 707 708 response <- .rs.api.sendRequest(request) 709 response$id 710 711}) 712 713.rs.addApiFunction("documentClose", function(id = NULL, save = TRUE) { 714 715 # resolve document id 716 id <- .rs.nullCoalesce(id, .rs.api.documentId(allowConsole = FALSE)) 717 if (is.null(id)) 718 return(TRUE) 719 720 # request close 721 .Call("rs_requestDocumentClose", id, save, PACKAGE = "(embedding)") 722 723}) 724 725.rs.addApiFunction("closeAllSourceBuffersWithoutSaving", function() { 726 .Call("rs_documentCloseAllNoSave", PACKAGE = "(embedding)") 727}) 728 729# NOTE: we allow '1L' just in case for backwards compatibility 730# with older preferences not migrated to the newer string version 731.rs.addApiFunction("getConsoleHasColor", function(name) { 732 mode <- .rs.readUiPref("ansi_console_mode") 733 !is.null(mode) && mode %in% list(1L, "on") 734}) 735 736.rs.addApiFunction("terminalSend", function(id, text) { 737 if (!is.character(text)) 738 stop("'text' should be a character vector", call. = FALSE) 739 740 if (is.null(id) || !is.character(id) || length(id) != 1) 741 stop("'id' must be a character vector of length one") 742 743 .Call("rs_terminalSend", id, text) 744 invisible(NULL) 745}) 746 747.rs.addApiFunction("terminalClear", function(id) { 748 if (is.null(id) || !is.character(id) || length(id) != 1) 749 stop("'id' must be a character vector of length one") 750 751 .Call("rs_terminalClear", id) 752 invisible(NULL) 753}) 754 755.rs.addApiFunction("terminalCreate", function(caption = NULL, show = TRUE, shellType = NULL) { 756 if (!is.null(caption) && (!is.character(caption) || (length(caption) != 1))) 757 stop("'caption' must be NULL or a character vector of length one") 758 759 if (is.null(show) || !is.logical(show)) 760 stop("'show' must be a logical vector") 761 762 if (!is.null(shellType) && (!is.character(shellType) || (length(shellType) != 1))) 763 stop("'shellType' must be NULL or a character vector of length one") 764 765 validShellType = TRUE 766 if (!is.null(shellType)) { 767 validShellType <- tolower(shellType) %in% c("default", "win-cmd", 768 "win-ps", "win-git-bash", "win-wsl-bash", "ps-core", "custom") 769 } 770 if (!validShellType) 771 stop("'shellType' must be NULL, or one of 'default', 'win-cmd', 'win-ps', 'win-git-bash', 'win-wsl-bash', 'ps-core', 'bash', 'zsh', or 'custom'.") 772 773 .Call("rs_terminalCreate", caption, show, shellType) 774}) 775 776.rs.addApiFunction("terminalBusy", function(id) { 777 if (is.null(id) || !is.character(id)) 778 stop("'id' must be a character vector") 779 780 .Call("rs_terminalBusy", id) 781}) 782 783.rs.addApiFunction("terminalRunning", function(id) { 784 if (is.null(id) || !is.character(id)) 785 stop("'id' must be a character vector") 786 787 .Call("rs_terminalRunning", id) 788}) 789 790.rs.addApiFunction("terminalList", function() { 791 .Call("rs_terminalList") 792}) 793 794.rs.addApiFunction("terminalContext", function(id) { 795 if (is.null(id) || !is.character(id) || (length(id) != 1)) 796 stop("'id' must be a single element character vector") 797 798 .Call("rs_terminalContext", id) 799}) 800 801.rs.addApiFunction("terminalActivate", function(id = NULL, show = TRUE) { 802 if (!is.null(id) && (!is.character(id) || (length(id) != 1))) 803 stop("'id' must be NULL or a character vector of length one") 804 805 if (!is.logical(show)) 806 stop("'show' must be TRUE or FALSE") 807 808 .Call("rs_terminalActivate", id, show) 809 invisible(NULL) 810}) 811 812.rs.addApiFunction("terminalBuffer", function(id, stripAnsi = TRUE) { 813 if (is.null(id) || !is.character(id) || (length(id) != 1)) 814 stop("'id' must be a single element character vector") 815 816 if (is.null(stripAnsi) || !is.logical(stripAnsi)) 817 stop("'stripAnsi' must be a logical vector") 818 819 .Call("rs_terminalBuffer", id, stripAnsi) 820}) 821 822.rs.addApiFunction("terminalKill", function(id) { 823 if (is.null(id) || !is.character(id)) 824 stop("'id' must be a character vector") 825 826 .Call("rs_terminalKill", id) 827 invisible(NULL) 828}) 829 830.rs.addApiFunction("terminalVisible", function() { 831 .Call("rs_terminalVisible") 832}) 833 834.rs.addApiFunction("terminalExecute", function(command, 835 workingDir = NULL, 836 env = character(), 837 show = TRUE) { 838 if (is.null(command) || !is.character(command) || (length(command) != 1)) 839 stop("'command' must be a single element character vector") 840 if (!is.null(workingDir) && (!is.character(workingDir) || (length(workingDir) != 1))) 841 stop("'workingDir' must be a single element character vector") 842 if (!is.null(env) && !is.character(env)) 843 stop("'env' must be a character vector") 844 if (is.null(show) || !is.logical(show)) 845 stop("'show' must be a logical vector") 846 847 .Call("rs_terminalExecute", command, workingDir, env, show, PACKAGE = "(embedding)") 848}) 849 850.rs.addApiFunction("terminalExitCode", function(id) { 851 if (is.null(id) || !is.character(id) || (length(id) != 1)) 852 stop("'id' must be a single element character vector") 853 854 .Call("rs_terminalExitCode", id, PACKAGE = "(embedding)") 855}) 856 857options(terminal.manager = list(terminalActivate = .rs.api.terminalActivate, 858 terminalCreate = .rs.api.terminalCreate, 859 terminalClear = .rs.api.terminalClear, 860 terminalList = .rs.api.terminalList, 861 terminalContext = .rs.api.terminalContext, 862 terminalBuffer = .rs.api.terminalBuffer, 863 terminalVisible = .rs.api.terminalVisible, 864 terminalBusy = .rs.api.terminalBusy, 865 terminalRunning = .rs.api.terminalRunning, 866 terminalKill = .rs.api.terminalKill, 867 terminalSend = .rs.api.terminalSend, 868 terminalExecute = .rs.api.terminalExecute, 869 terminalExitCode = .rs.api.terminalExitCode)) 870 871.rs.addApiFunction("selectFile", function( 872 caption = "Select File", 873 label = "Select", 874 path = .rs.getProjectDirectory(), 875 filter = NULL, 876 existing = TRUE) 877{ 878 .Call("rs_openFileDialog", 879 1L, 880 caption, 881 label, 882 path, 883 filter, 884 existing, 885 PACKAGE = "(embedding)") 886}) 887 888.rs.addApiFunction("selectDirectory", function( 889 caption = "Select Directory", 890 label = "Select", 891 path = .rs.getProjectDirectory()) 892{ 893 .Call("rs_openFileDialog", 894 2L, 895 caption, 896 label, 897 path, 898 NULL, 899 TRUE, 900 PACKAGE = "(embedding)") 901}) 902 903.rs.addApiFunction("getThemeInfo", function() { 904 905 # read theme preferences 906 global <- .rs.readUiPref("global_theme") 907 908 theme <- .rs.readUserState("theme") 909 if (is.null(theme)) 910 theme <- list("name" = "Textmate (default)", "isDark" = FALSE) 911 912 global <- switch( 913 if (is.null(global)) "" else global, 914 alternate = "Sky", 915 default = "Modern", 916 "Classic" 917 ) 918 919 # default/fallback theme colors 920 foreground <- "#000000"; 921 background <- "#FFFFFF"; 922 923 # attempt to read colors from browser 924 colors <- .Call("rs_getThemeColors", PACKAGE = "(embedding)") 925 if (!is.null(colors)) { 926 foreground <- colors$foreground 927 background <- colors$background 928 } 929 930 list( 931 editor = theme$name, 932 global = global, 933 dark = theme$isDark, 934 foreground = foreground, 935 background = background 936 ) 937}) 938 939.rs.addApiFunction("askForSecret", function(name, title, prompt) { 940 .rs.askForSecret(name, title, prompt) 941}) 942 943.rs.addApiFunction("previewSql", function(conn, statement, ...) { 944 .rs.previewSql(conn, statement, ...) 945}) 946 947.rs.addApiFunction("buildToolsCheck", function() { 948 .Call("rs_canBuildCpp", PACKAGE = "(embedding)") 949}) 950 951.rs.addApiFunction("buildToolsInstall", function(action) { 952 953 # skip prompt if requested explicitly 954 if (is.null(action) || !nzchar(action)) 955 return(.Call("rs_installBuildTools", PACKAGE = "(embedding)")) 956 957 # otherwise, call prompting version 958 .rs.installBuildTools(action) 959}) 960 961.rs.addApiFunction("buildToolsExec", function(expr) { 962 .rs.withBuildTools(expr) 963}) 964 965.rs.addApiFunction("dictionariesPath", function() { 966 .Call("rs_dictionariesPath", "bundled", PACKAGE = "(embedding)") 967}) 968 969.rs.addApiFunction("bundledDictionariesPath", function() { 970 .Call("rs_dictionariesPath", "bundled", PACKAGE = "(embedding)") 971}) 972 973.rs.addApiFunction("extraDictionariesPath", function() { 974 .Call("rs_dictionariesPath", "extra", PACKAGE = "(embedding)") 975}) 976 977.rs.addApiFunction("userDictionariesPath", function() { 978 .Call("rs_dictionariesPath", "user", PACKAGE = "(embedding)") 979}) 980 981# translate a local URL into an externally accessible URL on RStudio Server 982.rs.addApiFunction("translateLocalUrl", function(url, absolute = FALSE) { 983 .Call("rs_translateLocalUrl", url, absolute, PACKAGE = "(embedding)") 984}) 985 986# execute an arbitrary RStudio application command (AppCommand) 987.rs.addApiFunction("executeCommand", function(commandId, quiet = FALSE) { 988 .Call("rs_executeAppCommand", commandId, quiet, PACKAGE = "(embedding)") 989}) 990 991# return a list of all the R packages RStudio depends on in in some way 992.rs.addApiFunction("getPackageDependencies", function() { 993 .Call("rs_packageDependencies", PACKAGE = "(embedding)") 994}) 995 996# highlight UI elements within the IDE 997.rs.addApiFunction("highlightUi", function(data = list()) { 998 .Call("rs_highlightUi", data, PACKAGE = "(embedding)") 999}) 1000 1001# return display username (user identity) 1002.rs.addApiFunction("userIdentity", function() { 1003 .Call("rs_userIdentity", PACKAGE = "(embedding)") 1004}) 1005 1006# return system username 1007.rs.addApiFunction("systemUsername", function() { 1008 .Call("rs_systemUsername", PACKAGE = "(embedding)") 1009}) 1010 1011# store callback functions to be executed after a specified chunk 1012# and return a handle to unregister the chunk 1013.rs.addApiFunction("registerChunkCallback", function(chunkCallback) { 1014 1015 if (length(.rs.notebookChunkCallbacks) != 0) 1016 stop("Callback is already registered.") 1017 if (!is.function(chunkCallback)) 1018 stop("'chunkCallback' must be a function") 1019 if (length(formals(chunkCallback)) != 2) 1020 stop("'chunkCallback' must contain two parameters: chunkName and chunkCode") 1021 1022 data <- chunkCallback 1023 handle <- .Call("rs_createUUID", PACKAGE = "(embedding)") 1024 assign(handle, value = data, envir = .rs.notebookChunkCallbacks) 1025 1026 return(handle) 1027}) 1028 1029# unregister a chunk callback functions 1030.rs.addApiFunction("unregisterChunkCallback", function(id = NULL) { 1031 if (length(.rs.notebookChunkCallbacks) == 0) 1032 warning("No registered callbacks found") 1033 else if (!is.null(id) && !exists(id, envir = .rs.notebookChunkCallbacks)) 1034 warning("Handle not found.") 1035 else 1036 { 1037 id <- ls(envir = .rs.notebookChunkCallbacks) 1038 rm(list = id, envir = .rs.notebookChunkCallbacks) 1039 } 1040}) 1041 1042# get list of command IDs which currently have callbacks (listeners) attached 1043.rs.addFunction("getCommandsWithCallbacks", function() { 1044 commands <- unique(sort(unlist(lapply(names(.rs.commandCallbacks), function(handle) { 1045 handler <- get(handle, envir = .rs.commandCallbacks) 1046 if (nzchar(handler$command)) 1047 handler$command 1048 else 1049 "" 1050 })))) 1051 commands[nzchar(commands)] 1052}) 1053 1054# register a command callback 1055.rs.addApiFunction("registerCommandCallback", function(commandId, commandCallback) { 1056 1057 # validate arguments 1058 if (!nzchar(commandId)) 1059 stop("'commandId' must be a character vector naming an RStudio command ID") 1060 if (!is.function(commandCallback)) 1061 stop("'commandCallback' must be a function") 1062 1063 # find a unique ID for this callback 1064 repeat { 1065 handle <- .Call("rs_generateShortUuid", PACKAGE = "(embedding)") 1066 if (!(handle %in% names(.rs.commandCallbacks))) 1067 break 1068 } 1069 1070 # save the ID along with the registered callback 1071 assign(handle, 1072 value = list( 1073 command = commandId, 1074 callback = commandCallback), 1075 envir = .rs.commandCallbacks) 1076 1077 # send event to client indicating which command IDs currently have callbacks registered 1078 .rs.enqueClientEvent("command_callbacks_changed", 1079 .rs.scalarListFromList(as.list(.rs.getCommandsWithCallbacks()))) 1080 1081 # return the handle we created 1082 handle 1083}) 1084 1085# unregister a command callback 1086.rs.addApiFunction("unregisterCommandCallback", function(handle = NULL) { 1087 if (!is.null(handle) && !exists(handle, envir = .rs.commandCallbacks)) 1088 warning("Handle '", handle, " is not a registered RStudio command callback.") 1089 else { 1090 rm(list = handle, envir = .rs.commandCallbacks) 1091 1092 # send event to client indicating which command IDs currently have callbacks registered 1093 .rs.enqueClientEvent("command_callbacks_changed", 1094 .rs.scalarListFromList(as.list(.rs.getCommandsWithCallbacks()))) 1095 1096 } 1097 1098 invisible(NULL) 1099}) 1100 1101# records the execution of a command 1102.rs.addJsonRpcHandler("record_command_execution", function(commandId) { 1103 # loop over all registered command callbacks 1104 for (handle in names(.rs.commandCallbacks)) { 1105 1106 # retrieve handler metadata 1107 handler <- get(handle, envir = .rs.commandCallbacks) 1108 1109 # sanity check: ensure this handler looks properly formatted. nothing else should be writing 1110 # to this environment, but if it does we don't want it to trip up the processing below. 1111 if (!is.list(handler)) { 1112 next 1113 } 1114 if (!is.function(handler$callback)) { 1115 next 1116 } 1117 1118 # if this is a stream listener for all commands ("*"), invoke it with the command ID 1119 if (identical(handler$command, "*")) { 1120 handler$callback(commandId) 1121 next 1122 } 1123 1124 # if this is a listener for a specific command, invoke it without arguments 1125 if (identical(handler$command, commandId)) { 1126 handler$callback() 1127 } 1128 } 1129}) 1130 1131 1132# Tutorial ---- 1133 1134# invoked by rstudioapi to instruct RStudio to open a particular 1135# URL in the Tutorial pane. should be considered an internal contract 1136# between the RStudio + rstudioapi packages rather than an official 1137# user-facing API 1138.rs.addApiFunction("tutorialLaunchBrowser", function(url) { 1139 .rs.tutorial.launchBrowser(url) 1140}) 1141 1142# given a tutorial 'name' from package 'package', run that tutorial 1143# and show the application in the Tutorial pane 1144.rs.addApiFunction("tutorialRun", function(name, package, shiny_args = NULL) { 1145 .rs.tutorial.runTutorial(name, package, shiny_args) 1146}) 1147 1148# stop a running tutorial 1149.rs.addApiFunction("tutorialStop", function(name, package) { 1150 .rs.tutorial.stopTutorial(name, package) 1151}) 1152 1153# API for sending + receiving arbitrary requests from rstudioapi 1154# added in RStudio v1.4; not used univerally by older APIs but useful 1155# as a framework for any new functions that might be added 1156 1157#' @param type The event type. See '.rs.api.events' for the set 1158#' of permissible targets. 1159#' 1160#' @param sync Boolean; does handling of this event need to be 1161#' synchronous? Ensure `sync = TRUE` is used if you need to wait 1162#' for a response from the client. 1163#' 1164#' @param target The window to be targeted by this request. See 1165#' `.rs.api.eventTargets` for possible targets. 1166#' 1167#' @param data The payload associated with this event. 1168#' 1169.rs.addApiFunction("createRequest", function(type, sync, target, payload) 1170{ 1171 list( 1172 type = .rs.scalar(type), 1173 sync = .rs.scalar(sync), 1174 target = .rs.scalar(target), 1175 payload = as.list(payload) 1176 ) 1177}) 1178 1179.rs.addApiFunction("sendRequest", function(request) { 1180 .Call("rs_sendApiRequest", request, PACKAGE = "(embedding)") 1181}) 1182 1183.rs.addApiFunction("selectionGet", function(id = NULL) 1184{ 1185 # create data payload 1186 payload <- list( 1187 doc_id = .rs.scalar(id) 1188 ) 1189 1190 # create request 1191 request <- .rs.api.createRequest( 1192 type = .rs.api.eventTypes$TYPE_GET_EDITOR_SELECTION, 1193 sync = TRUE, 1194 target = .rs.api.eventTargets$TYPE_ACTIVE_WINDOW, 1195 payload = payload 1196 ) 1197 1198 # fire away 1199 .rs.api.sendRequest(request) 1200}) 1201 1202.rs.addApiFunction("selectionSet", function(value = NULL, id = NULL) 1203{ 1204 # collapse value into single string 1205 value <- paste(value, collapse = "\n") 1206 1207 # create data payload 1208 payload <- list( 1209 value = .rs.scalar(value), 1210 doc_id = .rs.scalar(id) 1211 ) 1212 1213 # create request 1214 request <- .rs.api.createRequest( 1215 type = .rs.api.eventTypes$TYPE_SET_EDITOR_SELECTION, 1216 sync = TRUE, 1217 target = .rs.api.eventTargets$TYPE_ACTIVE_WINDOW, 1218 payload = payload 1219 ) 1220 1221 # fire away 1222 .rs.api.sendRequest(request) 1223}) 1224 1225.rs.addApiFunction("filesPaneNavigate", function(path) 1226{ 1227 info <- file.info(path, extra_cols = FALSE) 1228 if (is.na(info$isdir)) 1229 stop("'", path, "' does not exist") 1230 else if (identical(info$isdir, FALSE)) 1231 path <- dirname(path) 1232 1233 payload <- list( 1234 path = .rs.scalar(.rs.createAliasedPath(path)) 1235 ) 1236 1237 request <- .rs.api.createRequest( 1238 type = .rs.api.eventTypes$TYPE_FILES_PANE_NAVIGATE, 1239 sync = FALSE, 1240 target = .rs.api.eventTargets$TYPE_UNKNOWN, 1241 payload = payload 1242 ) 1243 1244 .rs.api.sendRequest(request) 1245 invisible(path) 1246}) 1247 1248