Nothing
hover_xpath <- paste(
"(*|descendant-or-self::exprlist/*)[self::FUNCTION or self::OP-LAMBDA][following-sibling::SYMBOL_FORMALS[text() = '{token_quote}' and @line1 <= {row}]]/parent::expr",
"(*|descendant-or-self::exprlist/*)[LEFT_ASSIGN[preceding-sibling::expr[count(*)=1]/SYMBOL[text() = '{token_quote}' and @line1 <= {row}] and following-sibling::expr[@start > {start} or @end < {end}]]]",
"(*|descendant-or-self::exprlist/*)[RIGHT_ASSIGN[following-sibling::expr[count(*)=1]/SYMBOL[text() = '{token_quote}' and @line1 <= {row}] and preceding-sibling::expr[@start > {start} or @end < {end}]]]",
"(*|descendant-or-self::exprlist/*)[EQ_ASSIGN[preceding-sibling::expr[count(*)=1]/SYMBOL[text() = '{token_quote}' and @line1 <= {row}] and following-sibling::expr[@start > {start} or @end < {end}]]]",
"forcond/SYMBOL[text() = '{token_quote}' and @line1 <= {row}]",
sep = "|")
#' The response to a textDocument/hover Request
#'
#' When hovering on a symbol, if it is a function, return its help text
#' if it exists in the current [Workspace].
#' @noRd
hover_reply <- function(id, uri, workspace, document, point) {
if (!check_scope(uri, document, point)) {
return(Response$new(id))
}
token_result <- document$detect_token(point)
range <- token_result$range
contents <- NULL
resolved <- FALSE
version <- workspace$get_parse_data(uri)$version
logger$info("hover:", list(uri = uri, version = version, token = token_result))
xdoc <- workspace$get_parse_data(uri)$xml_doc
if (token_result$accessor == "" && !is.null(xdoc)) {
row <- point$row + 1
col <- point$col + 1
token <- xdoc_find_token(xdoc, row, col)
if (length(token)) {
token_name <- xml_name(token)
token_text <- xml_text(token)
token_start <- as.integer(xml_attr(token, "start"))
token_end <- as.integer(xml_attr(token, "end"))
logger$info(token_name, token_text)
if (token_name %in% c("SYMBOL", "SYMBOL_FUNCTION_CALL")) {
# symbol
preceding_dollar <- xml_find_first(token, "preceding-sibling::OP-DOLLAR")
if (length(preceding_dollar) == 0) {
enclosing_scopes <- xdoc_find_enclosing_scopes(xdoc,
row, col, top = TRUE)
xpath <- glue(hover_xpath,
row = row, start = token_start, end = token_end,
token_quote = xml_single_quote(token_text))
all_defs <- xml_find_all(enclosing_scopes, xpath)
if (length(all_defs)) {
last_def <- all_defs[[length(all_defs)]]
def_func <- xml_find_first(last_def,
"self::*[LEFT_ASSIGN | RIGHT_ASSIGN | EQ_ASSIGN]/expr[FUNCTION | OP-LAMBDA]")
if (length(def_func)) {
func_line1 <- as.integer(xml_attr(def_func, "line1"))
func_col1 <- as.integer(xml_attr(def_func, "col1"))
func_line2 <- as.integer(xml_attr(def_func, "line2"))
func_col2 <- as.integer(xml_attr(def_func, "col2"))
func_text <- get_range_text(document$content,
line1 = func_line1,
col1 = func_col1,
line2 = func_line2,
col2 = func_col2
)
func_expr <- parse(text = func_text, keep.source = FALSE)
def_text <- get_signature(token_text, func_expr[[1]])
def_line1 <- func_line1
} else {
def_line1 <- as.integer(xml_attr(last_def, "line1"))
def_line2 <- def_line1
def_text <- trimws(
paste0(document$content[def_line1:def_line2],
collapse = "\n")
)
}
doc_string <- NULL
doc_line1 <- detect_comments(document$content, def_line1 - 1) + 1
if (doc_line1 < def_line1) {
comment <- document$content[doc_line1:(def_line1 - 1)]
doc <- convert_comment_to_documentation(comment)
if (is.character(doc)) {
doc_string <- doc
} else if (is.list(doc)) {
if (is.null(doc$markdown)) {
doc_string <- doc$description
} else {
doc_string <- doc$markdown
}
}
}
contents <- c(sprintf("```r\n%s\n```", def_text), doc_string)
resolved <- TRUE
}
}
} else if (token_name == "SYMBOL_SUB") {
# function parameter
funct <- xml_text(xml_find_first(token,
"preceding-sibling::expr/SYMBOL_FUNCTION_CALL/text()"))
if (!is.na(funct)) {
package <- xml_text(xml_find_first(token,
"preceding-sibling::expr/SYMBOL_PACKAGE/text()"))
if (is.na(package)) {
package <- NULL
enclosing_scopes <- xdoc_find_enclosing_scopes(xdoc,
row, col, top = TRUE)
xpath <- glue(signature_xpath, row = row,
token_quote = xml_single_quote(funct))
all_defs <- xml_find_all(enclosing_scopes, xpath)
if (length(all_defs)) {
last_def <- all_defs[[length(all_defs)]]
func_line1 <- as.integer(xml_attr(last_def, "line1"))
func_col1 <- as.integer(xml_attr(last_def, "col1"))
func_line2 <- as.integer(xml_attr(last_def, "line2"))
func_col2 <- as.integer(xml_attr(last_def, "col2"))
func_text <- get_range_text(document$content,
line1 = func_line1,
col1 = func_col1,
line2 = func_line2,
col2 = func_col2
)
func_expr <- parse(text = func_text, keep.source = FALSE)
sig <- get_signature(funct, func_expr[[1]])
doc_string <- NULL
doc_line1 <- detect_comments(document$content, func_line1 - 1) + 1
if (doc_line1 < func_line1) {
comment <- document$content[doc_line1:(func_line1 - 1)]
doc <- convert_comment_to_documentation(comment)
if (is.list(doc)) {
doc_string <- doc$arguments[[token_text]]
if (!is.null(doc_string)) {
contents <- c(
sprintf("```r\n%s\n```", sig),
sprintf("`%s` - %s", token_text, doc_string))
}
}
}
resolved <- TRUE
}
}
if (!resolved) {
doc <- workspace$get_documentation(funct, package, isf = TRUE)
doc_string <- NULL
if (is.list(doc)) {
doc_string <- doc$arguments[[token_text]]
if (is.null(doc_string)) {
doc_string <- doc$arguments$...
token_text <- "..."
}
}
if (!is.null(doc_string)) {
sig <- workspace$get_signature(funct, package)
if (is.null(sig)) {
contents <- doc_string
} else {
sig <- str_trunc(sig, 300)
contents <- c(
sprintf("```r\n%s\n```", sig),
sprintf("`%s` - %s", token_text, doc_string))
}
}
resolved <- TRUE
}
}
} else if (token_name == "SYMBOL_FORMALS") {
# function formals
funct <- xml_find_first(token, "preceding-sibling::*[self::FUNCTION or self::OP-LAMBDA]/parent::expr")
func_line1 <- as.integer(xml_attr(funct, "line1"))
doc_line1 <- detect_comments(document$content, func_line1 - 1) + 1
if (doc_line1 < func_line1) {
comment <- document$content[doc_line1:(func_line1 - 1)]
doc <- convert_comment_to_documentation(comment)
if (is.list(doc)) {
doc_string <- doc$arguments[[token_text]]
if (!is.null(doc_string)) {
contents <- sprintf("`%s` - %s", token_text, doc_string)
}
}
}
resolved <- TRUE
} else if (token_name == "SYMBOL_PACKAGE") {
# package
if (length(find.package(token_text, quiet = TRUE))) {
desc <- utils::packageDescription(token_text, fields = c("Title", "Description"))
description <- gsub("\\s*\n\\s*", " ", desc$Description)
contents <- sprintf("**%s**\n\n%s", desc$Title, description)
} else {
contents <- sprintf("Package `%s` is not installed.", token_text)
}
resolved <- TRUE
} else if (token_name == "SLOT") {
# S4 slot
resolved <- TRUE
} else if (token_name == "NUM_CONST") {
# logical, integer, double
# contents <- "number"
# resolved <- TRUE
} else if (token_name == "STR_CONST") {
# string literal
# contents <- "string"
resolved <- TRUE
} else if (token_name == "COMMENT") {
# comment
resolved <- TRUE
} else if (startsWith(token_name, "OP-")) {
# operators
resolved <- TRUE
}
}
}
if (!resolved) {
contents <- workspace$get_help(token_result$token, token_result$package)
if (is.null(contents)) {
def_text <- NULL
doc <- workspace$get_documentation(token_result$token, token_result$package)
signs <- if (is.null(token_result$package)) {
workspace$guess_namespace(token_result$token)
} else {
token_result$package
}
sig <- workspace$get_signature(token_result$token, signs,
exported_only = token_result$accessor != ":::")
if (is.null(sig)) {
def <- workspace$get_definition(token_result$token, token_result$package,
exported_only = token_result$accessor != ":::")
if (!is.null(def)) {
def_doc <- workspace$documents$get(def$uri)
def_line1 <- def$range$start$line + 1
def_text <- def_doc$line(def_line1)
}
} else {
def_text <- sig
}
doc_string <- NULL
if (is.character(doc)) {
doc_string <- doc
} else if (is.list(doc)) {
if (is.null(doc$markdown)) {
doc_string <- doc$description
} else {
doc_string <- doc$markdown
}
}
contents <- c(
if (!is.null(def_text)) sprintf("```r\n%s\n```", def_text),
doc_string
)
}
}
if (is.null(contents)) {
Response$new(id)
} else {
Response$new(
id,
result = list(
contents = contents,
range = range(
start = document$to_lsp_position(row = range$start$row, col = range$start$col),
end = document$to_lsp_position(row = range$end$row, col = range$end$col)
)
)
)
}
}
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.