Nothing
get_style <- function(options) {
style <- getOption("languageserver.formatting_style")
if (is.null(style)) {
style <- styler::tidyverse_style(indent_by = options$tabSize)
} else {
style <- style(options)
}
style
}
#' Edit code style
#'
#' This functions formats a list of text using [styler::style_text()] with the
#' specified style.
#'
#' @noRd
style_text <- function(text, style, indention = 0L, trailing_empty_line = FALSE) {
new_text <- tryCatch(
styler::style_text(
text,
transformers = style,
base_indention = indention
),
error = function(e) e
)
if (inherits(new_text, "error")) {
logger$info("formatting error:", new_text$message)
return(NULL)
}
if (isTRUE(trailing_empty_line)) {
if (new_text[[length(new_text)]] != "") {
new_text <- c(new_text, "")
}
}
paste0(new_text, collapse = "\n")
}
#' Format a document
#' @noRd
formatting_reply <- function(id, uri, document, options) {
style <- get_style(options)
nline <- document$nline
if (document$is_rmarkdown) {
logger$info("formatting R markdown file")
blocks <- extract_blocks(document$content)
if (length(blocks) == 0) {
return(Response$new(id, list()))
}
TextEditList <- list()
for (block in blocks) {
new_text <- style_text(block$text, style)
if (is.null(new_text)) {
new_text <- block$text
}
a <- min(block$lines)
b <- max(block$lines)
range <- range(
start = document$to_lsp_position(row = a - 1, col = 0),
end = document$to_lsp_position(row = b - 1, col = nchar(document$line(b)))
)
TextEdit <- text_edit(range = range, new_text = new_text)
TextEditList[[length(TextEditList) + 1]] <- TextEdit
}
} else {
logger$info("formatting R file")
new_text <- style_text(document$content, style, trailing_empty_line = TRUE)
if (is.null(new_text)) {
return(Response$new(id, list()))
}
range <- range(
start = document$to_lsp_position(row = 0, col = 0),
end = if (nline) {
document$to_lsp_position(row = nline - 1, col = nchar(document$line(nline)))
} else {
document$to_lsp_position(row = 0, col = 0)
}
)
TextEdit <- text_edit(range = range, new_text = new_text)
TextEditList <- list(TextEdit)
}
Response$new(id, TextEditList)
}
#' Format a part of a document
#' @noRd
range_formatting_reply <- function(id, uri, document, range, options) {
row1 <- range$start$row
col1 <- range$start$col
if (range$end$col == 0 && row1 < range$end$row) {
# if the cursor is at the beginning of a line, move up one line
row2 <- range$end$row - 1
lastline <- document$content[row2 + 1]
col2 <- nchar(lastline)
} else {
row2 <- range$end$row
lastline <- document$content[row2 + 1]
col2 <- range$end$col
}
# check if the selection is empty
if (row1 == row2 && col1 == col2) {
return(Response$new(id, list()))
}
style <- get_style(options)
# check if the selection contains complete lines
if (col1 != 0 || col2 < nchar(lastline)) {
# disable assignment operator fix for partial selection
style$token$force_assignment_op <- NULL
}
selection <- document$content[(row1:row2) + 1]
indention <- nchar(stringi::stri_extract_first_regex(selection[1], "^\\s*"))
new_text <- style_text(selection, style, indention = indention)
if (is.null(new_text)) {
return(Response$new(id, list()))
}
range <- range(
start = document$to_lsp_position(row = row1, col = 0),
end = document$to_lsp_position(row = row2, col = nchar(document$line0(row2)))
)
TextEdit <- text_edit(range = range, new_text = new_text)
TextEditList <- list(TextEdit)
Response$new(id, TextEditList)
}
#' Format on type
#' @noRd
on_type_formatting_reply <- function(id, uri, document, point, ch, options) {
if (!check_scope(uri, document, point)) {
return(Response$new(id))
}
content <- document$content
end_line <- point$row + 1
use_completer <- FALSE
if (ch == "\n") {
start_line <- end_line - 1
if (grepl("^\\s*(#.*)?$", content[[start_line]])) {
return(Response$new(id))
}
if (grepl("^\\s*(#.*)?$", content[[end_line]])) {
# use completer to complete the potentially incomplete expression
last_line <- content[end_line]
content[end_line] <- "f()"
use_completer <- TRUE
}
} else {
start_line <- end_line
}
# backward parse until more expressions or non-parseable
expr <- NULL
nexpr <- 0
res <- tryCatchTimeout({
while (start_line >= 1) {
expr <- tryCatch(parse(
text = content[start_line:end_line],
keep.source = FALSE
), error = function(e) NULL)
nexpr1 <- length(expr)
# stop backward parsing when
# 1. we have at least one expression parsed; and
# 2. we are entering the previous expression:
# * if it is one-line expression, then we got 1 more expression.
# * if it is multi-line expression, then we got no expression
# 3. the previous line is not an incomplete expression ending with binary operator or comma
if (nexpr > 0 && (nexpr1 > nexpr || nexpr1 == 0) && !is_incomplete_line(content[[start_line]])) {
start_line <- start_line + 1
break
}
nexpr <- nexpr1
start_line <- start_line - 1
}
TRUE
}, timeout = 0.1, error = function(e) logger$info("on_type_formatting_reply:parser:", e))
if (is.null(res)) {
# timeout
return(Response$new(id))
}
if (nexpr >= 1) {
if (start_line == 0) {
start_line <- 1
}
# find first non-empty line for the detection of indention
while (start_line < end_line) {
if (grepl("\\S", content[[start_line]])) {
break
}
start_line <- start_line + 1
}
# logger$info("on_type_formatting_reply:", list(
# start_line = start_line,
# end_line = end_line,
# chunk = content[start_line:end_line]
# ))
style <- get_style(options)
# disable assignment operator fix since end_line could be function parameter
style$token$force_assignment_op <- NULL
indention <- nchar(stringi::stri_extract_first_regex(content[start_line], "^\\s*"))
new_text <- tryCatchTimeout(
style_text(content[start_line:end_line], style, indention = indention),
timeout = 1,
error = function(e) logger$info("on_type_formatting_reply:styler:", e)
)
if (!is.null(new_text)) {
if (use_completer) {
# remove completer from formatted text
new_text <- substr(new_text, 1, nchar(new_text) - 3)
new_text <- paste0(new_text, trimws(last_line))
}
range <- range(
start = document$to_lsp_position(row = start_line - 1, col = 0),
end = document$to_lsp_position(row = end_line - 1, col = nchar(document$line(end_line)))
)
TextEdit <- text_edit(range = range, new_text = new_text)
TextEditList <- list(TextEdit)
return(Response$new(id, TextEditList))
}
}
Response$new(id)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.