Nothing
### R code from vignette source 'ex-tcltk-table.Rnw'
###################################################
### code chunk number 1: ex-tcltk-table
###################################################
library(tcltk)
## helpers
quoteIt <- function(string) {
doQuote <- function(x) {
xx <- strsplit(x, '"', fixe = TRUE)[[1]]
paste(paste('"', xx, '"', sep = ""), collapse = '\'"\'')
}
if(!length(string)) return("")
has_double_quote <- grep('"',string)
if(!length(has_double_quote))
return(paste('"',string,'"',sep = ""))
if (!length(grep("([$`])", string))) {
paste("\"", gsub("([\"!\\])", "\\\\\\1", string),
"\"", sep = "")
} else sapply(string, doQuote)
}
## covert a data frame into a character based on
.toCharacter <- function(x,width,...) UseMethod(".toCharacter")
.toCharacter.default <- function(x,width,...) as.character(x)
.toCharacter.integer <- function(x,width,...) {
if(missing(width)) width <- max(nchar(as.character(x))) + 2
format(x, justify = "right", width = width)
}
.toCharacter.numeric <- function(x,width,...) {
if(missing(width)) width <- max(nchar(as.character(x))) + 2
format(x,trim = FALSE, width = width, justify = "right")
}
.toCharacter.factor <- function(x,width,...) {
if(missing(width)) width <- max(nchar(as.character(x))) + 2
.toCharacter(as.character(x),width,...)
}
.toCharacter.logical <- function(x,width,...) {
if(missing(width)) width <- 7
format(as.character(x), justify = "centre", width = width)
}
.toCharacter.data.frame <- function(x,width = 10, ...) {
nms <- dimnames(x)
DF <- as.data.frame(lapply(x,function(i) .toCharacter(i, width = width)),
stringsAsFactors = FALSE)
dimnames(DF) <- nms
return(DF)
}
addScrollbars <- function(parent, widget) {
xscr <- ttkscrollbar(parent, orient = "horizontal",
command = function(...) tkxview(widget, ...))
yscr <- ttkscrollbar(parent, orient = "vertical",
command = function(...) tkyview(widget, ...))
tkconfigure(widget,
xscrollcommand = function(...) tkset(xscr,...),
yscrollcommand = function(...) tkset(yscr,...))
tkgrid(widget, row = 0, column = 0, sticky = "news")
tkgrid(yscr,row = 0,column = 1, sticky = "ns")
tkgrid(xscr, row = 1, column = 0, sticky = "ew")
tkgrid.columnconfigure(parent, 0, weight = 1)
tkgrid.rowconfigure(parent, 0, weight = 1)
}
###################################################
### code chunk number 2: ex-tcltk-table.Rnw:67-68
###################################################
DF <- getCRANmirrors()[, c(1,2,5,4)]
###################################################
### code chunk number 3: notShown
###################################################
window <- tktoplevel()
tkwm.title(window, "Choose a CRAN mirror")
frame <- ttkframe(window, padding = c(3,3,3,12))
tkpack(frame, expand = TRUE, fill = "both")
###################################################
### code chunk number 4: ex-tcltk-table.Rnw:79-85
###################################################
frame_0 <- ttkframe(frame); tkpack(frame_0, fill = "x")
label <- ttklabel(frame_0, text = "filter:")
tkpack(label, side = "left")
filter_var <- tclVar("")
filter_entry <- ttkentry(frame_0, textvariable = filter_var)
tkpack(filter_entry, side = "left")
###################################################
### code chunk number 5: makeTreeview
###################################################
frame_1 <- ttkframe(frame)
tkpack(frame_1, expand = TRUE, fill = "both")
treeview <- ttktreeview(frame_1, columns = 1:ncol(DF),
displaycolumns = 1:(ncol(DF) - 1),
show = "headings", # not "tree"
selectmode = "browse") # single selection
addScrollbars(frame_1, treeview)
###################################################
### code chunk number 6: configureColumns
###################################################
widths <- c(100, 75, 400) # hard coded
nms <- names(DF)
for(i in 1:3) {
tcl(treeview, "heading", i, text = nms[i])
tcl(treeview, "column", i, width = widths[i],
stretch = TRUE, anchor = "w")
}
###################################################
### code chunk number 7: ex-tcltk-table.Rnw:125-136
###################################################
fillTable <- function(treeview, DF) {
children <- as.character(tcl(treeview, "children", ""))
for(i in children)
tcl(treeview, "delete", i) # out with old
shade <- c("none", "gray")
for(i in seq_len(nrow(DF)))
tcl(treeview, "insert", "", "end", tag = shade[i %% 2],
text = "",
values = unlist(DF[i,])) # in with new
tktag.configure(treeview, "gray", background = "gray95")
}
###################################################
### code chunk number 8: ex-tcltk-table.Rnw:140-141
###################################################
fillTable(treeview, DF)
###################################################
### code chunk number 9: ex-tcltk-table.Rnw:146-155
###################################################
cur_ind <- 1:nrow(DF)
tkbind(filter_entry, "<KeyRelease>", function(W, K) {
val <- tclvalue(tkget(W))
poss_vals <- apply(DF, 1, function(...)
paste(..., collapse = " "))
ind<- grep(val, poss_vals)
if(length(ind) == 0) ind <- 1:nrow(DF)
fillTable(treeview, DF[ind,])
})
###################################################
### code chunk number 10: ex-tcltk-table.Rnw:160-169
###################################################
tkbind(treeview, "<Double-Button-1>", function(W, x, y) {
sel <- as.character(tcl(W, "identify", "row", x, y))
vals <- tcl(W, "item", sel, "-values")
URL <- as.character(vals)[4] # not tclvalue
repos <- getOption("repos")
repos["CRAN"] <- gsub("/$", "", URL[1L])
options(repos = repos)
tkwm.withdraw(tkwinfo("toplevel", W))
})
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.