Nothing
# last modified 2022-06-13 by J. Fox
# File (and Edit) menu dialogs
loadLog <- function(){
logFile <- tclvalue(tkgetOpenFile(filetypes=gettextRcmdr('{"All Files" {"*"}} {"Script Files" {".R"}}'),
defaultextension="R",
parent=CommanderWindow()))
if (logFile == "") return()
fileCon <- file(logFile, "r")
contents <- readLines(fileCon)
close(fileCon)
currentLogFileName <- getRcmdr("logFileName")
putRcmdr("logFileName", logFile)
.log <- LogWindow()
if (tclvalue(tkget(.log, "1.0", "end")) != "\n"){
response2 <- RcmdrTkmessageBox(message=gettextRcmdr("Save current log file?"),
icon="question", type="yesno", default="yes")
if ("yes" == tclvalue(response2)) saveLog(currentLogFileName)
}
tkdelete(.log, "1.0", "end")
tkinsert(.log, "end", paste(contents, collapse="\n"))
}
saveLog <- function(logfilename) {
.logFileName <- if (missing(logfilename) || (logfilename == "%logfilename") || (logfilename == "logfilename"))
getRcmdr("logFileName") else logfilename
if (is.null(.logFileName)) {
saveLogAs()
return()
}
log <- tclvalue(tkget(LogWindow(), "1.0", "end"))
fileCon <- file(.logFileName, "w")
cat(log, file = fileCon)
close(fileCon)
Message(paste(gettextRcmdr("Script saved to"), .logFileName), type="note")
}
saveLogAs <- function() {
logFile <- tclvalue(tkgetSaveFile(filetypes=gettextRcmdr('{"All Files" {"*"}} {"Script Files" {".R"}}'),
defaultextension="R",
initialfile="RCommander.R",
parent=CommanderWindow()))
logFile <- removeRedundantExtension(logFile)
if (logFile == "") return()
log <- tclvalue(tkget(LogWindow(), "1.0", "end"))
fileCon <- file(logFile, "w")
cat(log, file = fileCon)
close(fileCon)
putRcmdr("logFileName", logFile)
Message(paste(gettextRcmdr("Script saved to"), logFile), type="note")
}
loadRmd <- function(){
RmdFile <- tclvalue(tkgetOpenFile(filetypes=gettextRcmdr('{"All Files" {"*"}} {"R Markdown Files" {".Rmd" ".rmd"}}'),
defaultextension="Rmd",
parent=CommanderWindow()))
if (RmdFile == "") return()
fileCon <- file(RmdFile, "r")
contents <- readLines(fileCon)
close(fileCon)
currentRmdFileName <- getRcmdr("RmdFileName")
putRcmdr("RmdFileName", RmdFile)
.rmd <- RmdWindow()
if (tclvalue(tkget(.rmd, "1.0", "end")) != "\n"){
response2 <- RcmdrTkmessageBox(message=gettextRcmdr("Save current Rmd file?"),
icon="question", type="yesno", default="yes")
if ("yes" == tclvalue(response2)) saveLog(currentRmdFileName)
}
tkdelete(.rmd, "1.0", "end")
tkinsert(.rmd, "end", paste(contents, collapse="\n"))
}
loadRnw <- function(){
RnwFile <- tclvalue(tkgetOpenFile(filetypes=gettextRcmdr('{"All Files" {"*"}} {"knitr Files" {".Rnw" ".rnw" ".Snw" ".snw"}}'),
defaultextension="Rnw",
parent=CommanderWindow()))
if (RnwFile == "") return()
fileCon <- file(RnwFile, "r")
contents <- readLines(fileCon)
close(fileCon)
currentRnwFileName <- getRcmdr("RnwFileName")
putRcmdr("RnwFileName", RnwFile)
.rnw <- RnwWindow()
if (tclvalue(tkget(.rnw, "1.0", "end")) != "\n"){
response2 <- RcmdrTkmessageBox(message=gettextRcmdr("Save current Rnw file?"),
icon="question", type="yesno", default="yes")
if ("yes" == tclvalue(response2)) saveLog(currentRnwFileName)
}
tkdelete(.rnw, "1.0", "end")
contents <- paste(contents, collapse="\n")
contents <- sub("\n\\\\end\\{document\\}\n", "", contents)
tkinsert(.rnw, "end", contents)
}
saveRmd <- function(Rmdfilename) {
.RmdFileName <- if (missing(Rmdfilename) || (Rmdfilename == "%Rmdfilename"))
getRcmdr("RmdFileName") else Rmdfilename
if ((.RmdFileName == "RcmdrMarkdown.Rmd") || (.RmdFileName == "RcmdrRMarkdown.Rmd") || is.null(.RmdFileName)) {
saveRmdAs()
return()
}
if (getRcmdr("Markdown.editor.open")){
.rmd.window <- RmdWindow()
.markdown.editor.window <- MarkdownEditorWindow()
.markdown.editor <- tclvalue(tkget(.markdown.editor.window, "1.0", "end"))
tkdelete(.rmd.window, "1.0", "end")
tkinsert(.rmd.window, "end", .markdown.editor)
}
.rmd <- tclvalue(tkget(RmdWindow(), "1.0", "end"))
fileCon <- file(.RmdFileName, "w")
cat(.rmd, file = fileCon)
close(fileCon)
Message(paste(gettextRcmdr("R Markdown file saved to"), .RmdFileName), type="note")
}
saveRnw <- function(Rnwfilename) {
.RnwFileName <- if (missing(Rnwfilename) || (Rnwfilename == "%Rnwfilename"))
getRcmdr("RnwFileName") else Rnwfilename
if ((.RnwFileName == "RcmdrKnitr.Rnw") || is.null(.RnwFileName)) {
saveRnwAs()
return()
}
if (getRcmdr("knitr.editor.open")){
.rnw.window <- RnwWindow()
.knitr.editor.window <- knitrEditorWindow()
.knitr.editor <- tclvalue(tkget(.knitr.editor.window, "1.0", "end"))
tkdelete(.rnw.window, "1.0", "end")
tkinsert(.rnw.window, "end", .knitr.editor)
}
.rnw <- tclvalue(tkget(RnwWindow(), "1.0", "end"))
.rnw <- paste(.rnw, "\n\\end{document}\n")
fileCon <- file(.RnwFileName, "w")
cat(.rnw, file = fileCon)
close(fileCon)
Message(paste(gettextRcmdr("knitr file saved to"), .RnwFileName), type="note")
}
saveRmdAs <- function() {
RmdFile <- tclvalue(tkgetSaveFile(filetypes=gettextRcmdr('{"All Files" {"*"}} {"R Markdown Files" {".Rmd" ".rmd"}}'),
defaultextension="Rmd",
initialfile="RCommanderMarkdown.Rmd",
parent=CommanderWindow()))
RmdFile <- removeRedundantExtension(RmdFile)
if (RmdFile == "") return()
if (getRcmdr("Markdown.editor.open")){
.rmd.window <- RmdWindow()
.markdown.editor.window <- MarkdownEditorWindow()
.markdown.editor <- tclvalue(tkget(.markdown.editor.window, "1.0", "end"))
tkdelete(.rmd.window, "1.0", "end")
tkinsert(.rmd.window, "end", .markdown.editor)
}
.rmd <- tclvalue(tkget(RmdWindow(), "1.0", "end"))
fileCon <- file(RmdFile, "w")
cat(.rmd, file = fileCon)
close(fileCon)
putRcmdr("RmdFileName", RmdFile)
Message(paste(gettextRcmdr("R Markdown file saved to"), RmdFile), type="note")
}
saveRnwAs <- function() {
RnwFile <- tclvalue(tkgetSaveFile(filetypes=gettextRcmdr('{"All Files" {"*"}} {"knitr Files" {".Rnw" ".rnw" ".Snw" ".snw"}}'),
defaultextension="Rnw",
initialfile="RCommanderKnitr.Rnw",
parent=CommanderWindow()))
RnwFile <- removeRedundantExtension(RnwFile)
if (RnwFile == "") return()
if (getRcmdr("knitr.editor.open")){
.rnw.window <- RnwWindow()
.knitr.editor.window <- knitrEditorWindow()
.knitr.editor <- tclvalue(tkget(.knitr.editor.window, "1.0", "end"))
tkdelete(.rnw.window, "1.0", "end")
tkinsert(.rnw.window, "end", .knitr.editor)
}
.rnw <- tclvalue(tkget(RnwWindow(), "1.0", "end"))
.rnw <- paste(.rnw, "\n\\end{document}\n")
fileCon <- file(RnwFile, "w")
cat(.rnw, file = fileCon)
close(fileCon)
putRcmdr("RnwFileName", RnwFile)
Message(paste(gettextRcmdr("knitr file saved to"), RnwFile), type="note")
}
saveOutput <- function() {
.outputFileName <- getRcmdr("outputFileName")
if (is.null(.outputFileName)) {
saveOutputAs()
return()
}
output <- tclvalue(tkget(OutputWindow(), "1.0", "end"))
fileCon <- file(.outputFileName, "w")
cat(output, file = fileCon)
close(fileCon)
Message(paste(gettextRcmdr("Output saved to"), .outputFileName), type="note")
}
saveOutputAs <- function() {
outputFile <- tclvalue(tkgetSaveFile(filetypes=gettextRcmdr('{"All Files" {"*"}} {"Output Files" {".txt"}}'),
defaultextension="txt",
initialfile="RCommander.txt",
parent=CommanderWindow()))
outputFile <- removeRedundantExtension(outputFile)
if (outputFile == "") return()
output <- tclvalue(tkget(OutputWindow(), "1.0", "end"))
fileCon <- file(outputFile, "w")
cat(output, file = fileCon)
close(fileCon)
putRcmdr("outputFileName", outputFile)
Message(paste(gettextRcmdr("Output saved to"), outputFile), type="note")
}
saveWorkspaceAs <- function(){
saveFile <- tclvalue(tkgetSaveFile(filetypes=gettextRcmdr('{"All Files" {"*"}} {"R Data Files" {".RData" ".rda" ".Rda" ".RDA"}}'),
defaultextension="",
initialfile=".RData",
parent=CommanderWindow()))
if (saveFile == "") return()
save(list=ls(envir=.GlobalEnv), file=saveFile)
putRcmdr("saveFileName", saveFile)
Message(paste(gettextRcmdr("R workspace saved to"), saveFile), type="note")
}
saveWorkspace <- function() {
.saveFileName <- getRcmdr("saveFileName")
if (is.null(.saveFileName)) {
saveWorkspaceAs()
return()
}
else save(list=ls(envir=.GlobalEnv), file=.saveFileName)
Message(paste(gettextRcmdr("R workspace saved to"), .saveFileName), type="note")
}
CloseCommander <- function() closeCommander(ask=getRcmdr("ask.to.exit"), ask.save=getRcmdr("ask.on.exit"))
closeCommander <- function(ask=TRUE, ask.save=ask){
if (ask){
response <- tclvalue(RcmdrTkmessageBox(message=gettextRcmdr("Exit?"),
icon="question", type="okcancel", default="cancel"))
if (response == "cancel") return(invisible(response))
}
else {
ask.save=FALSE
response <- "ok"
}
sink(type="message")
if (!is.null(ActiveDataSet()) && getRcmdr("attach.data.set"))
justDoIt(logger(paste("detach(", ActiveDataSet(), ")", sep="")))
putRcmdr(".activeDataSet", NULL)
putRcmdr(".activeModel", NULL)
if (ask.save && getRcmdr("log.commands") && tclvalue(tkget(LogWindow(), "1.0", "end")) != "\n"){
response2 <- RcmdrTkmessageBox(message=gettextRcmdr("Save script file?"),
icon="question", type="yesno", default="yes")
if ("yes" == tclvalue(response2)) saveLog()
}
if (ask.save && getRcmdr("markdown.output") && getRcmdr("log.commands") && tclvalue(tkget(RmdWindow(), "1.0", "end")) != "\n"){
response2 <- RcmdrTkmessageBox(message=gettextRcmdr("Save R Markdown file?"),
icon="question", type="yesno", default="yes")
if ("yes" == tclvalue(response2)) saveRmd()
}
if (ask.save && getRcmdr("knitr.output") && getRcmdr("log.commands") && tclvalue(tkget(RnwWindow(), "1.0", "end")) != "\n"){
response2 <- RcmdrTkmessageBox(message=gettextRcmdr("Save knitr file?"),
icon="question", type="yesno", default="yes")
if ("yes" == tclvalue(response2)) saveRnw()
}
if (ask.save && !getRcmdr("console.output") && tclvalue(tkget(OutputWindow(), "1.0", "end")) != "\n"){
response3 <- RcmdrTkmessageBox(message=gettextRcmdr("Save output file?"),
icon="question", type="yesno", default="yes")
if ("yes" == tclvalue(response3)) saveOutput()
}
if (MacOSXP()){
Sys.setenv(PATH=getRcmdr("PATH"))
}
if (!WindowsP()) options(getRcmdr("oldPager"))
if (getRcmdr("suppress.X11.warnings")) {
sink(type = "message")
close(getRcmdr("messages.connection"))
}
options(getRcmdr("saveOptions"))
options(help_type = getRcmdr("restore.help_type"))
options(device = getRcmdr("restore.device"))
# if (getRcmdr("restore.use.external.help"))
# system("defaults delete org.R-project.R use.external.help")
tkdestroy(CommanderWindow())
putRcmdr("commanderWindow", NULL)
putRcmdr("logWindow", NULL)
putRcmdr("RmdWindow", NULL)
putRcmdr("messagesWindow", NULL)
putRcmdr("outputWindow", NULL)
open.showData.windows <- getRcmdr("open.showData.windows")
if (length(open.showData.windows) > 0){
for (window in open.showData.windows){
if (window$ID %in% as.character(tkwinfo("children", "."))) tkdestroy(window)
}
putRcmdr("open.showData.windows", list())
}
if (getRcmdr("Markdown.editor.open")){
tkdestroy(getRcmdr("markdown.editor.toplevel.window"))
}
if (getRcmdr("knitr.editor.open")){
tkdestroy(getRcmdr("knitr.editor.toplevel.window"))
}
options(getRcmdr("quotes"))
options(getRcmdr("max.print"))
options(scipen=getRcmdr("scipen"))
tkwait <- options("Rcmdr")[[1]]$tkwait # to address problem in Debian Linux
if ((!is.null(tkwait)) && tkwait) putRcmdr(".commander.done", tclVar("1"))
return(invisible(response))
}
closeCommanderAndR <- function(){
response <- CloseCommander()
if (response == "cancel") return()
cat("\n")
quit(save="no")
}
Options <- function(){
setOption <- function(option, default) {
if (!is.null(current[[option]])) return(current[[option]])
else if (!is.null(getRcmdr(option, fail=FALSE))) return(getRcmdr(option))
return(default)
}
asLogical <- function(x) as.logical(as.numeric(x))
initializeDialog(title=gettextRcmdr("Commander Options"))
notebook <- ttknotebook(top)
closeTab <- tkframe(top)
fontTab <- tkframe(top)
outputTab <- tkframe(top)
otherTab <- tkframe(top)
current <- getOption("Rcmdr")
console.output <- getRcmdr("console.output")
default.font.size <- getRcmdr("default.font.size")
default.font.family <- getRcmdr("default.font.family")
log.commands <- getRcmdr("log.commands")
log.font.size <- getRcmdr("log.font.size")
log.font.family <- getRcmdr("log.font.family")
log.width <- setOption("log.width", 80)
log.height <- if (!is.null(current$log.height)) current$log.height
else if (!log.commands) 0 else 10
output.height <- if (!is.null(current$output.height)) current$output.height
else if (console.output) 0 else 2*log.height
scientific.notation <- getRcmdr("scientific.notation")
contrasts <- setOption("default.contrasts", c("contr.Treatment", "contr.poly"))
grab.focus <- getRcmdr("grab.focus")
double.click <- getRcmdr("double.click")
sort.names <- getRcmdr("sort.names")
show.edit.button <- setOption("show.edit.button", TRUE)
scale.factor <- current$scale.factor
suppress.icon.images <- getRcmdr("suppress.icon.images")
number.messages <- getRcmdr("number.messages")
etc <- getRcmdr("etc")
etcMenus <- getRcmdr("etcMenus")
log.font <- tclvalue(tkfont.actual("RcmdrLogFont"))
log.font.family <- tclvalue(.Tcl("font actual RcmdrLogFont -family"))
if (length(grep(" ", log.font.family)) > 1) log.font.family <- paste("{", log.font.family, "}", sep="")
title.color <- getRcmdr("title.color")
# On Windows 7 with Classic theme, a color name is returned instead of RGB values
if(substr(title.color, 1, 1) != "#") {
title.color.rgb <- as.numeric(tkwinfo("rgb", top, title.color))
title.color <- rgb(rbind(title.color.rgb), maxColorValue=65535)
}
use.markdown<- getRcmdr("use.markdown")
use.knitr<- getRcmdr("use.knitr")
retain.selections <- getRcmdr("retain.selections")
messages.height <- as.character(getRcmdr("messages.height"))
ask.to.exit <- getRcmdr("ask.to.exit")
ask.on.exit <- getRcmdr("ask.on.exit")
attach.data.set <- getRcmdr("attach.data.set")
log.text.color <- getRcmdr("log.text.color")
command.text.color <- getRcmdr("command.text.color")
output.text.color <- getRcmdr("output.text.color")
error.text.color <- getRcmdr("error.text.color")
warning.text.color <- getRcmdr("warning.text.color")
prefixes <- getRcmdr("prefixes")
multiple.select.mode <- getRcmdr("multiple.select.mode")
suppress.X11.warnings <- getRcmdr("suppress.X11.warnings")
showData.threshold <- getRcmdr("showData.threshold")
retain.messages <- getRcmdr("retain.messages")
crisp.dialogs <- getRcmdr("crisp.dialogs")
length.output.stack <- getRcmdr("length.output.stack")
length.command.stack <- getRcmdr("length.command.stack")
quit.R.on.close <- getRcmdr("quit.R.on.close")
variable.list.height <- getRcmdr("variable.list.height")
variable.list.width <- getRcmdr("variable.list.width")
placement <- setOption("placement", "")
suppress.menus <- getRcmdr("suppress.menus")
rmd.template <- getRcmdr("rmd.template")
rmd.standard <- system.file("etc", "Rcmdr-Markdown-Template.Rmd", package="Rcmdr")
rnw.template <- getRcmdr("rnw.template")
rnw.standard <- system.file("etc", "Rcmdr-knitr-Template.Rnw", package="Rcmdr")
use.rgl <- setOption("use.rgl", TRUE)
model.case.deletion <- setOption("model.case.deletion", FALSE)
checkBoxes(closeTab, frame="closeOptionsFrame", boxes=c("askToExit", "askOnExit", "quitR"),
initialValues=c(ask.to.exit, ask.on.exit, quit.R.on.close),
labels=gettextRcmdr("Ask to exit Commander", "Ask to save documents on exit", "Quit R on exit"))
checkBoxes(outputTab, frame="outputOptionsFrame",
boxes=c("consoleOutput", "logCommands", "numberMessages", "retainMessages", "useMarkdown", "useKnitr"),
initialValues=c(console.output, log.commands, number.messages, retain.messages, use.markdown, use.knitr),
labels=gettextRcmdr("Send output to R Console", "Log commands to script window", "Number messages",
"Retain messages", "Use R Markown", "Use knitr"))
env <- environment()
hex <- col2hex(c(log.text.color, command.text.color, output.text.color,
error.text.color, warning.text.color, title.color))
for (i in 1:6) assign(paste("hex", i, sep="."), hex[i], envir=env)
fontColorsFrame <- tkframe(fontTab)
colorField1 <- labelRcmdr(fontColorsFrame, text=rgb2col(hex[1]), fg=hex[1])
button1 <- tkbutton(fontColorsFrame, text=hex[1], bg = hex[1], width="10",
fg=convert(hex[1]),
command=function() {
color <- pickColor(hex[1], parent=button1)
fg <- convert(color)
tkconfigure(button1, bg=color, fg=fg, text=toupper(color))
tkconfigure(colorField1, text=rgb2col(color), foreground=color)
assign("hex.1", color, envir=env)
}
)
colorField2 <- labelRcmdr(fontColorsFrame, text=rgb2col(hex[2]), fg=hex[2])
button2 <- tkbutton(fontColorsFrame, text=hex[2], bg = hex[2], width="10",
fg=convert(hex[2]),
command=function() {
color <- pickColor(hex[2], parent=button2)
fg <- convert(color)
tkconfigure(button2, bg=color, fg=fg, text=toupper(color))
tkconfigure(colorField2, text=rgb2col(color), foreground=color)
assign("hex.2", color, envir=env)
}
)
colorField3 <- labelRcmdr(fontColorsFrame, text=rgb2col(hex[3]), fg=hex[3])
button3 <- tkbutton(fontColorsFrame, text=hex[3], bg = hex[3], width="10",
fg=convert(hex[3]),
command=function() {
color <- pickColor(hex[3], parent=button3)
fg <- convert(color)
tkconfigure(button3, bg=color, fg=fg, text=toupper(color))
tkconfigure(colorField3, text=rgb2col(color), foreground=color)
assign("hex.3", color, envir=env)
}
)
colorField4 <- labelRcmdr(fontColorsFrame, text=rgb2col(hex[4]), fg=hex[4])
button4 <- tkbutton(fontColorsFrame, text=hex[4], bg = hex[4], width="10",
fg=convert(hex[4]),
command=function() {
color <- pickColor(hex[4], parent=button4)
fg <- convert(color)
tkconfigure(button4, bg=color, fg=fg, text=toupper(color))
tkconfigure(colorField4, text=rgb2col(color), foreground=color)
assign("hex.4", color, envir=env)
}
)
colorField5 <- labelRcmdr(fontColorsFrame, text=rgb2col(hex[5]), fg=hex[5])
button5 <- tkbutton(fontColorsFrame, text=hex[5], bg = hex[5], width="10",
fg=convert(hex[5]),
command=function() {
color <- pickColor(hex[5], parent=button5)
fg <- convert(color)
tkconfigure(button5, bg=color, fg=fg, text=toupper(color))
tkconfigure(colorField5, text=rgb2col(color), foreground=color)
assign("hex.5", color, envir=env)
}
)
colorField6 <- labelRcmdr(fontColorsFrame, text=rgb2col(hex[6]), fg=hex[6])
button6 <- tkbutton(fontColorsFrame, text=hex[6], bg = hex[6], width="10",
fg=convert(hex[6]),
command=function() {
color <- pickColor(hex[6], parent=button6)
fg <- convert(color)
tkconfigure(button6, bg=color, fg=fg, text=toupper(color))
tkconfigure(colorField6, text=rgb2col(color), foreground=color)
assign("hex.6", color, envir=env)
}
)
logFontSizeVar <- tclVar(log.font.size)
fontFrame <- tkframe(fontTab)
logFontSizeSlider <- tkscale(fontFrame, from=6, to=20, showvalue=TRUE, variable=logFontSizeVar,
resolution=1, orient="horizontal")
logWidthVar <- tclVar(log.width)
outputSliderFrame <- tkframe(outputTab)
logWidthSlider <- tkscale(outputSliderFrame, from=30, to=120, showvalue=TRUE, variable=logWidthVar,
resolution=5, orient="horizontal")
logHeightVar <- tclVar(log.height)
logHeightSlider <- tkscale(outputSliderFrame, from=0, to=25, showvalue=TRUE, variable=logHeightVar,
resolution=1, orient="horizontal")
outputHeightVar <- tclVar(output.height)
outputHeightSlider <- tkscale(outputSliderFrame, from=0, to=50, showvalue=TRUE, variable=outputHeightVar,
resolution=5, orient="horizontal")
messagesHeightVar <- tclVar(messages.height)
messagesHeightSlider <- tkscale(outputSliderFrame, from=0, to=10, showvalue=TRUE, variable=messagesHeightVar,
resolution=1, orient="horizontal")
scientificNotationSliderFrame <- tkframe(outputTab)
scientificNotationVar <- tclVar(scientific.notation)
scientificNotartionSlider <- tkscale(scientificNotationSliderFrame, from=0, to=10, showvalue=TRUE, variable=scientificNotationVar,
resolution=1, orient="horizontal")
contrasts1 <- tclVar(contrasts[1])
contrasts2 <- tclVar(contrasts[2])
contrastsFrame <- tkframe(otherTab)
contrasts1Entry <- ttkentry(contrastsFrame, width="15", textvariable=contrasts1)
contrasts2Entry <- ttkentry(contrastsFrame, width="15", textvariable=contrasts2)
checkBoxes(otherTab, frame="otherOptionsFrame",
boxes=c("grabFocus", "doubleClick", "sortNames", "showEditButton", "SuppressIconImages",
"retainSelections", "useRgl", "modelCaseDeletion"),
initialValues=c(grab.focus, double.click, sort.names, show.edit.button, suppress.icon.images,
retain.selections, use.rgl, model.case.deletion),
labels=gettextRcmdr("Active window grabs focus", "Double-click presses OK button",
"Sort variable names alphabetically", "Show edit button",
"Suppress icon images", "Retain dialog selections", "Use rgl package",
"Include case-deletion box in statistical model dialogs")
)
scaleFactorFrame <- tkframe(otherTab)
scaleFactorVar <- tclVar(if (is.null(scale.factor)) 1.0 else scale.factor)
scaleFactorSlider <- tkscale(scaleFactorFrame, from=0.2, to=3.0, showvalue=TRUE, variable=scaleFactorVar,
resolution=0.2, orient="horizontal")
defaultFontSizeVar <- tclVar(default.font.size)
defaultFontSizeSlider <- tkscale(fontFrame, from=6, to=20, showvalue=TRUE, variable=defaultFontSizeVar,
resolution=1, orient="horizontal")
logFontFamilyVar <- tclVar(log.font.family)
defaultFontFamilyVar <- tclVar(default.font.family)
logFontEntry <- ttkentry(fontFrame, width="20", textvariable=logFontFamilyVar)
defaultFontEntry <- ttkentry(fontFrame, width="20", textvariable=defaultFontFamilyVar)
rmdTemplateVar <- tclVar(rmd.template)
templateFrame <- tkframe(outputTab)
rmdTemplateEntry <- ttkentry(templateFrame, width="75", textvariable=rmdTemplateVar)
onSelectTemplate <- function(){
templateFile <- tclvalue(tkgetOpenFile(filetypes=gettextRcmdr('{"All Files" {"*"}} {"R Markdown Files" {".Rmd" ".rmd"}}'),
defaultextension="Rmd",
parent=outputTab))
if (templateFile == "") return()
tclvalue(rmdTemplateVar) <- templateFile
return(NULL)
}
templateButton <- buttonRcmdr(templateFrame, text=gettextRcmdr("Select file"), command=onSelectTemplate)
rnwTemplateVar <- tclVar(rnw.template)
rnwTemplateEntry <- ttkentry(templateFrame, width="75", textvariable=rnwTemplateVar)
onSelectRnwTemplate <- function(){
rnwTemplateFile <- tclvalue(tkgetOpenFile(filetypes=gettextRcmdr('{"All Files" {"*"}} {"knitr Files" {".Rnw" ".rnw" ".Snw" ".snw"}}'),
defaultextension="Rnw",
parent=outputTab))
if (rnwTemplateFile == "") return()
tclvalue(rnwTemplateVar) <- rnwTemplateFile
return(NULL)
}
rnwTemplateButton <- buttonRcmdr(templateFrame, text=gettextRcmdr("Select file"), command=onSelectRnwTemplate)
all.themes <- tk2theme.list()
current.theme <- tk2theme()
all.themes <- union(current.theme, all.themes)
themesBox <- variableListBox(otherTab, all.themes,
title = gettextRcmdr("Theme (pick one)"),
initialSelection = varPosn(current.theme, vars=all.themes))
onOK <- function(){
theme <- getSelection(themesBox)
closeDialog(top)
ask.to.exit <- asLogical(tclvalue(askToExitVariable))
ask.on.exit <- asLogical(tclvalue(askOnExitVariable))
quit.R.on.close <- asLogical(tclvalue(quitRVariable))
console.output <- asLogical(tclvalue(consoleOutputVariable))
number.messages <- asLogical(tclvalue(numberMessagesVariable))
retain.messages <- asLogical(tclvalue(retainMessagesVariable))
use.markdown <- asLogical(tclvalue(useMarkdownVariable))
use.knitr<- asLogical(tclvalue(useKnitrVariable))
rmd.template <- tclvalue(rmdTemplateVar)
if (rmd.template == rmd.standard) rmd.template <- NULL
rnw.template <- tclvalue(rnwTemplateVar)
if (rnw.template == rnw.standard) rnw.template <- NULL
log.font.family <- tclvalue(logFontFamilyVar)
default.font.family <- tclvalue(defaultFontFamilyVar)
log.font.size <- round(as.numeric(tclvalue(logFontSizeVar)))
default.font.size <- tclvalue(defaultFontSizeVar)
scale.factor <- round(as.numeric(tclvalue(scaleFactorVar)), 1)
if (scale.factor == 1) scale.factor <- NULL
log.width <- round(as.numeric(tclvalue(logWidthVar)))
log.height <- as.numeric(tclvalue(logHeightVar))
log.commands <- asLogical(tclvalue(logCommandsVariable)) && (log.height != 0)
output.height <- as.numeric(tclvalue(outputHeightVar))
scientific.notation <- as.numeric(tclvalue(scientificNotationVar))
console.output <- asLogical(tclvalue(consoleOutputVariable)) || (output.height == 0)
contrasts <- c(tclvalue(contrasts1), tclvalue(contrasts2))
grab.focus <- asLogical(tclvalue(grabFocusVariable))
double.click <- asLogical(tclvalue(doubleClickVariable))
sort.names <- asLogical(tclvalue(sortNamesVariable))
show.edit.button <- asLogical(tclvalue(showEditButtonVariable))
suppress.icon.images <- asLogical(tclvalue(SuppressIconImagesVariable))
retain.selections <- asLogical(tclvalue(retainSelectionsVariable))
use.rgl <- asLogical(tclvalue(useRglVariable))
model.case.deletion <- asLogical(tclvalue(modelCaseDeletionVariable))
options <- current
options$ask.to.exit <- ask.to.exit
options$ask.on.exit <- ask.on.exit
options$quit.R.on.close <- quit.R.on.close
options$number.messages <- number.messages
options$retain.messages <- retain.messages
options$use.markdown <- use.markdown
options$rmd.template <- rmd.template
options$use.knitr <- use.knitr
options$rnw.template <- rnw.template
options$log.font.family <- log.font.family
options$default.font.family <- default.font.family
options$log.font.size <- log.font.size
options$default.font.size <- default.font.size
options$scale.factor <- scale.factor
options$log.width <- log.width
options$log.height <- log.height
options$log.commands <- log.commands
options$output.height <- output.height
options$scientific.notation <- scientific.notation
options$console.output <- console.output
options$default.contrasts <- contrasts
options$grab.focus <- grab.focus
options$double.click <- double.click
options$sort.names <- sort.names
options$show.edit.button <- show.edit.button
options$suppress.icon.images <- suppress.icon.images
options$retain.selections <- retain.selections
options$use.rgl <- use.rgl
options$model.case.deletion <- model.case.deletion
colors <- c(hex.1, hex.2, hex.3, hex.4, hex.5, hex.6)
colors <- rgb2col(colors)
options$log.text.color <- colors[1]
options$command.text.color <- colors[2]
options$output.text.color <- colors[3]
options$error.text.color <- colors[4]
options$warning.text.color <- colors[5]
options$title.color <- colors[6]
options$theme <- theme
options(Rcmdr=options)
closeCommander()
Commander()
}
OKCancelHelp(helpSubject="Commander")
tkgrid(closeOptionsFrame, sticky="nw")
tkgrid(labelRcmdr(fontFrame, text=gettextRcmdr("Dialog text font size (points)")), defaultFontSizeSlider, sticky="sw", padx=6)
tkgrid(labelRcmdr(fontFrame, text=gettextRcmdr("Script and output font size (points)")), logFontSizeSlider, sticky="sw", padx=6)
tkgrid(labelRcmdr(fontFrame, text=gettextRcmdr("Dialog font")), defaultFontEntry, sticky="w", padx=6)
tkgrid(labelRcmdr(fontFrame, text=gettextRcmdr("Script and output font")), logFontEntry, sticky="w", padx=6)
tkgrid(fontFrame, sticky="w")
tkgrid(labelRcmdr(fontTab, text=""))
pal <- c(log.text.color, command.text.color, output.text.color, error.text.color, warning.text.color, title.color)
tkgrid(labelRcmdr(fontColorsFrame, text=gettextRcmdr("Script text color ")), button1, colorField1, sticky="w", padx=6)
tkgrid(labelRcmdr(fontColorsFrame, text=gettextRcmdr("Command text color ")), button2, colorField2, sticky="w", padx=6)
tkgrid(labelRcmdr(fontColorsFrame, text=gettextRcmdr("Output text color ")), button3, colorField3, sticky="w", padx=6)
tkgrid(labelRcmdr(fontColorsFrame, text=gettextRcmdr("Error text color ")), button4, colorField4, sticky="w", padx=6)
tkgrid(labelRcmdr(fontColorsFrame, text=gettextRcmdr("Warning text color ")), button5, colorField5, sticky="w", padx=6)
tkgrid(labelRcmdr(fontColorsFrame, text=gettextRcmdr("Dialog subtitles text color ")), button6, colorField6, sticky="w", padx=6)
tkgrid(fontColorsFrame, sticky="w")
tkgrid(labelRcmdr(outputSliderFrame, text=gettextRcmdr("Script window width (characters)")), logWidthSlider, sticky="sw", padx=6)
tkgrid(labelRcmdr(outputSliderFrame, text=gettextRcmdr("Script window height (lines)")), logHeightSlider, sticky="sw", padx=6)
tkgrid(labelRcmdr(outputSliderFrame, text=gettextRcmdr("Output window height (lines)")), outputHeightSlider, sticky="sw", padx=6)
tkgrid(labelRcmdr(outputSliderFrame, text=gettextRcmdr("Messages window height (lines)")), messagesHeightSlider, sticky="sw", padx=6)
tkgrid(outputSliderFrame, sticky="w")
tkgrid(labelRcmdr(scientificNotationSliderFrame, text=gettextRcmdr("Suppress scientific notation\n(higher = more suppression)")),
scientificNotartionSlider, sticky="sw", padx=6)
tkgrid(scientificNotationSliderFrame, sticky="w")
tkgrid(labelRcmdr(outputTab, text=" "), sticky="w")
tkgrid(outputOptionsFrame, sticky="nw", columnspan = 3)
tkgrid(labelRcmdr(templateFrame, text=gettextRcmdr("R Markdown template file")), rmdTemplateEntry, templateButton, sticky="w", padx=6)
tkgrid(templateFrame, columnspan=2, sticky="w")
tkgrid(labelRcmdr(templateFrame, text=gettextRcmdr("R knitr template file")), rnwTemplateEntry, rnwTemplateButton, sticky="w", padx=6)
tkgrid(labelRcmdr(scaleFactorFrame, text=gettextRcmdr("Scale factor for Tk elements")), scaleFactorSlider, sticky="sw")
tkgrid(scaleFactorFrame, sticky="w")
tkgrid(labelRcmdr(otherTab, text=""))
tkgrid(labelRcmdr(contrastsFrame, text=""), labelRcmdr(contrastsFrame, text=gettextRcmdr("Unordered factors")), labelRcmdr(contrastsFrame, text=" "),
labelRcmdr(contrastsFrame, text=gettextRcmdr("Ordered factors")), sticky="w")
tkgrid(labelRcmdr(contrastsFrame, text=gettextRcmdr("Contrasts")), contrasts1Entry, labelRcmdr(contrastsFrame, text=" "), contrasts2Entry, sticky="sw")
tkgrid(contrastsFrame, sticky="sw")
tkgrid(labelRcmdr(otherTab, text=" "), sticky="w")
tkgrid(otherOptionsFrame, sticky="w", columnspan=2)
tkgrid(labelRcmdr(otherTab, text=""))
tkgrid(getFrame(themesBox), sticky="w")
tkgrid(labelRcmdr(otherTab, text=""))
tkadd(notebook, closeTab, text=gettextRcmdr("Exit"), padding=6)
tkadd(notebook, fontTab, text=gettextRcmdr("Fonts"), padding=6)
tkadd(notebook, outputTab, text=gettextRcmdr("Output"), padding=6)
tkadd(notebook, otherTab, text=gettextRcmdr("Other Options"), padding=6)
tkgrid(notebook)
tkconfigure(OKbutton, text=gettextRcmdr("Restart R Commander"), width=20)
tkgrid(buttonsFrame, columnspan=3, sticky="ew")
dialogSuffix()
}
saveOptions <- function(){
initializeDialog(title=gettextRcmdr("Save Commander Options"))
onCopy <- function(){
focused <- tkfocus()
if (tclvalue(focused) != optionsWindow$ID) focused <- optionsWindow
selection <- strsplit(tclvalue(tktag.ranges(focused, "sel")), " ")[[1]]
if (is.na(selection[1])) return()
text <- tclvalue(tkget(focused, selection[1], selection[2]))
tkclipboard.clear()
tkclipboard.append(text)
}
onDelete <- function(){
focused <- tkfocus()
if (tclvalue(focused) != optionsWindow$ID) focused <- optionsWindow
selection <- strsplit(tclvalue(tktag.ranges(focused, "sel")), " ")[[1]]
if (is.na(selection[1])) return()
tkdelete(focused, selection[1], selection[2])
}
onCut <- function(){
onCopy()
onDelete()
}
onPaste <- function(){
onDelete()
focused <- tkfocus()
if (tclvalue(focused) != optionsWindow$ID) focused <- optionsWindow
text <- tclvalue(.Tcl("selection get -selection CLIPBOARD"))
if (length(text) == 0) return()
tkinsert(focused, "insert", text)
}
onFind <- function(){
focused <- tkfocus()
if (tclvalue(focused) != optionsWindow$ID) focused <- optionsWindow
initializeDialog(title=gettextRcmdr("Find"))
textFrame <- tkframe(top)
textVar <- tclVar(getRcmdr("last.search"))
textEntry <- ttkentry(textFrame, width="20", textvariable=textVar)
checkBoxes(frame="optionsFrame", boxes=c("regexpr", "case"), initialValues=c("0", "1"),
labels=gettextRcmdr(c("Regular-expression search", "Case sensitive")))
radioButtons(name="direction", buttons=c("foward", "backward"), labels=gettextRcmdr(c("Forward", "Backward")),
values=c("-forward", "-backward"), title=gettextRcmdr("Search Direction"))
onOK <- function(){
text <- tclvalue(textVar)
putRcmdr("last.search", text)
if (text == ""){
errorCondition(recall=onFind, message=gettextRcmdr("No search text specified."))
return()
}
type <- if (tclvalue(regexprVariable) == 1) "-regexp" else "-exact"
case <- tclvalue(caseVariable) == 1
direction <- tclvalue(directionVariable)
stop <- if (direction == "-forward") "end" else "1.0"
where <- if (case) tksearch(focused, type, direction, "--", text, "insert", stop)
else tksearch(focused, type, direction, "-nocase", "--", text, "insert", stop)
where <- tclvalue(where)
if (where == "") {
Message(message=gettextRcmdr("Text not found."),
type="note")
if (GrabFocus()) tkgrab.release(top)
tkdestroy(top)
tkfocus(CommanderWindow())
return()
}
if (GrabFocus()) tkgrab.release(top)
tkfocus(focused)
tkmark.set(focused, "insert", where)
tksee(focused, where)
tkdestroy(top)
}
.exit <- function(){
text <- tclvalue(textVar)
putRcmdr("last.search", text)
return("")
}
OKCancelHelp()
tkgrid(labelRcmdr(textFrame, text=gettextRcmdr("Search for:")), textEntry, sticky="w")
tkgrid(textFrame, sticky="w")
tkgrid(optionsFrame, sticky="w")
tkgrid(directionFrame, sticky="w")
tkgrid(buttonsFrame, sticky="w")
dialogSuffix(focus=textEntry)
}
onSelectAll <- function() {
focused <- tkfocus()
if (tclvalue(focused) != optionsWindow$ID) focused <- optionsWindow
tktag.add(focused, "sel", "1.0", "end")
tkfocus(focused)
}
onClear <- function(){
onSelectAll()
onDelete()
}
onUndo <- function(){
focused <- tkfocus()
if (tclvalue(focused) != optionsWindow$ID) focused <- optionsWindow
tcl(focused, "edit", "undo")
}
onRedo <- function(){
focused <- tkfocus()
if (tclvalue(focused) != optionsWindow$ID) focused <- optionsWindow
tcl(focused, "edit", "redo")
}
onOK <- function(){
optionsFile <- tclvalue(tkgetSaveFile(filetypes=gettextRcmdr('{"All Files" {"*"}}'),
initialfile=".Rprofile",
parent=top))
if (optionsFile == "") return()
options <- tclvalue(tkget(optionsWindow, "1.0", "end"))
fileCon <- file(optionsFile, "w")
cat(options, file = fileCon)
close(fileCon)
closeDialog(top)
Message(paste(gettextRcmdr("R Profile saved to"), optionsFile), type="note")
}
contextMenu <- function(){
contextMenu <- tkmenu(tkmenu(optionsWindow), tearoff=FALSE)
tkadd(contextMenu, "command", label=gettextRcmdr("Cut"), command=onCut)
tkadd(contextMenu, "command", label=gettextRcmdr("Copy"), command=onCopy)
tkadd(contextMenu, "command", label=gettextRcmdr("Paste"), command=onPaste)
tkadd(contextMenu, "command", label=gettextRcmdr("Delete"), command=onDelete)
tkadd(contextMenu, "separator")
tkadd(contextMenu, "command", label=gettextRcmdr("Find..."), command=onFind)
tkadd(contextMenu, "command", label=gettextRcmdr("Select all"), command=onSelectAll)
tkadd(contextMenu, "separator")
tkadd(contextMenu, "command", label=gettextRcmdr("Undo"), command=onUndo)
tkadd(contextMenu, "command", label=gettextRcmdr("Redo"), command=onRedo)
tkadd(contextMenu, "separator")
tkadd(contextMenu, "command", label=gettextRcmdr("Clear window"), command=onClear)
tkpopup(contextMenu, tkwinfo("pointerx", optionsWindow), tkwinfo("pointery", optionsWindow))
}
optionsFrame <- tkframe(top)
optionsWindow <- tktext(optionsFrame, bg="white", foreground=getRcmdr("log.text.color"),
font=getRcmdr("logFont"), height=20, width=65, wrap="none", undo=TRUE)
optionsXscroll <- ttkscrollbar(optionsFrame, orient="horizontal",
command=function(...) tkxview(optionsWindow, ...))
optionsYscroll <- ttkscrollbar(optionsFrame,
command=function(...) tkyview(optionsWindow, ...))
tkconfigure(optionsWindow, xscrollcommand=function(...) tkset(optionsXscroll, ...))
tkconfigure(optionsWindow, yscrollcommand=function(...) tkset(optionsYscroll, ...))
tkbind(top, "<Control-x>", onCut)
tkbind(top, "<Control-X>", onCut)
tkbind(top, "<Control-c>", onCopy)
tkbind(top, "<Control-C>", onCopy)
tkbind(top, "<Control-f>", onFind)
tkbind(top, "<Control-F>", onFind)
tkbind(top, "<F3>", onFind)
tkbind(top, "<Control-a>", onSelectAll)
tkbind(top, "<Control-A>", onSelectAll)
tkbind(top, "<Control-w>", onRedo)
tkbind(top, "<Control-W>", onRedo)
if (MacOSXP()){
tkbind(top, "<Meta-x>", onCut)
tkbind(top, "<Meta-X>", onCut)
tkbind(top, "<Meta-c>", onCopy)
tkbind(top, "<Meta-C>", onCopy)
tkbind(top, "<Meta-v>", onPaste)
tkbind(top, "<Meta-V>", onPaste)
tkbind(top, "<Meta-f>", onFind)
tkbind(top, "<Meta-F>", onFind)
tkbind(top, "<Meta-a>", onSelectAll)
tkbind(top, "<Meta-A>", onSelectAll)
tkbind(top, "<Meta-w>", onRedo)
tkbind(top, "<Meta-W>", onRedo)
tkbind(top, "<Meta-z>", onUndo)
tkbind(top, "<Meta-Z>", onUndo)
tkbind(top, "<Shift-Meta-z>", onRedo)
tkbind(top, "<Shift-Meta-Z>", onRedo)
}
tkbind(top, "<Alt-BackSpace>", onUndo)
tkbind(optionsWindow, "<ButtonPress-3>", contextMenu)
OKCancelHelp(helpSubject="saveOptions")
menu <- tkmenu(top)
tkconfigure(top, menu=menu)
editMenu <- tkmenu(menu, tearoff=FALSE)
tkadd(editMenu, "command", label=gettextRcmdr("Cut"), command=onCut)
tkadd(editMenu, "command", label=gettextRcmdr("Copy"), command=onCopy)
tkadd(editMenu, "command", label=gettextRcmdr("Paste"), command=onPaste)
tkadd(editMenu, "command", label=gettextRcmdr("Delete"), command=onDelete)
tkadd(editMenu, "separator")
tkadd(editMenu, "command", label=gettextRcmdr("Find..."), command=onFind)
tkadd(editMenu, "command", label=gettextRcmdr("Select all"), command=onSelectAll)
tkadd(editMenu, "separator")
tkadd(editMenu, "command", label=gettextRcmdr("Undo"), command=onUndo)
tkadd(editMenu, "command", label=gettextRcmdr("Redo"), command=onRedo)
tkadd(editMenu, "separator")
tkadd(editMenu, "command", label=gettextRcmdr("Clear window"), command=onClear)
tkadd(menu, "cascade", label=gettextRcmdr("Edit"), menu=editMenu)
Rprofile <- if (file.exists(".Rprofile")) readLines(".Rprofile") else ""
start <- grep("^###! Rcmdr Options Begin !###", Rprofile)
end <- grep("^###! Rcmdr Options End !###", Rprofile)
if (length(start) == 1 && length(end) == 1){
Rprofile <- Rprofile[-(start:end)]
}
Rprofile <- sub("\\n*$", "", Rprofile)
tkinsert(optionsWindow, "end", paste(Rprofile, collapse="\n"))
options <- getOption("Rcmdr")
con <- file(open="w+")
dput(options, con)
options <- readLines(con)
close(con)
options <- paste(c("", "",
"###! Rcmdr Options Begin !###",
"options(Rcmdr=",
options,
")",
"",
"# Uncomment the following 4 lines (remove the #s)",
"# to start the R Commander automatically when R starts:",
"",
"# local({",
"# old <- getOption('defaultPackages')",
"# options(defaultPackages = c(old, 'Rcmdr'))",
"# })",
"",
"###! Rcmdr Options End !###"),
collapse="\n"
)
tkinsert(optionsWindow, "end", options)
tkgrid(labelRcmdr(top, text=
paste(gettextRcmdr("The following commands will be saved in the file .Rprofile.",
"You may edit this file before saving it."), collapse="\n")),
sticky="w")
tkgrid(optionsWindow, optionsYscroll, sticky="news")
tkgrid(optionsXscroll, sticky="ew", columnspan=2)
tkgrid(optionsFrame, sticky="news", padx=10, pady=0)
tkgrid(buttonsFrame, sticky="ew")
dialogSuffix(bindReturn=FALSE)
}
loadPackages <- function(){
availablePackages <- sort(setdiff(.packages(all.available = TRUE), .packages()))
if (length(availablePackages) == 0){
errorCondition(message=gettextRcmdr("No packages available to load."))
return()
}
initializeDialog(title=gettextRcmdr("Load Packages"))
packagesBox <- variableListBox(top, availablePackages, title=gettextRcmdr("Packages (pick one or more)"),
selectmode="multiple", listHeight=10)
onOK <- function(){
packages <- getSelection(packagesBox)
closeDialog(top)
if (length(packages) == 0){
errorCondition(recall=loadPackages, message=gettextRcmdr("You must select at least one package."))
return()
}
for (package in packages) {
Library(package)
}
Message(paste(gettextRcmdr("Packages loaded:"), paste(packages, collapse=", ")), type="note")
}
OKCancelHelp(helpSubject="library")
tkgrid(getFrame(packagesBox), sticky="nw")
tkgrid(buttonsFrame, sticky="w")
dialogSuffix()
}
Setwd <- function(){
wd <- tclvalue(tkchooseDirectory(initialdir=getwd(), parent=CommanderWindow()))
if (wd != "") doItAndPrint(paste('setwd("', wd, '")', sep=""))
}
editMarkdown <- function(){
.rmd <- RmdWindow()
buffer <- tclvalue(tkget(.rmd, "1.0", "end"))
compile <- function() {
.rmd <- RmdWindow()
editor <- getRcmdr("editor.text")
buffer <- tclvalue(tkget(editor, "1.0", "end"))
tkdelete(.rmd, "1.0", "end")
tkinsert(.rmd, "end", buffer)
compileRmd()
}
removeLastBlock <- function(){
.rmd <- RmdWindow()
editor <- getRcmdr("editor.text")
buffer <- tclvalue(tkget(editor, "1.0", "end"))
tkdelete(.rmd, "1.0", "end")
tkinsert(.rmd, "end", buffer)
removeLastRmdBlock()
buffer <- tclvalue(tkget(.rmd, "1.0", "end"))
tkdelete(editor, "1.0", "end")
tkinsert(editor, "end", buffer)
}
saveEdits <- function(){
.rmd <- RmdWindow()
editor <- getRcmdr("editor.text")
buffer <- tclvalue(tkget(editor, "1.0", "end"))
tkdelete(.rmd, "1.0", "end")
tkinsert(.rmd, "end", buffer)
tkyview.moveto(.rmd, 1)
}
ok <- function(){
.rmd <- RmdWindow()
editor <- getRcmdr("editor.text")
buffer <- tclvalue(tkget(editor, "1.0", "end"))
tkdelete(.rmd, "1.0", "end")
tkinsert(.rmd, "end", buffer)
tkyview.moveto(.rmd, 1)
}
RcmdrEditor(buffer, title="Edit R Markdown document", ok=ok,
help=list(label="Using R Markdown", command=browseRMarkdown),
file.menu=list(list(label="Generate report", command=compile),
list(label="Save current edits", command=saveEdits)),
edit.menu=list(list(label="Remove last Markdown block", command=removeLastRmdBlock),
list(label="Remove last Markdown section title", command=removeLastRmdSection)),
toolbar.buttons=list(list(label="Generate report", command=compile, image="::image::submitIcon"),
list(label="Save edits", command=saveEdits, image="::image::saveEditsIcon")))
}
editKnitr <- function(){
.rnw <- RnwWindow()
buffer <- tclvalue(tkget(.rnw, "1.0", "end"))
compile <- function() {
.rnw <- RnwWindow()
editor <- getRcmdr("editor.text")
buffer <- tclvalue(tkget(editor, "1.0", "end"))
tkdelete(.rnw, "1.0", "end")
tkinsert(.rnw, "end", buffer)
compileRnw()
}
saveEdits <- function(){
.rnw <- RnwWindow()
editor <- getRcmdr("editor.text")
buffer <- tclvalue(tkget(editor, "1.0", "end"))
tkdelete(.rnw, "1.0", "end")
tkinsert(.rnw, "end", buffer)
tkyview.moveto(.rnw, 1)
}
removeLastBlock <- function(){
.rnw <- RnwWindow()
editor <- getRcmdr("editor.text")
buffer <- tclvalue(tkget(editor, "1.0", "end"))
tkdelete(.rnw, "1.0", "end")
tkinsert(.rnw, "end", buffer)
removeLastRnwBlock()
buffer <- tclvalue(tkget(.rnw, "1.0", "end"))
tkdelete(editor, "1.0", "end")
tkinsert(editor, "end", buffer)
}
ok <- function(){
.rnw <- RnwWindow()
editor <- getRcmdr("editor.text")
buffer <- tclvalue(tkget(editor, "1.0", "end"))
tkdelete(.rnw, "1.0", "end")
tkinsert(.rnw, "end", buffer)
tkyview.moveto(.rnw, 1)
}
RcmdrEditor(buffer, title="Edit knitr document", ok=ok,
file.menu=list(list(label="Generate PDF report", command=compile), list(label="Save current edits", command=saveEdits)),
toolbar.buttons=list(list(label="Generate PDF report", command=compile, image="::image::submitIcon"),
list(label="Save edits", command=saveEdits, image="::image::saveEditsIcon")))
}
appNap <- function(){
initializeDialog(title=gettextRcmdr("Mac OS X app nap for R.app"))
radioButtons(name="appnap", buttons=c("off", "on"), labels=gettextRcmdr(c("off (recommended)", "on")),
title=gettextRcmdr("Set app nap"), initialValue=appnap())
onOK <- function(){
setting <- tclvalue(appnapVariable)
appnap(setting)
closeDialog()
}
OKCancelHelp(helpSubject="Commander")
tkgrid(appnapFrame, sticky="w")
tkgrid(buttonsFrame, sticky="ew")
dialogSuffix()
}
installSoftware <- function(){
initializeDialog(title=gettextRcmdr("Install Auxiliary Software"))
has <- unlist(getRcmdr("capabilities"))
installed <- c("", gettextRcmdr("(already installed)"))[1 + has]
checkBoxes(frame="selectSoftwareFrame", boxes=c("latex", "pandoc"),
initialValues=!as.numeric(has),
labels=paste(gettextRcmdr(c("LaTeX", "Pandoc")), installed),
title=gettextRcmdr("Software to Install"))
onOK <- function(){
if (tclvalue(latexVariable) == "1"){
if (WindowsP()) browseURL("https://miktex.org/download")
else if (MacOSXP()) browseURL("https://www.tug.org/mactex/")
else browseURL("https://www.latex-project.org/get/")
}
if (tclvalue(pandocVariable) == "1") browseURL("https://pandoc.org/installing.html")
closeDialog()
tkfocus(CommanderWindow())
}
OKCancelHelp(helpSubject="AuxiliarySoftware")
tkgrid(labelRcmdr(top, text = paste(
gettextRcmdr("Please read the help for this dialog\nbefore installing auxiliary software."), "\n")))
tkgrid(selectSoftwareFrame, sticky="w")
dialogSuffix(grid.buttons=TRUE)
}
# the following function suggested by Vilmantas Gegzna
# restartCommander <- function() {
# response <- tclvalue(RcmdrTkmessageBox(message=gettextRcmdr("Restart the Commander?"),
# icon="question", type="okcancel", default="cancel"))
# if (response == "cancel") return(invisible(response))
# else {
# response <- closeCommander(
# ask = getRcmdr("ask.to.exit"),
# ask.save = getRcmdr("ask.on.exit")
# )
# if (response == "cancel") return(invisible(response))
# else Commander()
# }
# }
restartCommander <- function(){
ask.save <- getRcmdr("ask.on.exit")
response <- tclvalue(RcmdrTkmessageBox(message=gettextRcmdr("Restart the Commander?"),
icon="question", type="okcancel", default="cancel"))
if (response == "cancel") return(invisible(response))
if (ask.save && getRcmdr("log.commands") && tclvalue(tkget(LogWindow(), "1.0", "end")) != "\n"){
response2 <- RcmdrTkmessageBox(message=gettextRcmdr("Save script file?"),
icon="question", type="yesno", default="yes")
if ("yes" == tclvalue(response2)) saveLog()
}
if (ask.save && getRcmdr("markdown.output") && getRcmdr("log.commands") && tclvalue(tkget(RmdWindow(), "1.0", "end")) != "\n"){
response2 <- RcmdrTkmessageBox(message=gettextRcmdr("Save R Markdown file?"),
icon="question", type="yesno", default="yes")
if ("yes" == tclvalue(response2)) saveRmd()
}
closeCommander(ask=FALSE)
Commander()
}
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.