#' @title Shiny Gadget to interactively prefix function in a script
#'
#' @description Open a script, load package(s) used in that script, then launch this addin via RStudio menu.
#' It will propose to prefix function with their package (if a function is in several packages, a choice can be made),
#' validate the suggested prefix or skip to the next function.
#'
#' @export
#'
#' @importFrom miniUI miniPage miniContentPanel
#' @importFrom rstudioapi getSourceEditorContext insertText
#' @importFrom shiny tags fillPage uiOutput splitLayout actionButton
#' tagList icon actionLink reactiveValues observeEvent showModal
#' modalDialog modalButton selectizeInput removeModal renderUI HTML
#' isolate radioButtons removeUI insertUI stopApp runGadget paneViewer
#' @importFrom shinyWidgets confirmSweetAlert
#' @importFrom stringr str_replace
#'
#' @examples
#' \dontrun{
#'
#' prefixer()
#'
#' }
prefixer <- function() {
script <- rstudioapi::getSourceEditorContext()$contents
if (sum(nchar(script), na.rm = TRUE) == 0) {
warning("It seems there are nothing to prefix...")
return(invisible())
}
script_funs <- get_script_funs(script)
if (nrow(script_funs) == 0) {
warning("It seems there are nothing to prefix...")
return(invisible())
}
to_load <- get_unloaded_packages(script = script)
ui <- miniPage(
tags$head(tags$style(".highlight-context {color: red !important;}")),
tags$div(
class = "gadget-title", style = "background-color: rgb(16,34,70);",
tags$h1("prefixer::", style = "font-weight: bold; color: #FFF;"),
tags$button(
id="cancel", type="button", "Cancel",
class="btn btn-default btn-sm action-button pull-right"
)
),
miniContentPanel(
fillPage(
# padding = 10, title = "Prefixer",
tags$br(),
uiOutput(outputId = "ui_fun"),
tags$div(id = "button-close-placeholder")
)
),
tags$div(
style = "padding: 15px;",
splitLayout(
id = "buttons-navigate",
actionButton(
inputId = "add_prefix", label = "Add prefix", width = "100%",
icon = tags$i(tags$b("::", style = "font-style: normal;"))
),
tagList(
actionButton(
inputId = "skip", label = "Skip", width = "100%",
icon = icon("forward")
), tags$br(),
actionLink(
inputId = "skip_all", label = "Skip all occurences",
icon = icon("fast-forward"), style = "font-size: 80%;"
)
)
),
tags$span(
style = "font-size: 70%;",
"If your script use unloaded packages, functions from these packages won't be prefixed. You can load packages by ",
actionLink(inputId = "load_packages", label = "clicking here"), "."
)
)
)
server <- function(input, output, session) {
script_funs_r <- reactiveValues(x = script_funs)
if (length(to_load) > 0) {
confirmSweetAlert(
session = session, inputId = "confirm_load", title = "Unloaded packages",
text = paste0(
"These packages seems to be used but are not loaded : ", paste(to_load, collapse = ", "),
". Do you want to load them ?"
)
)
}
observeEvent(input$load_packages, {
showModal(modalDialog(
easyClose = FALSE, footer = modalButton("Cancel"),
selectizeInput(
inputId = "packages_to_load",
label = "Packages to load:",
choices = .packages(all.available = TRUE),
multiple = TRUE, options = list(plugins = list("remove_button")),
width = "100%"
),
actionButton(
inputId = "load_more_packages", label = "Load selected packages",
width = "100%", class = "btn-primary"
)
))
})
observeEvent(input$load_more_packages, {
invisible(lapply(input$packages_to_load, library, character.only = TRUE))
script_funs <- get_script_funs(script)
script_funs_r$x <- script_funs
# Update selection
set_selection(script_funs, 1)
# Update fun list
fun$actual_fun <- script_funs$funs[1]
fun$suggested_fun <- paste(script_funs$package[1], script_funs$funs[1], sep = "::")
fun$fun_context <- script_funs$fun_context[1]
fun$multiple_occurence <- sum(script_funs$funs[1] == script_funs$funs) > 1
fun$multiple_package <- unique(script_funs$package[script_funs$funs == script_funs$funs[1]])
fun$max <- nrow(script_funs)
removeModal()
})
observeEvent(input$confirm_load, {
if (input$confirm_load) {
invisible(lapply(to_load, library, character.only = TRUE))
# Update script funs table
script_funs <- get_script_funs(script)
script_funs_r$x <- script_funs
# Update selection
set_selection(script_funs, 1)
# Update fun list
fun$actual_fun <- script_funs$funs[1]
fun$suggested_fun <- paste(script_funs$package[1], script_funs$funs[1], sep = "::")
fun$fun_context <- script_funs$fun_context[1]
fun$multiple_occurence <- sum(script_funs$funs[1] == script_funs$funs) > 1
fun$multiple_package <- unique(script_funs$package[script_funs$funs == script_funs$funs[1]])
fun$max <- nrow(script_funs)
}
})
fun <- reactiveValues(
counter = 1,
actual_fun = script_funs$funs[1],
suggested_fun = paste(script_funs$package[1], script_funs$funs[1], sep = "::"),
fun_context = script_funs$fun_context[1],
multiple_occurence = sum(script_funs$funs[1] == script_funs$funs) > 1,
multiple_package = unique(script_funs$package[script_funs$funs == script_funs$funs[1]]),
max = nrow(script_funs)
)
set_selection(script_funs, 1)
output$ui_fun <- renderUI({
actual_fun <- fun$actual_fun
suggested_fun <- fun$suggested_fun
fun_context <- HTML(fun$fun_context)
# print(reactiveValuesToList(isolate(fun)))
if (isolate(fun$counter) <= fun$max) {
if (length(fun$multiple_package) == 1) {
tagList(
tags$div(tags$b("Function: "), tags$pre(actual_fun)),
tags$div(tags$b("Context: "), tags$pre(fun_context)),
tags$br(),
tags$span(tags$b("Suggested prefix: "), tags$pre(suggested_fun))
)
} else {
fun$counter <- isolate(fun$counter) + length(fun$multiple_package) - 1
tagList(
tags$div(tags$b("Function: "), tags$pre(actual_fun)),
tags$div(tags$b("Context: "), tags$pre(fun_context)),
tags$br(),
tags$div(
tags$b("Suggested prefix: "),
radioButtons(
inputId = "choice_multiple", label = NULL, width = "100%",
choiceNames = lapply(
X = fun$multiple_package,
FUN = function(x) {
tags$pre(paste(x, actual_fun, sep = "::"), style = "width: 100%;")
}
), choiceValues = paste(fun$multiple_package, actual_fun, sep = "::")
),
tags$style(".radio input[type='radio'] {margin-top: 12px !important;}"),
tags$style("label {width: 100%}")
)
)
}
} else {
removeUI(selector = "#buttons-navigate", immediate = TRUE)
insertUI(
selector = "#button-close-placeholder",
ui = actionButton(
inputId = "close_addin", label = "Close",
icon = icon("remove"), width = "100%"
),
immediate = TRUE
)
tags$div(
class = "alert alert-success",
tags$b("Done!"), "all functions have been prefixed."
)
}
})
observeEvent(input$add_prefix, {
if (length(fun$multiple_package) == 1) {
text2add <- fun$suggested_fun
} else {
text2add <- input$choice_multiple
}
insertText(
location = get_position(script_funs_r$x, fun$counter),
text = text2add
)
# Update pos
row <- script_funs_r$x$numrow[fun$counter]
if (sum(script_funs_r$x$numrow == row) > 1) {
x <- script_funs_r$x
l <- nchar(str_replace(string = text2add, pattern = ":.*", replacement = ""))
x$start[x$numrow == row] <- x$start[x$numrow == row] + l + 2
x$end[x$numrow == row] <- x$end[x$numrow == row] + l + 2
script_funs_r$x <- x
}
fun$counter <- fun$counter + 1
if (fun$counter <= fun$max) {
set_selection(script_funs_r$x, fun$counter)
fun$actual_fun <- script_funs_r$x$funs[fun$counter]
fun$suggested_fun <- paste(script_funs_r$x$package[fun$counter], fun$actual_fun, sep = "::")
fun$fun_context <- script_funs_r$x$fun_context[fun$counter]
fun$multiple_occurence <- sum(fun$actual_fun == script_funs_r$x$funs) > 1
fun$multiple_package <- unique(script_funs_r$x$package[script_funs_r$x$funs == fun$actual_fun])
} else {
fun$actual_fun <- ""
}
})
observeEvent(input$skip, {
fun$counter <- fun$counter + 1
if (fun$counter <= fun$max) {
# print(script_funs_r$fun_context)
set_selection(script_funs_r$x, fun$counter)
fun$actual_fun <- script_funs_r$x$funs[fun$counter]
fun$suggested_fun <- paste(script_funs_r$x$package[fun$counter], fun$actual_fun, sep = "::")
fun$fun_context <- script_funs_r$x$fun_context[fun$counter]
fun$multiple_occurence <- sum(fun$actual_fun == script_funs_r$x$funs) > 1
fun$multiple_package <- unique(script_funs_r$x$package[script_funs_r$x$funs == fun$actual_fun])
} else {
fun$actual_fun <- ""
}
})
observeEvent(input$skip_all, {
# fun$counter <- fun$counter + 1
script_funs_r$x <- script_funs_r$x[!script_funs_r$x$funs %in% fun$actual_fun, ]
fun$max <- nrow(script_funs_r$x)
if (fun$counter <= fun$max) {
# print(script_funs_r$fun_context)
set_selection(script_funs_r$x, fun$counter)
fun$actual_fun <- script_funs_r$x$funs[fun$counter]
fun$suggested_fun <- paste(script_funs_r$x$package[fun$counter], fun$actual_fun, sep = "::")
fun$fun_context <- script_funs_r$x$fun_context[fun$counter]
fun$multiple_occurence <- sum(fun$actual_fun == script_funs_r$x$funs) > 1
fun$multiple_package <- unique(script_funs_r$x$package[script_funs_r$x$funs == fun$actual_fun])
} else {
fun$actual_fun <- ""
}
})
observeEvent(input$close_addin, {
stopApp()
})
observeEvent(input$cancel, {
stopApp()
})
}
runGadget(app = ui, server = server, viewer = paneViewer())
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.