Skip to content

Commit

Permalink
Merge pull request #62 from detule/pr-refactor
Browse files Browse the repository at this point in the history 
Refactor shinyAce
  • Loading branch information
@vnijs
vnijs authored Jun 27, 2019
2 parents 690491e + e6eb8e7 commit 0b10a43
Show file tree
Hide file tree
Showing 16 changed files with 442 additions and 372 deletions.
2 changes: 1 addition & 1 deletion DESCRIPTION
View file
Original file line number Diff line number Diff line change
Expand Up @@ -23,4 +23,4 @@ Suggests:
dplyr (>= 0.7.4)
BugReports: https://github.com/trestletech/shinyAce/issues
Encoding: UTF-8
RoxygenNote: 6.1.0
RoxygenNote: 6.1.1
275 changes: 52 additions & 223 deletions R/ace-editor.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -45,10 +45,10 @@
#' By default, only local completer is used where all aforementioned code pieces
#' will be considered as candidates. Use \code{autoCompleteList} for static
#' completions and \code{\link{aceAutocomplete}} for dynamic R code completions.
#' @param autoCompleters List of completers to enable. If set to \code{NULL},
#' @param autoCompleters Character vector of completers to enable. If set to \code{NULL},
#' all completers will be disabled. Select one or more of "snippet", "text", "static",
#' and "keyword" to control which completers to use. Default option is an empty character
#' vector which does not effect default completion options
#' "keyword", and "rlang" to control which completers to use. Default option is an
#' empty character vector which does not effect default completion options.
#' @param autoCompleteList A named list that contains static code completions
#' candidates. This can be especially useful for Non-Standard Evaluation (NSE)
#' functions such as those in \code{dplyr} and \code{ggvis}. Each element in list
Expand Down Expand Up @@ -105,7 +105,7 @@
#' @export
aceEditor <- function(
outputId, value, mode, theme,
vimKeyBinding = FALSE, readOnly = FALSE, height = "400px", fontSize = 12,
vimKeyBinding = FALSE, readOnly = FALSE, height = "400px", fontSize = 12,
debounce = 1000, wordWrap = FALSE, showLineNumbers = TRUE,
highlightActiveLine = TRUE, selectionId = NULL, cursorId = NULL,
hotkeys = NULL,
Expand All @@ -116,233 +116,62 @@ aceEditor <- function(
showInvisibles = FALSE, setBehavioursEnabled = TRUE,
autoScrollEditorIntoView = FALSE, maxLines = NULL, minLines = NULL
) {

editorVar <- paste0("editor__", sanitizeId(outputId))
js <- paste("var ", editorVar," = ace.edit('", outputId, "');", sep = "")
if (!missing(theme)) {
js <- paste(js, "", editorVar, ".setTheme('ace/theme/", theme, "');", sep = "")
}
if (vimKeyBinding) {
js <- paste(js, "", editorVar, ".setKeyboardHandler('ace/keyboard/vim');", sep = "")
}
if (!missing(mode)) {
js <- paste(js, "", editorVar, ".getSession().setMode('ace/mode/", mode,"');", sep = "")
}
if (!missing(value)) {
js <- paste(js, "", editorVar, ".setValue(", jsQuote(value), ", -1);", sep = "")
}
if (!showLineNumbers) {
js <- paste(js, "", editorVar, ".renderer.setShowGutter(false);", sep = "")
}
if (!highlightActiveLine) {
js <- paste(js, "", editorVar, ".setHighlightActiveLine(false);", sep = "")
}
if (readOnly) {
js <- paste(js, "", editorVar, ".setReadOnly(", jsQuote(readOnly), ");", sep = "")
}
if (!is.null(fontSize) && !is.na(as.numeric(fontSize))) {
js <- paste(js, "document.getElementById('", outputId, "').style.fontSize='",
as.numeric(fontSize), "px'; ", sep = "")
}

escapedId <- gsub("\\.", "\\\\\\\\.", outputId)
escapedId <- gsub("\\:", "\\\\\\\\:", escapedId)
payloadLst <-
list(
id = escapedId,
vimKeyBinding = vimKeyBinding,
readOnly = readOnly,
wordWrap = wordWrap,
showLineNumbers = showLineNumbers,
highlightActiveLine = highlightActiveLine,
selectionId = selectionId,
cursorId = cursorId,
hotkeys = hotkeys,
autoComplete = match.arg(autoComplete),
autoCompleteList = autoCompleteList,
tabSize = tabSize,
useSoftTabs = useSoftTabs,
showInvisibles = showInvisibles,
setBehavioursEnabled = setBehavioursEnabled,
autoScrollEditorIntoView = autoScrollEditorIntoView,
maxLines = maxLines,
minLines = minLines
)

if(is.null(autoCompleters))
payloadLst$autoComplete <- "disabled"
if(sum(autoCompleters %in% c("snippet", "text", "static", "keyword", "rlang")) > 0)
payloadLst$autoCompleters <- I(autoCompleters)
if(!missing(value)) payloadLst$value <- value
if(!missing(mode)) payloadLst$mode <- mode
if(!missing(theme)) payloadLst$theme <- theme
if(!is.null(fontSize) && !is.na(as.numeric(fontSize)))
payloadLst$fontSize <- fontSize
if(!is.null(debounce) && !is.na(as.numeric(debounce)))
payloadLst$debounce <- debounce
if (!is.null(debounce) && !is.na(as.numeric(debounce))) {
# I certainly hope there's a more reasonable way to compare
# I certainly hope there's a more reasonable way to compare
# versions with an extra field in them...
re <- regexpr("^\\d+\\.\\d+(\\.\\d+)?", utils::packageVersion("shiny"))
shinyVer <- substr(utils::packageVersion("shiny"), 0, attr(re, "match.length"))
minorVer <- as.integer(substr(utils::packageVersion("shiny"),
attr(re, "match.length") + 2,
nchar(utils::packageVersion("shiny"))))
attr(re, "match.length") + 2,
nchar(utils::packageVersion("shiny"))))
comp <- utils::compareVersion(shinyVer, "0.9.1")
if (comp < 0 || (comp == 0 && minorVer < 9004)) {
warning("Shiny version 0.9.1.9004 required to use input debouncing in shinyAce.")
}
js <- paste(js, "$('#", outputId ,"').data('debounce',", debounce,");", sep = "")
}

