Nothing
## three classes
## a main class to hold everything
## a class fto list the files
## a class for dispalying the files
## ChunkEditor class implements a simple editor for R code. The main widget comes
## from qtbase's qeditor, which has syntax highlighting. To this we add actions to
## evaluate a selection, the current line, the current chunk -- as defined by being within
## ### blocks (as generated by sweave, say), or the buffer
## The format button also formats R text, as there is no automatic indenting the way
## emacs does.
## @param parent -- not sure what this does, but super might
## @return a QWidget instance. Call its show method to create the GUI
qsetClass("ChunkEditor", Qt$QWidget, function(parent=NULL) {
super(parent)
## editor
# this$displayFile <- qeditor(tempfile(), rsyntax=TRUE)
this$displayFile <- Qt$QTextEdit()
## actions
this$closeGUIAction <- Qt$QAction("close", this)
this$sourceLineAction <- Qt$QAction("line", this)
this$sourceChunkAction <- Qt$QAction("chunk ", this)
this$sourceBufferAction <- Qt$QAction("buffer", this)
this$sourceSelectionAction <- Qt$QAction("selection", this)
this$formatBufferAction <- Qt$QAction("Format buffer", this)
this$helpAction <- Qt$QAction("Help", this)
this$actionNames <- c("sourceLine","sourceChunk","sourceBuffer",
"sourceSelection", "formatBuffer") ## not needed? , "closeGUI", "help")
## Emacs shortcuts -- not working
this$sourceLineAction$setShortcut(Qt$QKeySequence("Ctrl+C, Ctrl+J"))
this$sourceChunkAction$setShortcut(Qt$QKeySequence("Ctrl+C, Ctrl+C"))
this$sourceBufferAction$setShortcut(Qt$QKeySequence("Ctrl+C, Ctrl+B"))
this$sourceSelectionAction$setShortcut(Qt$QKeySequence("Ctrl+C, Ctrl+S")) # not sure of this binding
this$formatBufferAction$setShortcut(Qt$QKeySequence("Esc-Q"))
## triggered is key
## sapply(actionNames,
## function(i) {
## act <- get(sprintf("%sAction",i), envir=this)
## qconnect(act, "triggered", function(d) {
## get(d$methname, d$this)()
## })
## },
## user.data=list(this=this, methname=i))
qconnect(closeGUIAction, "triggered", closeGUI)
qconnect(sourceLineAction, "triggered", sourceLine)
qconnect(sourceChunkAction, "triggered", sourceChunk)
qconnect(sourceBufferAction, "triggered", sourceBuffer)
qconnect(sourceSelectionAction, "triggered", sourceSelection)
qconnect(formatBufferAction, "triggered", formatBuffer)
qconnect(helpAction, "triggered", Help)
})
## Make the GUI that contains the ChunkEditor. Has buttons on top
## @return widget to place into GUI
qsetMethod("makeGUI", ChunkEditor, function() {
widget <- this
lyt <- Qt$QVBoxLayout()
widget$setLayout(lyt)
blyt <- Qt$QHBoxLayout()
lyt$addLayout(blyt)
lyt$addWidget(this$displayFile, 10L) # stretch
this$displayFile$setSizePolicy(Qt$QSizePolicy$Expanding,
Qt$QSizePolicy$Expanding)
## add buttons
l <- Qt$QLabel(); l$text <- "Evaluate:"
blyt$addWidget(l)
sapply(this$actionNames, function(i) {
a <- get(sprintf("%sAction",i), envir=this)
b <- Qt$QPushButton()
assign(sprintf("%sButton",i), this)
b$addAction(a)
b$setText(a$text)
qconnect(b, "clicked", function(bool, a) a$trigger(), user.data=a)
qconnect(a, "changed", function(l) {
a <- l$a; b <- l$b
b$setText(a$text)
b$setEnabled(a$enabled)
}, user.data=list(a=a,b=b))
if(i %in% this$actionNames[1:4]) {
blyt$addWidget(b)
} else if(i == this$actionNames[5]) {
l <- Qt$QLabel(); l$text <- "|"
blyt$addWidget(l)
blyt$addWidget(b)
} else {
blyt$addWidget(b)
}
})
blyt$addStretch()
widget
})
## provide a simple help message
## @return NULL
qsetMethod("Help", ChunkEditor, function() {
mb <- Qt$QMessageBox(this)
mb$setWindowTitle("ChunkEditor")
mb$setText("A file editor with highlighting")
mb$setInformativeText(paste("You can source the file,",
"a chunk (between ### comments),",
"or the current line", sep="\n"))
mb$exec()
})
## function to update interface
## @return NULL
qsetMethod("updateInterface", ChunkEditor, function() {
})
## close GUI
## @return NULL
qsetMethod("closeGUI", ChunkEditor, function() {
this$close()
})
## load file into editor
## @param fname File name
## @return NULL
qsetMethod("loadFile", ChunkEditor, function(fname, fsource) {
if(!missing(fname) && nchar(fname) > 0) # XXX do a better check here
tmp <- readLines(fname)
else if(!missing(fsource))
tmp <- fsource
else
return()
edit <- this$displayFile
edit$clear()
sapply(tmp, function(i) {
edit$textCursor()$insertText(i)
edit$textCursor()$insertText("\n")
})
## move to front
cursor <- edit$textCursor()
cursor$setPosition(0)
edit$setTextCursor(cursor)
edit$ensureCursorVisible()
})
## Method to get various pieces of the buffer
##
## @param type what piece to get: entire buffer, the block as defined by three comment symbols, the current line, or the current selection
## @param return.text logical. If \code{TRUE} returns text, otherwise the selection anchor and position values.
## @return Either the text as a character vector or the selection bounds
qsetMethod("getText", ChunkEditor, function(type=c("buffer","block","line","selection"),
return.text=TRUE) {
cursor <- this$displayFile$textCursor()
## constants
QtMoveOperation <- c(Start=1, End=11, StartOfLine=3, EndOfLine=13, Up=2, Down=12)
blockRegexp <- "^\\s*[#]{3,}"
mc <- function(dir="Up", keep=0L) {
cursor$movePosition(QtMoveOperation[dir], keep)
}
grabLine <- function() {
mc("StartOfLine")
mc("EndOfLine", 1L)
a <- cursor$selectedText()
mc("StartOfLine")
a
}
type <- match.arg(type)
if(type == "line") {
mc("StartOfLine")
anchor <- cursor$anchor()
mc("EndOfLine", 1L)
position <- cursor$position()
} else if(type == "selection") {
anchor <- cursor$anchor()
position <- cursor$position()
} else if(type == "buffer") {
mc("End")
anchor=0L
position <- cursor$position()
} else {
## three steps:
## first get out of ### if in it
## then go back to first ###, mark anchor
## then go down to first ###, this is position
## select from anchor to position
## break out of ### if in one -- go down
a <- grabLine()
if(!is.null(a) && grepl(blockRegexp, a)) {
while(grepl(blockRegexp, a)) {
if(!mc("Down"))
break
a <- grabLine()
}
} else {
## Else move back until we get to ### or false
while(is.null(a) || !grepl(blockRegexp, a)) {
if(!mc("Up")) { # false if can't
mc("StartOfLine")
break
}
a <- grabLine()
}
}
## at beginning of block
a <- grabLine()
if(!is.null(a) && grepl(blockRegexp, a))
mc("Down")
anchor <- cursor$anchor()
## now move down until we hit a ### block
a <- grabLine()
while(!is.null(a) && !grepl(blockRegexp, a)) {
if(!mc("Down")) { # false if can't
mc("End")
break
}
a <- grabLine()
}
position <- cursor$position()
}
if(as.logical(return.text)) {
## now grab text
cursor$setPosition(anchor, 0L)
cursor$setPosition(position, 1L)
txt <- cursor$selectedText()
if(!is.null(txt))
txt <- unlist(strsplit(txt, "\u2029"))
return(txt)
} else {
return(c(anchor=anchor, position=position))
}
})
## Run a command
## @return runs the command, may print, ...
## @note can aoverride in subclass to make more interesting things
qsetMethod("runCommand", ChunkEditor, function(txt=character(0)) {
##' run the command, catch errors
if(is.null(txt) || !length(txt))
return()
out <- try(eval(parse(text=txt), envir=.GlobalEnv), silent=TRUE)
## CAREFUL, can't use "inherits" here -- it gets picked up as a method for ChunkEditor
# if(get("inherits")(out, "try-error"))
# cat("Error")
})
## source current line (through runCommand)
## @return calls runCommand
qsetMethod("sourceLine", ChunkEditor, function() {
txt <- this$getText(type="line")
this$runCommand(txt)
})
## source the current chunk
## @note a chunk is defined by being within blocks marked by ###. These are generated by
## Sweave, or can be typed in. The first block need not be demarked this way, nor need the
## last block.
## @return void
qsetMethod("sourceChunk", ChunkEditor, function() {
txt <- this$getText(type="block")
this$runCommand(txt)
})
## Source the buffer
## @return void
qsetMethod("sourceBuffer", ChunkEditor, function() {
txt <- this$getText(type="buffer")
this$runCommand(txt)
})
## Source the current selection, if set
## @return void
qsetMethod("sourceSelection", ChunkEditor, function() {
txt <- this$getText(type="selection")
this$runCommand(txt)
})
## format the buffer
## @return void
## @note Uses code from the formatR package and the animation package.
qsetMethod("formatBuffer", ChunkEditor, function() {
txt <- this$getText("buffer")
con = tempfile()
enc = getOption("encoding")
options(encoding = "native.enc")
on.exit(options(encoding = enc))
writeLines(txt, con)
tidy.opt = list(keep.comment = TRUE, keep.blank.line = TRUE,
width.cutoff = 60)
text.tidy = tidy.source(con, keep.comment = tidy.opt$keep.comment,
keep.blank.line = tidy.opt$keep.blank.line, width.cutoff = tidy.opt$width.cutoff,
output = FALSE)$text.tidy
## Encoding works on some platforms for multi-byte characters...
Encoding(text.tidy) = "UTF-8"
this$loadFile(fname="", fsource=unlist(strsplit(text.tidy,"\n")))
})
####################################################
## file selector class
## A simple file selector class for selection a file from the given directory
## @param dir the current direction to choose the file from
## @return sets the file into the ChunkEditor instance
qsetClass("FileSelector", Qt$QTableWidget, function(dir) {
if(missing(dir))
dir <- system.file("Examples","ch-Qt", package="ProgGUIinR")
this$dir <- dir # directory
## table widget to select file
this$setHorizontalHeaderItem(0, Qt$QTableWidgetItem("Files"))
this$verticalHeader()$setVisible(FALSE) # no rows
this$setAlternatingRowColors(TRUE) # alternate shade
header <- this$horizontalHeader() # stretch column
header$setStretchLastSection(TRUE)
## handler for loading file into buffer
qconnect(this, "cellClicked", function(row, column, this) {
item <- this$item(row, 0)
newFile <-item$text()
if(!is.null(this$editor)) {
file <- paste(dir, newFile, sep=.Platform$file.sep)
ce <- this$chunkEditor()
ce$loadFile(file)
}
}, user.data=this)
})
## Method to make GUI object
## @return widget containing object
qsetMethod("makeGUI", FileSelector, function() {
widget <- this
widget$setSizePolicy(Qt$QSizePolicy$Expanding,
Qt$QSizePolicy$Expanding)
widget
})
## method to call to update interface
## @return NULL
qsetMethod("updateInterface", FileSelector, function() {
})
## add a chunk editor instance
## @param ed a ChunkEditor instance
qsetMethod("setChunkEditor", FileSelector, function(ed) {
this$editor <- ed
})
## get the ChunkEditor. Is this needed? (Better to have accessor methods)
## @return returns the associated ChunkEditor for this instance
qsetMethod("chunkEditor", FileSelector, function() {
this$editor
})
## populate list
## @note list the available files for browsing. Not heirarchical, but should be.
## @return void
qsetMethod("findFiles", FileSelector, function() {
QtTableItemFlags <- c(selectable=1, editable=2, dragEnabled=4,dropEnabled=8, userCheckable=16,enabled=32,tristate=64)
x <- list.files(path=this$dir, pattern="\\.R$")
this$setColumnCount(1)
this$setRowCount(length(x))
for(i in seq_along(x)) {
item <- Qt$QTableWidgetItem(x[i])
item$setFlags(as.integer(1 + 32))
this$setItem(i-1, 0, item)
}
## set header name
item <- Qt$QTableWidgetItem("Files")
this$setHorizontalHeaderItem(0, item)
})
##################################################
## Main window
## Main class to make GUI
## @return Returns widget
qsetClass("browseFiles", Qt$QSplitter, function() {
this$.chunkEditor <- ChunkEditor()
this$.fileSelector <- FileSelector()
this$setWindowTitle("Browse files")
this$setOrientation(1L)
## populate files
this$fileSelector$setChunkEditor(this$chunkEditor)
this$fileSelector$findFiles()
this$makeGUI()
})
## make these accessible to other components
qsetProperty("chunkEditor", browseFiles)
qsetProperty("fileSelector", browseFiles)
## Make the GUI
## @return widget containing GUI
qsetMethod("makeGUI", browseFiles, function() {
## Layout GUI
this$addWidget(this$fileSelector$makeGUI())
this$addWidget(this$chunkEditor$makeGUI())
})
## tidy source from the animation package
## @param source what to tidy
## @param keep.comment leave comments
## @param keep.blank.line by name
## @param begin.comment ??
## @param end.comment ??
## @param output TRUE
## @param width.cutoff specified cutoff
## @note just uses the tidy.source function from animation. Idea borrowed
## err "lifted" from the formatR package
`tidy.source` <- function(source = "clipboard", keep.comment = TRUE,
keep.blank.line = TRUE, begin.comment, end.comment, output = TRUE,
width.cutoff = 60L, ...) {
if (source == "clipboard" && Sys.info()["sysname"] == "Darwin") {
source = pipe("pbpaste")
}
tidy.block = function(block.text) {
exprs = base::parse(text = block.text)
n = length(exprs)
res = character(n)
for (i in 1:n) {
dep = paste(base::deparse(exprs[i], width.cutoff), collapse = "\n")
res[i] = substring(dep, 12, nchar(dep) - 1)
}
return(res)
}
text.lines = readLines(source, warn = FALSE)
if (keep.comment) {
identifier = function() paste(sample(LETTERS), collapse = "")
if (missing(begin.comment))
begin.comment = identifier()
if (missing(end.comment))
end.comment = identifier()
text.lines = gsub("^[[:space:]]+|[[:space:]]+$", "",
text.lines)
while (length(grep(sprintf("%s|%s", begin.comment, end.comment),
text.lines))) {
begin.comment = identifier()
end.comment = identifier()
}
head.comment = substring(text.lines, 1, 1) == "#"
if (any(head.comment)) {
text.lines[head.comment] = gsub("\"", "'", text.lines[head.comment])
text.lines[head.comment] = sprintf("%s=\"%s%s\"",
begin.comment, text.lines[head.comment], end.comment)
}
blank.line = text.lines == ""
if (any(blank.line) & keep.blank.line)
text.lines[blank.line] = sprintf("%s=\"%s\"", begin.comment,
end.comment)
text.mask = tidy.block(text.lines)
text.tidy = gsub(sprintf("%s = \"|%s\"", begin.comment,
end.comment), "", text.mask)
}
else {
text.tidy = text.mask = tidy.block(text.lines)
begin.comment = end.comment = ""
}
if (output) cat(paste(text.tidy, collapse = "\n"), "\n", ...)
invisible(list(
text.tidy = text.tidy,
text.mask = text.mask,
begin.comment = begin.comment,
end.comment = end.comment
)
)
}
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.