Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Refactor shinyAce #62

Merged
merged 4 commits into from
Jun 27, 2019
Merged

Refactor shinyAce #62

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
386d67a
Refactor shinyAce
detule Jun 12, 2019
ad48ae4
tests: RM test-js-quote
detule Jun 12, 2019
7ab2d2c
shinyAce.js: Fixup jQuery alias usage
detule Jun 18, 2019
e6eb8e7
autoCompleters: More careful treatment of autoCompleters == ''
Jun 25, 2019
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion DESCRIPTION
View file
Open in desktop
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
Open in desktop
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
Open in desktop

This file was deleted.

22 changes: 16 additions & 6 deletions R/update-ace-editor.R
View file
Open in desktop
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
Open in desktop
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