if (wordWrap) {
js <- paste(js, "", editorVar,".getSession().setUseWrapMode(true);", sep = "")
}

# https://learn.jquery.com/using-jquery-core/faq/how-do-i-select-an-element-by-an-id-that-has-characters-used-in-css-notation/
escapedId <- gsub("\\.", "\\\\\\\\.", outputId)
escapedId <- gsub("\\:", "\\\\\\\\:", escapedId)
js <- paste(js, "$('#", escapedId, "').data('aceEditor',", editorVar, ");", sep = "")

if (!is.null(selectionId)) {
selectJS <- paste("", editorVar, ".getSelection().on(\"changeSelection\", function() {
Shiny.onInputChange(\"", selectionId,
"\",", editorVar, ".getCopyText());})",
sep = "")
js <- paste(js, selectJS, sep = "")
}

if (!is.null(cursorId)) {
curJS <- paste("\n", editorVar, ".getSelection().on(\"changeCursor\", function() {
Shiny.onInputChange(\"", cursorId,
"\",", editorVar, ".selection.getCursor() );}\n);",
sep = "")
js <- paste(js, curJS, sep = "")
}

for (i in seq_along(hotkeys)) {
shortcut = hotkeys[[i]]
if (is.list(shortcut)) {
shortcut = paste0(names(shortcut), ": '", shortcut, "'", collapse = ", ")
} else {
shortcut = paste0("win: '", shortcut, "', mac: '", shortcut, "'")
}

id = names(hotkeys)[i]
code = paste0("
", editorVar,".commands.addCommand({
name: '", id,"',
bindKey: {", shortcut,"},
exec: function(", editorVar,") {
var selection = ", editorVar, ".session.getTextRange();
var range = ", editorVar, ".selection.getRange();
var imax = ", editorVar, ".session.getLength() - range.end.row;
if(selection === '') {
var i = 1;
var line = ", editorVar, ".session.getLine(range.end.row);
var next_line = ", editorVar, ".session.getLine(range.end.row + i);
if (/^```\\{.*\\}\\s*$/.test(line)) {
// run R-code chunk
while(/\\n```\\s*$/.test(line) === false & i < imax + 1) {
i++;
line = line.concat('\\n', next_line);
next_line = ", editorVar, ".session.getLine(range.end.row + i);
// console.log(next_line, i, imax);
}
if (i === imax + 1) {
line = '<h4>Code chunk not properly closed. Code chunks must end in &#96 &#96 &#96</h4>';
}
} else if (/^\\$\\$\\s*$/.test(line)) {
// evaluate equation
while(/\\n\\$\\$\\s*$/.test(line) === false & i < imax + 1) {
i++;
line = line.concat('\\n', next_line);
next_line = ", editorVar, ".session.getLine(range.end.row + i);
}
if (i === imax + 1) {
line = '<h4>Equation not properly closed. Display equations must start and end with $$</h4>';
}
} else if (/(\\(|\\{|\\[)\\s*$/.test(line)) {
", editorVar, ".navigateLineEnd();
", editorVar, ".jumpToMatching();
match_line = ", editorVar, ".selection.getCursor();
if (match_line.row === range.end.row) {
line = '#### Bracket not properly closed. Fix and try again';
} else {
line = ", editorVar, ".session.getLines(range.end.row, match_line.row).join('\\n');
i = match_line.row - range.end.row + 1
}
} else {
rexpr = /(%>%|\\+|\\-|\\,)\\s*$/;
rxeval = rexpr.test(line);
while((rxeval | /^\\s*(\\#|$)/.test(next_line)) & i < imax) {
rxeval = rexpr.test(line);
if (rxeval | /^\\s*(\\}|\\))/.test(next_line)) {
line = line.concat('\\n', next_line);
}
i++;
next_line = ", editorVar, ".session.getLine(range.end.row + i);
// console.log(next_line, i, imax)
}
}
", editorVar, ".gotoLine(range.end.row + i + 1);
if (line === '') {
line = ' '; // ensure whole report is not rendered
}
}
Shiny.onInputChange(\"", id,
"\",{
editorId: '", outputId,"',
selection: selection,
range: range,
line: line,
randNum: Math.random()
});
},
readOnly: true // false if this command should not apply in readOnly mode
});
")
js <- paste0(js, code)
}

autoComplete <- match.arg(autoComplete)
if (autoComplete != "disabled") {
js <- paste(js, "", editorVar, ".setOption('enableBasicAutocompletion', true);", sep = "")
}
if (autoComplete == "live") {
js <- paste(js, "", editorVar, ".setOption('enableLiveAutocompletion', true);", sep = "")
}

if (length(autoCompleters) > 0) {
if (sum(autoCompleters %in% c("snippet", "text", "static", "keyword")) > 0) {
js <- paste(js, 'var langTools = ace.require("ace/ext/language_tools");')
js <- paste(js, "", editorVar, ".completers = [];", sep = "")
if ("snippet" %in% autoCompleters) {
js <- paste(js, "", editorVar, ".completers.push(langTools.snippetCompleter);", sep = "")
}
if ("text" %in% autoCompleters) {
js <- paste(js, "", editorVar, ".completers.push(langTools.textCompleter);", sep = "")
}
if ("keyword" %in% autoCompleters) {
js <- paste(js, "", editorVar, ".completers.push(langTools.keywordCompleter);", sep = "")
}
if ("static" %in% autoCompleters) {
code <- 'var staticCompleter = {
getCompletions: function(editor, session, pos, prefix, callback) {
var comps = $("#" + editor.container.id).data("auto-complete-list");
if(comps) {
var words = [];
Object.keys(comps).forEach(function(key) {
var comps_key = comps[key];
if (!Array.isArray(comps[key])) {
comps_key = [comps_key];
}
words = words.concat(comps_key.map(function(d) {
return {name: d, value: d, meta: key};
}));
});
callback(null, words);
}
}
};
langTools.addCompleter(staticCompleter);'
js <- paste0(js, code)
js <- paste(js, "", editorVar, ".completers.push(staticCompleter);", sep = "")
}
}
} else {
js <- paste(js, "", editorVar, ".completers = [];", sep = "")
}

if (!useSoftTabs) {
js <- paste(js, "", editorVar, ".setOption('useSoftTabs', false);", sep = "")
}
js <- paste(js, "", editorVar, ".setOption('tabSize', ", tabSize, ");", sep = "")
if (showInvisibles) {
js <- paste(js, "", editorVar, ".setOption('showInvisibles', true);", sep = "")
}
if (!setBehavioursEnabled) {
js <- paste(js, "", editorVar, ".setBehavioursEnabled(false);", sep = "")
}

if (autoScrollEditorIntoView) {
js <- paste(js, "", editorVar, ".setOption('autoScrollEditorIntoView', true);", sep = "")
if (!is.null(maxLines)) {
js <- paste(js, "", editorVar, ".setOption('maxLines', ", maxLines, ");", sep = "")
}
if (!is.null(minLines)) {
js <- paste(js, "", editorVar, ".setOption('minLines', ", minLines, ");", sep = "")
}
}

payloadLst$debounce <- debounce
}
# Filter out any elements of the list that are NULL
# In the javascript code we use ".hasOwnProperty" to test whether a property
# should be set, and all of our properties are such that a javascript value of
# `null` does not make sense.
payloadLst <- Filter(f = function(y) !is.null(y), x = payloadLst)
payload <- jsonlite::toJSON(payloadLst, null = "null", auto_unbox = TRUE)
tagList(
singleton(tags$head(
initResourcePaths(),
Expand All @@ -362,7 +191,7 @@ aceEditor <- function(
style = paste("height:", validateCssUnit(height)),
`data-auto-complete-list` = jsonlite::toJSON(autoCompleteList)
),
tags$script(type = "text/javascript", HTML(js))
tags$script(type = "application/json", `data-for` = escapedId, HTML(payload))
)
}

Expand Down
12 changes: 0 additions & 12 deletions R/js-quote.R
View file

This file was deleted.

22 changes: 16 additions & 6 deletions R/update-ace-editor.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -25,7 +25,7 @@
#' @param border Set the \code{border} 'normal', 'alert', or 'flash'.
#' @param autoComplete Enable/Disable code completion. See \code{\link{aceEditor}}
#' for details.
#' @param autoCompleters List of completers to enable. If set to \code{NULL},
#' @param autoCompleters Character vector of completers to enable. If set to \code{NULL},
#' all completers will be disabled.
#' @param autoCompleteList If set to \code{NULL}, existing static completions
#' list will be unset. See \code{\link{aceEditor}} for details.
Expand Down Expand Up @@ -53,6 +53,15 @@ updateAceEditor <- function(
if (missing(session) || missing(editorId)) {
stop("Must provide both a session and an editorId to update Ace editor settings")
}
if(!all(autoComplete %in% c("disabled", "enabled", "live")))
stop("updateAceEditor: Incorrectly formatted autoComplete parameter")
if(!all(border %in% c("normal", "alert", "flash")))
stop("updateAceEditor: Incorrectly formatted border parameter")
if(
!is.null(autoCompleters) &&
!all(autoCompleters %in% c("snippet", "text", "keyword", "static", "rlang"))
)
stop("updateAceEditor: Incorrectly formatted autoCompleters parameter")

theList <- list(id = editorId)

Expand All @@ -72,14 +81,15 @@ updateAceEditor <- function(
}

if (!missing(autoComplete)) {
autoComplete <- match.arg(autoComplete)
if (!is.null(autoCompleters))
autoComplete <- "disabled"
else
autoComplete <- match.arg(autoComplete)
theList["autoComplete"] <- autoComplete
}

if (!missing(autoCompleters)) {
if (!is.null(autoCompleters)) {
autoCompleters <- match.arg(autoCompleters, several.ok = TRUE)
}
if (!missing(autoCompleters) && !is.null(autoCompleters)) {
autoCompleters <- match.arg(autoCompleters, several.ok = TRUE)
theList <- c(theList, list(autoCompleters = autoCompleters))
}

Expand Down
4 changes: 2 additions & 2 deletions inst/examples/05-hotkeys/server.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -8,12 +8,12 @@ shinyServer(function(input, output, session) {
vals <- reactiveValues(log = "")

observe({
input$runKey
input$ace_runKey
isolate(vals$log <- paste(vals$log, renderLogEntry("Run Key"), sep="\n"))
})

observe({
input$helpKey
input$ace_helpKey
isolate(vals$log <- paste(vals$log, renderLogEntry("Help Key"), sep="\n"))
})

Expand Down
Loading

0 comments on commit 0b10a43

Please sign in to comment.