Nothing
#' GUI: Export Data
#'
#' A graphical user interface (\acronym{GUI}) for exporting data to text files, shapefiles, or R data files.
#'
#' @param file.type character.
#' Output file type: either
#' \var{txt} for text files,
#' \var{rda} for R-data files, or
#' \var{shp} for shapefiles.
#' @param parent tkwin.
#' \acronym{GUI} parent window
#'
#' @return Saves the \acronym{GUI} options in the \code{export} component of \code{\link{Data}}.
#' List components of \code{export} include:
#' \item{processed}{indicates whether exported data are limited to processed records.}
#' \item{fmts}{indicates whether a header line of conversion specification format strings is written (text only).}
#' \item{cols}{indicates whether a header line of column names is written (text only).}
#' \item{rows}{indicates whether the row names are written (text only).}
#' \item{comment}{indicates whether to write comments using the comment character, \code{com} (text only).}
#' \item{sep}{field separator character (text only).}
#' \item{dec}{string used for decimal points (text only).}
#' \item{nas}{string interpreted as \code{\link{NA}} value (text only).}
#' \item{com}{comment character (text only).}
#' \item{qmethod}{a string specifying how to deal with embedded double quote characters when quoting strings (text only).}
#' \item{quote}{if true, any character or factor columns will be surrounded by double quotes (text only).}
#' \item{encoding}{declares the encoding to be used on the file (text only).}
#' \item{eol}{the character to print at the end of each line (text only).}
#' \item{zip}{indicate whether the file should be compressed using \href{http://www.gzip.org/}{gzip},
#' \href{http://www.bzip.org/}{bzip2}, or \href{http://tukaani.org/xz/format.html}{xz} (text only).}
#' \item{changelog}{indicate if a separate text file should be written with the change log (text only).}
#' \item{ascii}{if true, an \acronym{ASCII} representation of the data is written (R data only).}
#'
#' @author J.C. Fisher, U.S. Geological Survey, Idaho Water Science Center
#'
#' @seealso \code{\link[utils]{write.table}}, \code{\link{save}}, \code{\link[rgdal]{writeOGR}}
#'
#' @keywords IO
#'
#' @import tcltk
#'
#' @export
#'
#' @examples
#' \dontrun{
#' Data(replace.all = obj)
#' ExportData(file.type = "txt")
#' }
#'
ExportData <- function(file.type="txt", parent=NULL) {
# final export of data to file
ExportToFile <- function() {
tkconfigure(tt, cursor="watch")
on.exit(tkconfigure(tt, cursor="arrow"))
idxs <- as.integer(tkcurselection(f1.lst.1.1)) + 1L
col.ids <- col.ids[idxs]
is.proc <- as.logical(as.integer(tclvalue(processed.var)))
file.name <- as.character(tclvalue(file.var))
# organize data
vars <- Data("vars")
cols <- Data("cols")
rows <- Data("rows")
all.col.ids <- vapply(seq_along(cols), function(i) cols[[i]]$id, "")
if (file.type == "shp") {
id.x <- all.col.ids[vars$x]
id.y <- all.col.ids[vars$y]
if (!id.x %in% col.ids) col.ids <- c(col.ids, id.x)
if (!id.y %in% col.ids) col.ids <- c(col.ids, id.y)
}
col.idxs <- which(all.col.ids %in% col.ids)
col.ids <- vapply(col.idxs, function(i) cols[[i]]$id, "")
col.funs <- vapply(col.idxs, function(i) cols[[i]]$fun, "")
col.nams <- vapply(col.idxs, function(i) cols[[i]]$name, "")
col.fmts <- vapply(col.idxs, function(i) cols[[i]]$format, "")
# identify data set and records
if (is.proc) {
row.names <- row.names(Data("data.pts"))
row.idxs <- which(row.names %in% rows)
if (length(row.names) != length(row.idxs))
stop("length of row names different from length of row indexes")
} else {
row.names <- rows
row.idxs <- seq_along(row.names)
}
n <- length(col.idxs)
m <- length(row.idxs)
d <- list()
for (i in seq_len(n)) {
obj <- EvalFunction(col.funs[i], cols)[row.idxs]
if (file.type == "txt") {
fmt <- col.fmts[i]
if (fmt == "") {
obj <- .DefaultFormat(obj)
} else {
if (inherits(obj, "POSIXt")) {
obj <- format(obj, format=fmt, na.encode=FALSE)
} else {
ans <- try(sprintf(fmt, obj), silent=TRUE)
if (inherits(ans, "try-error")) {
obj <- .DefaultFormat(obj)
} else {
obj <- ans
obj[obj %in% c("NA", "NaN")] <- NA
}
}
}
}
d[[i]] <- obj
}
if (file.type == "txt") {
d <- do.call(cbind, d) # matrix
} else {
class(d) <- "data.frame" # see warning in utils::read.table (R v3.0.2)
}
rownames(d) <- row.names
if (is.null(Data("export"))) Data("export", list())
Data(c("export", "processed"), is.proc)
# write text file
if (file.type == "txt") {
is.fmts <- as.logical(as.integer(tclvalue(conv.fmts.var)))
is.cols <- as.logical(as.integer(tclvalue(col.names.var)))
is.rows <- as.logical(as.integer(tclvalue(row.names.var)))
is.quot <- as.logical(as.integer(tclvalue(quote.var)))
is.comm <- as.logical(as.integer(tclvalue(comment.var)))
is.log <- as.logical(as.integer(tclvalue(changelog.var)))
sep <- sep0[as.integer(tcl(f3.box.1.2, "current")) + 1L]
dec <- dec0[as.integer(tcl(f3.box.1.5, "current")) + 1L]
nas <- nas0[as.integer(tcl(f3.box.2.2, "current")) + 1L]
qme <- qme0[as.integer(tcl(f3.box.2.5, "current")) + 1L]
com <- com0[as.integer(tcl(f3.box.3.2, "current")) + 1L]
enc <- enc0[as.integer(tcl(f4.box.2.2, "current")) + 1L]
eol <- eol0[as.integer(tcl(f4.box.3.2, "current")) + 1L]
zip <- zip0[as.integer(tcl(f4.box.4.2, "current")) + 1L]
if (is.na(sep)) sep <- as.character(tclvalue(sep.var))
if (is.na(nas)) {
nas <- as.character(tclvalue(nas.var))
if (nas == "") nas <- "NA"
}
if (is.na(com)) com <- as.character(tclvalue(com.var))
# write changelog
if (is.log) {
base.name <- sub(paste0("\\.", zip, "$"), "", basename(file.name))
base.name <- paste0(base.name, ".log")
f.log <- file.path(dirname(file.name), base.name)
if (file.access(f.log, mode=0) == 0) {
msg <- paste0("\'", base.name, "\' already exists.\n\nDo you want to replace it?")
ans <- tkmessageBox(icon="info", message=msg, title="Confirm Save As", type="yesno", parent=tt)
if (as.character(ans) == "no") return()
}
utils::write.table(Data("changelog"), file=f.log, quote=is.quot, sep=sep,
eol=eol, na=nas, dec=dec, row.names=FALSE, col.names=TRUE,
qmethod=qme, fileEncoding=enc)
}
# set connection
args <- list(description=file.name, open="w", encoding=enc)
what <- paste0(ifelse(zip == "bz2", "bz", zip), "file")
con <- do.call(what, args)
if (!inherits(con, "connection")) stop("Connection error")
on.exit(close(con), add=TRUE)
# write comment
if (is.comm) {
txt <- Data("comment")
if (!is.null(txt) && length(txt) > 0 && is.character(txt))
writeLines(paste(com, txt), con=con, sep=eol)
}
# write headers
headers <- c(is.fmts, is.cols)
if (any(headers)) {
if (is.rows) {
h <- matrix(NA, nrow=sum(headers), ncol=ncol(d) + 1L)
col.fmts <- c("", col.fmts)
col.nams <- c("", col.nams)
} else {
h <- matrix(NA, nrow=sum(headers), ncol=ncol(d))
}
i <- 1L
if (headers[1]) {
h[i, ] <- col.fmts
i <- i + 1L
}
if (headers[2]) h[i, ] <- col.nams
utils::write.table(h, file=con, append=is.comm, quote=is.quot, sep=sep,
eol=eol, na=nas, dec=dec, row.names=FALSE, col.names=FALSE,
qmethod=qme, fileEncoding=enc)
}
# write records
utils::write.table(d, file=con, append=(is.comm | any(headers)), quote=is.quot,
sep=sep, eol=eol, na=nas, dec=dec, row.names=is.rows,
col.names=FALSE, qmethod=qme, fileEncoding=enc)
Data(c("export", "fmts"), is.fmts)
Data(c("export", "cols"), is.cols)
Data(c("export", "rows"), is.rows)
Data(c("export", "comment"), is.comm)
Data(c("export", "sep"), sep)
Data(c("export", "dec"), dec)
Data(c("export", "na"), nas)
Data(c("export", "com"), com)
Data(c("export", "qmethod"), qme)
Data(c("export", "quote"), is.quot)
Data(c("export", "encoding"), enc)
Data(c("export", "eol"), eol)
Data(c("export", "zip"), zip)
Data(c("export", "changelog"), is.log)
# write shapefile
} else if (file.type == "shp") {
# names are finicky for shapefiles, rules are convoluted, that is, 8-bit names and no periods
col.ids.8bit <- gsub("\\.", "", make.names(substr(col.ids, 1, 7), unique=TRUE))
colnames(d) <- col.ids.8bit
idx.x <- which(col.ids %in% id.x)
idx.y <- which(col.ids %in% id.y)
is.coord.na <- is.na(d[, idx.x]) | is.na(d[, idx.y])
d <- d[!is.coord.na, ] # remove coordinates containing missing values
sp::coordinates(d) <- col.ids.8bit[c(idx.x, idx.y)]
sp::proj4string(d) <- Data("crs")
dsn <- dirname(file.name)
layer <- basename(file.name)
ext <- tolower(utils::tail(unlist(strsplit(layer, "\\."))[-1], 1))
if (length(ext) != 0) layer <- sub(paste0(".", ext, "$"), "", layer)
rgdal::writeOGR(obj=d, dsn=dsn, layer=layer, driver="ESRI Shapefile",
verbose=TRUE, overwrite_layer=TRUE)
# write r data file
} else if (file.type == "rda") {
ascii <- as.logical(as.integer(tclvalue(ascii.var)))
names(d) <- make.names(names=col.ids, unique=TRUE)
comment(d) <- Data("comment")
obj.name <- sub("[.][^.]*$", "", basename(file.name))
assign(obj.name, d, envir=environment(ExportToFile))
save(list=obj.name, file=file.name, ascii=ascii)
Data(c("export", "ascii"), ascii)
}
memory.usage <- gc()
tclvalue(tt.done.var) <- 1
}
# select all or none from variable list
SelectVariables <- function(sel) {
n <- length(col.ids) - 1L
if (sel == "all") {
tkselection.set(f1.lst.1.1, 0, n)
} else if (sel == "none") {
tkselection.clear(f1.lst.1.1, 0, n)
} else {
idxs <- 0:n
sel <- as.integer(tkcurselection(f1.lst.1.1))
tkselection.clear(f1.lst.1.1, 0, n)
for (i in idxs[!(idxs %in% sel)]) tkselection.set(f1.lst.1.1, i)
}
ToggleExport()
}
# get file
GetDataFile <- function() {
if (file.type == "txt") {
zip <- zip0[as.integer(tcl(f4.box.4.2, "current")) + 1L]
if (zip == "") {
sep <- sep0[as.integer(tcl(f3.box.1.2, "current")) + 1L]
if ("," %in% sep) {
default.ext <- "csv"
exts <- "csv"
} else if ("\t" %in% sep) {
default.ext <- "tsv"
exts <- c("tsv", "tab")
} else {
default.ext <- "txt"
exts <- c("txt", "tsv", "csv")
}
} else {
default.ext <- zip
exts <- zip
}
} else {
default.ext <- file.type
exts <- file.type
}
f <- GetFile(cmd="Save As", exts=exts, file=NULL, win.title="Save Data As",
defaultextension=default.ext)
if (is.null(f)) return()
tclvalue(file.var) <- f
ToggleExport()
}
# toggle file extension
ToggleExtension <- function() {
f <- as.character(tclvalue(file.var))
if (f == "") return()
ext <- attr(GetFile(file=f), "extension")
zip <- zip0[as.integer(tcl(f4.box.4.2, "current")) + 1L]
for (i in zip0) f <- sub(paste0("\\.", i, "$"), "", f)
if (zip != ext) tclvalue(file.var) <- ifelse(zip == "", f, paste(f, zip, sep="."))
return()
}
# toggle state of export button
ToggleExport <- function() {
idxs <- as.integer(tkcurselection(f1.lst.1.1))
f <- as.character(tclvalue(file.var))
s <- if (length(idxs) == 0L || nchar(f) == 0L) "disabled" else "normal"
tkconfigure(f0.but.2, state=s)
}
# check for required information
col.ids <- vapply(Data("cols"), function(i) i$id, "")
if (length(col.ids) == 0) return()
if (!file.type %in% c("txt", "shp", "rda")) stop()
if (file.type == "shp") {
if (!requireNamespace("rgdal", quietly=TRUE)) stop()
if (is.null(Data(c("vars", "x"))) | is.null(Data(c("vars", "y"))))
stop("shapefiles require x,y coordinate values")
}
# initialize values
sep0 <- c("\t", ",", "", ";", "|", NA)
sep1 <- c("Tab ( \\t )", "Comma ( , )", "White space ( )",
"Semicolon ( ; )", "Pipe ( | )", "Custom\u2026")
nas0 <- c("NA", "na", "N/A", "n/a", NA)
nas1 <- c("NA", "na", "N/A", "n/a", "Custom\u2026")
dec0 <- c(".", ",")
dec1 <- c("Period ( . )", "Comma ( , )")
qme0 <- c("escape", "double")
qme1 <- c("Escape quote", "Double quote")
com0 <- c("#", "!", "\\", "~", NA)
com1 <- c("Number sign ( # )", "Exclamation ( ! )", "Backslash ( \\\\ )",
"Tilde ( ~ )", "Custom\u2026")
enc0 <- c("native.enc", iconvlist())
enc1 <- c("Default", iconvlist())
eol0 <- c("\n", "\r", "\r\n")
eol1 <- c("LF ( \\n )", "CR ( \\r )", "CR+LF ( \\r\\n )")
zip0 <- c("", "gz", "bz2", "xz")
zip1 <- c("None", "gzip", "bzip2", "xz")
# assign variables linked to tk widgets
variables.var <- tclVar()
for (i in seq_along(col.ids)) tcl("lappend", variables.var, col.ids[i])
sep.var <- tclVar()
nas.var <- tclVar()
com.var <- tclVar()
file.var <- tclVar()
tt.done.var <- tclVar(0)
if (is.null(Data(c("export", "processed"))))
processed.var <- tclVar(FALSE)
else
processed.var <- tclVar(Data(c("export", "processed")))
if (is.null(Data(c("export", "fmts"))))
conv.fmts.var <- tclVar(FALSE)
else
conv.fmts.var <- tclVar(Data(c("export", "fmts")))
if (is.null(Data(c("export", "cols"))))
col.names.var <- tclVar(FALSE)
else
col.names.var <- tclVar(Data(c("export", "cols")))
if (is.null(Data(c("export", "rows"))))
row.names.var <- tclVar(FALSE)
else
row.names.var <- tclVar(Data(c("export", "rows")))
if (is.null(Data(c("export", "comment"))))
comment.var <- tclVar(FALSE)
else
comment.var <- tclVar(Data(c("export", "comment")))
if (is.null(Data(c("export", "quote"))))
quote.var <- tclVar(FALSE)
else
quote.var <- tclVar(Data(c("export", "quote")))
if (is.null(Data(c("export", "changelog"))))
changelog.var <- tclVar(FALSE)
else
changelog.var <- tclVar(Data(c("export", "changelog")))
if (is.null(Data(c("export", "ascii"))))
ascii.var <- tclVar(FALSE)
else
ascii.var <- tclVar(Data(c("export", "ascii")))
# open gui
tclServiceMode(FALSE)
tt <- tktoplevel()
if (!is.null(parent)) {
tkwm.transient(tt, parent)
geo <- unlist(strsplit(as.character(tkwm.geometry(parent)), "\\+"))
geo <- as.integer(geo[2:3]) + 25
tkwm.geometry(tt, sprintf("+%s+%s", geo[1], geo[2]))
}
tktitle(tt) <- "Export Data"
# frame 0, export and cancel buttons
f0 <- ttkframe(tt, relief="flat")
f0.but.2 <- ttkbutton(f0, width=12, text="Export", command=ExportToFile)
f0.but.4 <- ttkbutton(f0, width=12, text="Help",
command=function() {
print(utils::help("ExportData", package="RSurvey"))
})
f0.but.3 <- ttkbutton(f0, width=12, text="Cancel",
command=function() tclvalue(tt.done.var) <- 1)
f0.grp.5 <- ttksizegrip(f0)
tkgrid("x", f0.but.2, f0.but.3, f0.but.4, f0.grp.5)
tkgrid.columnconfigure(f0, 0, weight=1)
tkgrid.configure(f0.but.2, f0.but.3, f0.but.4, padx=c(0, 4), pady=c(0, 10))
tkgrid.configure(f0.but.4, columnspan=2, padx=c(0, 10))
tkgrid.configure(f0.grp.5, sticky="se")
tkraise(f0.but.4, f0.grp.5)
tkpack(f0, fill="x", side="bottom", anchor="e")
# frame 1, sample entry
txt <- "Select variables and data records"
f1 <- ttklabelframe(tt, relief="flat", borderwidth=5, padding=5, text=txt)
f1.lst.1.1 <- tklistbox(f1, selectmode="extended", activestyle="none",
relief="flat", borderwidth=5, width=10, height=4,
exportselection=FALSE, listvariable=variables.var,
highlightthickness=0)
f1.ysc.1.6 <- ttkscrollbar(f1, orient="vertical")
tkconfigure(f1.lst.1.1, background="white", yscrollcommand=paste(.Tk.ID(f1.ysc.1.6), "set"))
tkconfigure(f1.ysc.1.6, command=paste(.Tk.ID(f1.lst.1.1), "yview"))
f1.but.2.1 <- ttkbutton(f1, width=8, text="All",
command=function() SelectVariables("all"))
f1.but.2.2 <- ttkbutton(f1, width=8, text="None",
command=function() SelectVariables("none"))
f1.but.2.3 <- ttkbutton(f1, width=8, text="Inverse",
command=function() SelectVariables("inverse"))
f1.chk.2.4 <- ttkcheckbutton(f1, variable=processed.var, text="Include only processed records")
tkgrid(f1.lst.1.1, "x", "x", "x", "x", f1.ysc.1.6)
tkgrid(f1.but.2.1, f1.but.2.2, f1.but.2.3, f1.chk.2.4, "x", "x", pady=c(4, 0))
tkgrid.configure(f1.lst.1.1, sticky="nsew", columnspan=5)
tkgrid.configure(f1.ysc.1.6, sticky="ns")
tkgrid.configure(f1.but.2.1, f1.but.2.2, padx=c(0, 4))
tkgrid.configure(f1.chk.2.4, padx=c(40, 0))
tkgrid.columnconfigure(f1, 4, weight=1, minsize=0)
tkgrid.rowconfigure(f1, 0, weight=1)
tkpack(f1, fill="both", expand=TRUE, side="top", padx=10, pady=10)
if (is.null(Data("data.pts"))) {
tclvalue(processed.var) <- 0
tkconfigure(f1.chk.2.4, state="disabled")
}
if (file.type == "txt") {
# frame 2, meta data
f2 <- ttklabelframe(tt, relief="flat", borderwidth=5, padding=5, text="Metadata")
f2.chk.1.1 <- ttkcheckbutton(f2, variable=comment.var, text="Comment")
txt <- "Format conversion specification strings"
f2.chk.1.2 <- ttkcheckbutton(f2, variable=conv.fmts.var, text=txt)
f2.chk.2.1 <- ttkcheckbutton(f2, variable=row.names.var, text="Record (row) names")
f2.chk.2.2 <- ttkcheckbutton(f2, variable=col.names.var, text="Variable (column) names")
tkgrid(f2.chk.1.1, f2.chk.1.2, sticky="w")
tkgrid(f2.chk.2.1, f2.chk.2.2, sticky="w")
tkgrid.configure(f2.chk.1.2, f2.chk.2.2, padx=c(40, 0))
tkpack(f2, fill="x", padx=10, pady=c(0, 10))
# frame 3, export parmaters
f3 <- ttklabelframe(tt, relief="flat", borderwidth=5, padding=5, text="Options")
f3.lab.1.1 <- ttklabel(f3, text="Separator")
f3.lab.1.4 <- ttklabel(f3, text="Decimal")
f3.lab.2.1 <- ttklabel(f3, text="NA string")
f3.lab.2.4 <- ttklabel(f3, text="Method")
f3.lab.3.1 <- ttklabel(f3, text="Comment")
f3.box.1.2 <- ttkcombobox(f3, width=17, state="readonly", value=sep1)
f3.box.1.5 <- ttkcombobox(f3, width=17, state="readonly", value=dec1)
f3.box.2.2 <- ttkcombobox(f3, width=17, state="readonly", value=nas1)
f3.box.2.5 <- ttkcombobox(f3, width=17, state="readonly", value=qme1)
f3.box.3.2 <- ttkcombobox(f3, width=17, state="readonly", value=com1)
f3.ent.1.3 <- ttkentry(f3, width=12, textvariable=sep.var, state="disabled")
f3.ent.2.3 <- ttkentry(f3, width=12, textvariable=nas.var, state="disabled")
f3.ent.3.3 <- ttkentry(f3, width=12, textvariable=com.var, state="disabled")
txt <- "Surround character variables by double quotes"
f3.chk.4.1 <- ttkcheckbutton(f3, variable=quote.var, text=txt)
tkgrid(f3.lab.1.1, f3.box.1.2, f3.ent.1.3, f3.lab.1.4, f3.box.1.5)
tkgrid(f3.lab.2.1, f3.box.2.2, f3.ent.2.3, f3.lab.2.4, f3.box.2.5, pady=4)
tkgrid(f3.lab.3.1, f3.box.3.2, f3.ent.3.3)
tkgrid(f3.chk.4.1, pady=c(4, 0))
tkgrid.configure(f3.lab.1.1, f3.lab.1.4, f3.lab.2.1, f3.lab.2.4, f3.lab.3.1,
padx=c(10, 2), sticky="w")
tkgrid.configure(f3.lab.1.1, f3.lab.2.1, f3.lab.3.1, padx=c(0, 2))
tkgrid.configure(f3.ent.1.3, f3.ent.2.3, f3.ent.3.3, padx=c(2, 0))
tkgrid.configure(f3.chk.4.1, columnspan=5, sticky="w", pady=c(5, 0))
tkpack(f3, fill="x", padx=10, pady=c(0, 10))
tcl(f3.box.1.2, "current", 0)
tcl(f3.box.1.5, "current", 0)
tcl(f3.box.2.2, "current", 0)
tcl(f3.box.2.5, "current", 0)
tcl(f3.box.3.2, "current", 0)
if (!is.null(Data(c("export", "sep")))) {
if (Data(c("export", "sep")) %in% sep0) {
tcl(f3.box.1.2, "current", match(Data(c("export", "sep")), sep0) - 1)
tkconfigure(f3.ent.1.3, state="disabled")
} else {
tcl(f3.box.1.2, "current", match(NA, sep0) - 1)
tkconfigure(f3.ent.1.3, state="normal")
tclvalue(sep.var) <- Data(c("export", "sep"))
}
}
if (!is.null(Data(c("export", "na")))) {
if (Data(c("export", "na")) %in% nas0) {
tcl(f3.box.2.2, "current", match(Data(c("export", "na")), nas0) - 1)
tkconfigure(f3.ent.2.3, state="disabled")
} else {
tcl(f3.box.2.2, "current", match(NA, nas0) - 1)
tkconfigure(f3.ent.2.3, state="normal")
tclvalue(nas.var) <- Data(c("export", "na"))
}
}
if (!is.null(Data(c("export", "com")))) {
if (Data(c("export", "com")) %in% com0) {
tcl(f3.box.3.2, "current", match(Data(c("export", "com")), com0) - 1)
tkconfigure(f3.ent.3.3, state="disabled")
} else {
tcl(f3.box.3.2, "current", match(NA, com0) - 1)
tkconfigure(f3.ent.3.3, state="normal")
tclvalue(com.var) <- Data(c("export", "com"))
}
}
if (!is.null(Data(c("export", "dec"))))
tcl(f3.box.1.5, "current", match(Data(c("export", "dec")), dec0) - 1)
if (!is.null(Data(c("export", "qmethod"))))
tcl(f3.box.2.5, "current",
match(Data(c("export", "qmethod")), qme0) - 1)
}
# frame 4, output file and compression
f4 <- ttklabelframe(tt, relief="flat", borderwidth=5, padding=5, text="Output file")
f4.ent.1.1 <- ttkentry(f4, width=12, textvariable=file.var)
f4.but.1.5 <- ttkbutton(f4, width=8, text="Browse", command=GetDataFile)
f4.lab.2.1 <- ttklabel(f4, text="Encoding")
f4.lab.3.1 <- ttklabel(f4, text="End-of-line")
f4.lab.4.1 <- ttklabel(f4, text="Compression")
f4.box.2.2 <- ttkcombobox(f4, width=17, state="readonly", value=enc1)
f4.box.3.2 <- ttkcombobox(f4, width=17, state="readonly", value=eol1)
f4.box.4.2 <- ttkcombobox(f4, width=17, state="readonly", value=zip1)
txt <- "Export changelog ( *.log )"
f4.chk.2.3 <- ttkcheckbutton(f4, variable=changelog.var, text=txt)
tkgrid(f4.ent.1.1, "x", "x", "x", f4.but.1.5)
tkgrid.configure(f4.ent.1.1, sticky="we", columnspan=4, padx=c(0, 2))
if (file.type == "txt") {
tkgrid(f4.lab.2.1, f4.box.2.2, f4.chk.2.3, pady=c(4, 0), sticky="w")
tkgrid(f4.lab.3.1, f4.box.3.2, "x", pady=c(4, 0), sticky="w")
tkgrid(f4.lab.4.1, f4.box.4.2, "x", pady=c(4, 0), sticky="w")
tkgrid.configure(f4.lab.2.1, f4.lab.3.1, f4.lab.4.1, padx=c(0, 2))
tkgrid.configure(f4.chk.2.3, padx=c(20, 0), columnspan=2)
tcl(f4.box.2.2, "current", 0)
tcl(f4.box.3.2, "current", 0)
tcl(f4.box.4.2, "current", 0)
if (is.character(Data(c("export", "encoding"))))
tcl(f4.box.2.2, "current", match(Data(c("export", "encoding")), enc0) - 1L)
if (is.character(Data(c("export", "eol"))))
tcl(f4.box.3.2, "current", match(Data(c("export", "eol")), eol0) - 1L)
if (is.character(Data(c("export", "zip"))))
tcl(f4.box.4.2, "current", match(Data(c("export", "zip")), zip0) - 1L)
if (is.null(Data("changelog"))) {
tclvalue(changelog.var) <- 0
tkconfigure(f4.chk.2.3, state="disabled")
}
} else if (file.type == "rda") {
f4.rbt.2.1 <- ttkradiobutton(f4, variable=ascii.var, value=0, text="Binary")
f4.rbt.2.2 <- ttkradiobutton(f4, variable=ascii.var, value=1, text="ASCII")
tkgrid(f4.rbt.2.1, f4.rbt.2.2, "x", "x")
tkgrid.configure(f4.rbt.2.1, padx=c(0, 4))
}
tkgrid.columnconfigure(f4, 3, weight=1)
tkpack(f4, fill="x", padx=10, pady=c(0, 15))
# bind events
tclServiceMode(TRUE)
tkbind(tt, "<Destroy>", function() tclvalue(tt.done.var) <- 1)
tkbind(f1.lst.1.1, "<<ListboxSelect>>", ToggleExport)
tkbind(f4.ent.1.1, "<KeyRelease>", ToggleExport)
if (file.type == "txt") {
tkbind(f3.box.1.2, "<<ComboboxSelected>>",
function() {
sep <- sep0[as.integer(tcl(f3.box.1.2, "current")) + 1]
if (is.na(sep)) {
tkconfigure(f3.ent.1.3, state="normal")
tkfocus(f3.ent.1.3)
} else {
tkconfigure(f3.ent.1.3, state="disabled")
}
})
tkbind(f3.box.2.2, "<<ComboboxSelected>>",
function() {
nas <- nas0[as.integer(tcl(f3.box.2.2, "current")) + 1]
if (is.na(nas)) {
tkconfigure(f3.ent.2.3, state="normal")
tkfocus(f3.ent.2.3)
} else {
tkconfigure(f3.ent.2.3, state="disabled")
}
})
tkbind(f3.box.3.2, "<<ComboboxSelected>>",
function() {
com <- com0[as.integer(tcl(f3.box.3.2, "current")) + 1]
if (is.na(com)) {
tkconfigure(f3.ent.3.3, state="normal")
tkfocus(f3.ent.3.3)
} else {
tkconfigure(f3.ent.3.3, state="disabled")
}
})
tkbind(f4.box.4.2, "<<ComboboxSelected>>", ToggleExtension)
}
# gui control
ToggleExport()
tkfocus(f1.lst.1.1)
tkgrab(tt)
tkwait.variable(tt.done.var)
tclServiceMode(FALSE)
tkgrab.release(tt)
tkdestroy(tt)
tclServiceMode(TRUE)
}
.DefaultFormat <- function(x) {
x <- format(x, trim=TRUE, na.encode=FALSE, scientific=FALSE, drop0trailing=TRUE)
return(gsub("(^ +)|( +$)", "", x))
}
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.