R/utils.R

In konradedgar/reformatFilePath: RStudio Add-In Formatting File Path

# This file is sourced from:
# https://github.com/rstudio/addinexamples and is part of
# addinexamples - nn R package showcasing how RStudio addins can be registered and used.
# more information is available on: http://rstudio.github.io/rstudioaddins/
# The addinexamples is license to RStudio, Inc.under MIT License

injectHighlightHandler <- function() {
    code <- "
  Shiny.addCustomMessageHandler('highlight-code', function(message) {
    var id = message['id'];
    setTimeout(function() {
      var el = document.getElementById(id);
      hljs.highlightBlock(el);
    }, 100);
  });
  "

    tags$script(code)
}

includeHighlightJs <- function() {
    resources <- system.file("www/shared/highlight", package = "shiny")
    list(includeScript(file.path(resources, "highlight.pack.js")),
         includeCSS(file.path(resources, "rstudio.css")),
         injectHighlightHandler())
}

highlightCode <- function(session, id) {
    session$sendCustomMessage("highlight-code", list(id = id))
}

rCodeContainer <- function(...) {
    code <- HTML(as.character(tags$code(class = "language-r", ...)))
    div(pre(code))
}

renderCode <- function(expr,
                       env = parent.frame(),
                       quoted = FALSE) {
    func <- NULL
    installExprFunction(expr, "func", env, quoted)
    markRenderFunction(textOutput, function() {
        paste(func(), collapse = "\n")
    })
}

stableColumnLayout <- function(...) {
    dots <- list(...)
    n <- length(dots)
    width <- 12 / n
    class <- sprintf("col-xs-%s col-md-%s", width, width)
    fluidRow(lapply(dots, function(el) {
        div(class = class, el)
    }))
}

isErrorMessage <- function(object) {
    inherits(object, "error_message")
}

errorMessage <- function(type, message) {
    structure(list(type = type, message = message),
              class = "error_message")
}