################################################################################
# CHANGE LOG (last 20 changes)
# 16.09.2022: Filename as suggested name for dataset for single file import.
# 10.09.2022: Compacted the gui. Removed destroy workaround.
# 16.03.2020: Added language support.
# 17.03.2019: Fixed widgets not enabled.
# 01.03.2019: Rearranged widgets and changed visibility for more intuitive options.
# 22.02.2019: Compressed tcltk gui.
# 15.02.2019: Fixed Error in if (svalue(savegui_chk)) { : argument is of length zero (tcltk)
# 07.08.2017: Added audit trail.
# 17.07.2017: Added label "Selected for import".
# 13.07.2017: Fixed issue with button handlers.
# 13.07.2017: Fixed expanded 'gexpandgroup'.
# 13.07.2017: Fixed narrow dropdown with hidden argument ellipsize = "none".
# 11.07.2017: Changed part of layout and Implemented last directory as default.
# 07.07.2017: Replaced 'droplist' with 'gcombobox'.
# 07.07.2017: Removed argument 'border' for 'gbutton'.
# 15.12.2015: Removed "0" from the default 'na.strings'.
# 04.12.2015: Implemented new parameter 'na.strings'.
# 05.10.2015: Added attributes.
# 29.08.2015: Added importFrom.
# 23.05.2015: Added new options available in 'import'.
# 11.10.2014: Added 'focus', added 'parent' parameter.
# 28.06.2014: Added help button and moved save gui checkbox.
#' @title Import Data
#'
#' @description
#' GUI wrapper for the \code{\link{import}} function.
#'
#' @details
#' Simplifies the use of the \code{\link{import}} function by providing a graphical
#' user interface to it.
#'
#' @param env environment into which the object will be saved.
#' Default is the current environment.
#' @param savegui logical indicating if GUI settings should be saved in the environment.
#' @param debug logical indicating printing debug information.
#' @param parent widget to get focus when finished.
#'
#' @return TRUE
#'
#' @export
#'
#' @importFrom utils help
#' @importFrom tools file_path_sans_ext
#'
#' @seealso \code{\link{import}}
import_gui <- function(env = parent.frame(), savegui = NULL, debug = FALSE, parent = NULL) {
# Define variables.
.default_file_dir <- NA
.default_file_name <- NA
.default_dir <- NA
.selectedFile <- NULL
.selectedFolder <- NULL
.batchImport <- TRUE
# Language ------------------------------------------------------------------
# Get this functions name from call.
fnc <- as.character(match.call()[[1]])
if (debug) {
print(paste("IN:", fnc))
}
# Default strings.
strWinTitle <- "Import from files"
strChkGui <- "Save GUI settings"
strBtnHelp <- "Help"
strBtnFile <- "Select file"
strTipFile <- "Import of a single file into one dataset."
strMsgFile <- "Select a file..."
strBtnFolder <- "Select folder"
strTipFolder <- "Batch import of multiple files into one dataset."
strMsgFolder <- "Select a folder..."
strLblSelected <- "Selected for import:"
strFrmOptions <- "Options"
strExpMultiple <- "Multiple files options"
strChkIgnore <- "Ignore case"
strLblPrefix <- "Prefix:"
strLblSuffix <- "Suffix:"
strLblExtension <- "Extension:"
strChkName <- "Save file name"
strChkTime <- "Save file time stamp"
strLblDelimiter <- "Delimiter:"
strDrpTab <- "TAB"
strDrpSpace <- "SPACE"
strDrpComma <- "COMMA"
strDrpSemicolon <- "SEMICOLON"
strLblNA <- "NA strings (separated by comma):"
strChkTrim <- "Auto trim samples"
strLblTrim <- "Trim samples containing the word (separate by pipe |):"
strChkInvert <- "Invert (remove matching samples"
strChkSlim <- "Auto slim repeated columns"
strChkKeep <- "Keep all fixed (keep a row even if no data)"
strFrmSave <- "Save as"
strLblSave <- "Name for dataset:"
strMsgSave <- "Name for new dataset"
strBtnImport <- "Import"
strBtnProcessing <- "Processing..."
strMsgName <- "A name for the dataset must be provided."
strMsgDataset <- "Dataset empty!\nCheck your file filter."
strMsgTitleError <- "Error"
# Get strings from language file.
dtStrings <- getStrings(gui = fnc)
# If language file is found.
if (!is.null(dtStrings)) {
# Get language strings, use default if not found.
strtmp <- dtStrings["strWinTitle"]$value
strWinTitle <- ifelse(is.na(strtmp), strWinTitle, strtmp)
strtmp <- dtStrings["strChkGui"]$value
strChkGui <- ifelse(is.na(strtmp), strChkGui, strtmp)
strtmp <- dtStrings["strBtnHelp"]$value
strBtnHelp <- ifelse(is.na(strtmp), strBtnHelp, strtmp)
strtmp <- dtStrings["strBtnFile"]$value
strBtnFile <- ifelse(is.na(strtmp), strBtnFile, strtmp)
strtmp <- dtStrings["strTipFile"]$value
strTipFile <- ifelse(is.na(strtmp), strTipFile, strtmp)
strtmp <- dtStrings["strMsgFile"]$value
strMsgFile <- ifelse(is.na(strtmp), strMsgFile, strtmp)
strtmp <- dtStrings["strBtnFolder"]$value
strBtnFolder <- ifelse(is.na(strtmp), strBtnFolder, strtmp)
strtmp <- dtStrings["strTipFolder"]$value
strTipFolder <- ifelse(is.na(strtmp), strTipFolder, strtmp)
strtmp <- dtStrings["strMsgFolder"]$value
strMsgFolder <- ifelse(is.na(strtmp), strMsgFolder, strtmp)
strtmp <- dtStrings["strLblSelected"]$value
strLblSelected <- ifelse(is.na(strtmp), strLblSelected, strtmp)
strtmp <- dtStrings["strFrmOptions"]$value
strFrmOptions <- ifelse(is.na(strtmp), strFrmOptions, strtmp)
strtmp <- dtStrings["strExpMultiple"]$value
strExpMultiple <- ifelse(is.na(strtmp), strExpMultiple, strtmp)
strtmp <- dtStrings["strChkIgnore"]$value
strChkIgnore <- ifelse(is.na(strtmp), strChkIgnore, strtmp)
strtmp <- dtStrings["strLblPrefix"]$value
strLblPrefix <- ifelse(is.na(strtmp), strLblPrefix, strtmp)
strtmp <- dtStrings["strLblSuffix"]$value
strLblSuffix <- ifelse(is.na(strtmp), strLblSuffix, strtmp)
strtmp <- dtStrings["strLblExtension"]$value
strLblExtension <- ifelse(is.na(strtmp), strLblExtension, strtmp)
strtmp <- dtStrings["strChkName"]$value
strChkName <- ifelse(is.na(strtmp), strChkName, strtmp)
strtmp <- dtStrings["strChkTime"]$value
strChkTime <- ifelse(is.na(strtmp), strChkTime, strtmp)
strtmp <- dtStrings["strLblDelimiter"]$value
strLblDelimiter <- ifelse(is.na(strtmp), strLblDelimiter, strtmp)
strtmp <- dtStrings["strDrpTab"]$value
strDrpTab <- ifelse(is.na(strtmp), strDrpTab, strtmp)
strtmp <- dtStrings["strDrpSpace"]$value
strDrpSpace <- ifelse(is.na(strtmp), strDrpSpace, strtmp)
strtmp <- dtStrings["strDrpComma"]$value
strDrpComma <- ifelse(is.na(strtmp), strDrpComma, strtmp)
strtmp <- dtStrings["strDrpSemicolon"]$value
strDrpSemicolon <- ifelse(is.na(strtmp), strDrpSemicolon, strtmp)
strtmp <- dtStrings["strLblNA"]$value
strLblNA <- ifelse(is.na(strtmp), strLblNA, strtmp)
strtmp <- dtStrings["strChkTrim"]$value
strChkTrim <- ifelse(is.na(strtmp), strChkTrim, strtmp)
strtmp <- dtStrings["strLblTrim"]$value
strLblTrim <- ifelse(is.na(strtmp), strLblTrim, strtmp)
strtmp <- dtStrings["strChkInvert"]$value
strChkInvert <- ifelse(is.na(strtmp), strChkInvert, strtmp)
strtmp <- dtStrings["strChkSlim"]$value
strChkSlim <- ifelse(is.na(strtmp), strChkSlim, strtmp)
strtmp <- dtStrings["strChkKeep"]$value
strChkKeep <- ifelse(is.na(strtmp), strChkKeep, strtmp)
strtmp <- dtStrings["strFrmSave"]$value
strFrmSave <- ifelse(is.na(strtmp), strFrmSave, strtmp)
strtmp <- dtStrings["strLblSave"]$value
strLblSave <- ifelse(is.na(strtmp), strLblSave, strtmp)
strtmp <- dtStrings["strMsgSave"]$value
strMsgSave <- ifelse(is.na(strtmp), strMsgSave, strtmp)
strtmp <- dtStrings["strBtnImport"]$value
strBtnImport <- ifelse(is.na(strtmp), strBtnImport, strtmp)
strtmp <- dtStrings["strBtnProcessing"]$value
strBtnProcessing <- ifelse(is.na(strtmp), strBtnProcessing, strtmp)
strtmp <- dtStrings["strMsgName"]$value
strMsgName <- ifelse(is.na(strtmp), strMsgName, strtmp)
strtmp <- dtStrings["strMsgDataset"]$value
strMsgDataset <- ifelse(is.na(strtmp), strMsgDataset, strtmp)
strtmp <- dtStrings["strMsgTitleError"]$value
strMsgTitleError <- ifelse(is.na(strtmp), strMsgTitleError, strtmp)
}
# WINDOW ####################################################################
# Main window.
w <- gwindow(
title = strWinTitle,
visible = FALSE
)
# Runs when window is closed.
addHandlerUnrealize(w, handler = function(h, ...) {
# Save GUI state.
.saveSettings()
# Focus on parent window.
if (!is.null(parent)) {
focus(parent)
}
# Destroy window.
return(FALSE)
})
# Vertical main group.
gv <- ggroup(
horizontal = FALSE,
spacing = 1,
use.scrollwindow = FALSE,
container = w,
expand = TRUE
)
# Help button group.
gh <- ggroup(container = gv, expand = FALSE, fill = TRUE)
savegui_chk <- gcheckbox(text = strChkGui, checked = FALSE, container = gh)
addSpring(gh)
help_btn <- gbutton(text = strBtnHelp, container = gh)
addHandlerChanged(help_btn, handler = function(h, ...) {
# Open help page for function.
print(help(fnc, help_type = "html"))
})
# GUI #######################################################################
# Button for single file import.
select_file <- gbutton(text = strBtnFile, container = gv)
tooltip(select_file) <- strTipFile
addHandlerClicked(select_file, handler = function(h, ...) {
# Set batch import flag.
.batchImport <<- FALSE
# Check if last location is available.
if (!is.na(.default_file_dir) && !is.na(.default_file_name)) {
m_file_dir <- .default_file_dir
message("Last used file directory: ", m_file_dir)
m_filename <- .default_file_name
message("Last used file name: ", m_filename)
} else {
m_file_dir <- getwd()
m_filename <- NULL
message("Could not access last used import directory.")
message("Using current working directory: ", getwd())
}
# Open file selector.
.selectedFile <<- gfile(
text = strMsgFile, type = "open",
initial.filename = m_filename,
initial.dir = m_file_dir
)
# Save last used filename and directory.
if (length(.selectedFile) > 0) {
.default_file_name <<- basename(.selectedFile)
.default_file_dir <<- dirname(.selectedFile)
}
# Update current selection.
svalue(selected_lbl) <- paste0(c(strLblSelected, .selectedFile))
# Suggest filename as name for dataset.
svalue(import_edt) <- file_path_sans_ext(basename(.selectedFile))
})
# Button for multiple files import.
select_folder <- gbutton(text = strBtnFolder, container = gv)
tooltip(select_folder) <- strTipFolder
addHandlerClicked(select_folder, handler = function(h, ...) {
# Set import from folder flag.
.batchImport <<- TRUE
# Check if last location is available.
if (!is.na(.default_dir)) {
m_dir <- .default_dir
message("Last used batch directory: ", m_dir)
} else {
m_dir <- getwd()
message("Could not access last used import directory.")
message("Using current working directory: ", getwd())
}
# Open folder selector.
.selectedFolder <<- gfile(
text = strMsgFolder, type = "selectdir",
initial.dir = m_dir
)
# Save last used directory.
if (length(.selectedFolder) > 0) {
.default_dir <<- .selectedFolder
}
# Update current selection.
svalue(selected_lbl) <- paste0(c(strLblSelected, .selectedFolder))
})
# Selected status label.
selected_lbl <- glabel(text = strLblSelected, container = gv, anchor = c(-1, 0))
# OPTIONS -------------------------------------------------------------------
opt_frm <- gframe(
text = strFrmOptions, pos = 0, horizontal = FALSE,
spacing = 1, container = gv
)
# MULTIPLE FILES OPTIONS ----------------------------------------------------
multi_frm <- gexpandgroup(
text = strExpMultiple,
horizontal = FALSE, container = opt_frm
)
# Start collapsed.
visible(multi_frm) <- FALSE
multi_case_chk <- gcheckbox(
text = strChkIgnore, checked = TRUE,
container = multi_frm
)
glabel(text = strLblPrefix, container = multi_frm, anchor = c(-1, 0))
multi_pre_edt <- gedit(container = multi_frm, expand = TRUE, fill = TRUE)
glabel(text = strLblSuffix, container = multi_frm, anchor = c(-1, 0))
multi_suf_edt <- gedit(container = multi_frm, expand = TRUE, fill = TRUE)
glabel(text = strLblExtension, container = multi_frm, anchor = c(-1, 0))
multi_ext_edt <- gedit(
text = "txt", container = multi_frm,
expand = TRUE, fill = TRUE
)
# INFO ----------------------------------------------------------------------
opt_file_chk <- gcheckbox(
text = strChkName, checked = TRUE,
container = opt_frm
)
opt_time_chk <- gcheckbox(
text = strChkTime, checked = TRUE,
container = opt_frm
)
# DELIMITER -----------------------------------------------------------------
glabel(text = strLblDelimiter, container = opt_frm, anchor = c(-1, 0))
opt_sep_drp <- gcombobox(
items = c(strDrpTab, strDrpSpace, strDrpComma, strDrpSemicolon),
selected = 1, editable = FALSE, container = opt_frm,
ellipsize = "none"
)
glabel(
text = strLblNA,
container = opt_frm, anchor = c(-1, 0)
)
opt_na_edt <- gedit(text = "NA,,", container = opt_frm)
# TRIM ----------------------------------------------------------------------
opt_trim_chk <- gcheckbox(
text = strChkTrim, checked = FALSE,
container = opt_frm
)
addHandlerChanged(opt_trim_chk, handler = function(h, ...) {
.updateGui()
})
trim_grp <- ggroup(horizontal = FALSE, container = opt_frm)
enabled(trim_grp) <- FALSE
glabel(
text = strLblTrim,
container = trim_grp, anchor = c(-1, 0)
)
trim_samples_edt <- gedit(
text = "pos|neg|ladder",
width = 25, container = trim_grp, expand = TRUE
)
trim_invert_chk <- gcheckbox(
text = strChkInvert, checked = TRUE,
container = trim_grp
)
# SLIM ----------------------------------------------------------------------
opt_slim_chk <- gcheckbox(
text = strChkSlim,
checked = FALSE, container = opt_frm
)
addHandlerChanged(opt_slim_chk, handler = function(h, ...) {
.updateGui()
})
slim_grp <- ggroup(horizontal = FALSE, container = opt_frm)
enabled(slim_grp) <- FALSE
slim_fix_chk <- gcheckbox(
text = strChkKeep,
checked = TRUE, container = slim_grp
)
# SAVE --------------------------------------------------------------------
save_frm <- gframe(
text = strFrmSave, pos = 0,
horizontal = FALSE, container = gv
)
glabel(text = strLblSave, container = save_frm, anchor = c(-1, 0))
import_edt <- gedit(
initial.msg = strMsgSave,
container = save_frm, expand = TRUE, fill = TRUE
)
# IMPORT --------------------------------------------------------------------
import_btn <- gbutton(text = strBtnImport, container = gv)
addHandlerClicked(import_btn, handler = function(h, ...) {
# Get values.
file_val <- .selectedFile
folder_val <- .selectedFolder
ignore_val <- svalue(multi_case_chk)
prefix_val <- svalue(multi_pre_edt)
suffix_val <- svalue(multi_suf_edt)
extension_val <- svalue(multi_ext_edt)
folder_opt_val <- .batchImport
val_name <- svalue(import_edt)
get_file_val <- svalue(opt_file_chk)
get_time_val <- svalue(opt_time_chk)
del_val <- svalue(opt_sep_drp, index = TRUE)
na_val <- svalue(opt_na_edt)
trim_val <- svalue(opt_trim_chk)
trim_what_val <- svalue(trim_samples_edt)
trim_invert_val <- svalue(trim_invert_chk)
slim_val <- svalue(opt_slim_chk)
slim_fix_val <- svalue(slim_fix_chk)
# Assign a delimiter character.
val_delimiter <- NA
if (del_val == 1) {
val_delimiter <- "\t"
} else if (del_val == 2) {
val_delimiter <- " "
} else if (del_val == 3) {
val_delimiter <- ","
} else if (del_val == 4) {
val_delimiter <- ";"
}
# Convert to character vector.
val_na <- unlist(strsplit(na_val, ","))
# Initiate variable.
ok <- TRUE
# Check that a name has been provided for the new data object.
if (nchar(val_name) == 0) {
gmessage(
msg = strMsgName,
title = strMsgTitleError, icon = "error", parent = w
)
ok <- FALSE
}
# Check if ok to import data to 'env'.
if (ok) {
# Set arguments.
if (folder_opt_val) {
file_val <- NA
} else {
folder_val <- NA
}
if (!nchar(prefix_val) > 0) {
prefix_val <- NA
}
if (!nchar(suffix_val) > 0) {
suffix_val <- NA
}
if (debug) {
print("val_name")
print(val_name)
print("ignore_val")
print(ignore_val)
print("prefix_val")
print(prefix_val)
print("suffix_val")
print(suffix_val)
print("folder_opt_val")
print(folder_opt_val)
print("file_val")
print(file_val)
print("folder_val")
print(folder_val)
print("get_file_val")
print(get_file_val)
print("get_time_val")
print(get_time_val)
print("del_val")
print(del_val)
print("na_val")
print(na_val)
print("val_na")
print(val_na)
print("trim_val")
print(trim_val)
print("trim_what_val")
print(trim_what_val)
print("trim_invert_val")
print(trim_invert_val)
print("slim_val")
print(slim_val)
print("slim_fix_val")
print(slim_fix_val)
}
# Change button.
blockHandlers(import_btn)
svalue(import_btn) <- strBtnProcessing
unblockHandlers(import_btn)
enabled(import_btn) <- FALSE
# Call function.
datanew <- import(
folder = folder_opt_val,
extension = extension_val,
suffix = suffix_val,
prefix = prefix_val,
import.file = file_val,
folder.name = folder_val,
file.name = get_file_val,
time.stamp = get_time_val,
separator = val_delimiter,
ignore.case = ignore_val,
auto.trim = trim_val,
trim.samples = trim_what_val,
trim.invert = trim_invert_val,
auto.slim = slim_val,
slim.na = slim_fix_val,
na.strings = val_na,
debug = debug
)
if (length(datanew) == 0) {
# Show warning.
gmessage(
msg = strMsgDataset,
title = strMsgTitleError,
icon = "error",
parent = w
)
# Change button.
blockHandlers(import_btn)
svalue(import_btn) <- strBtnImport
unblockHandlers(import_btn)
enabled(import_btn) <- TRUE
} else {
# Create key-value pairs to log.
keys <- list(
"folder", "extension", "suffix", "prefix",
"import.file", "folder.name", "file.name", "time.stamp",
"ignore.case", "auto.trim", "trim.samples", "trim.invert",
"auto.slim", "slim.na", "separator", "na.strings"
)
values <- list(
folder_opt_val, extension_val, suffix_val, prefix_val,
file_val, folder_val, get_file_val, get_time_val,
ignore_val, trim_val, trim_what_val, trim_invert_val,
slim_val, slim_fix_val, val_delimiter, val_na
)
# Update audit trail.
datanew <- auditTrail(
obj = datanew, key = keys, value = values,
label = fnc, arguments = FALSE,
package = "strvalidator"
)
# Save data.
saveObject(
name = val_name, object = datanew, parent = w,
env = env, debug = debug
)
# Close GUI.
.saveSettings()
dispose(w)
}
}
})
# INTERNAL FUNCTIONS ########################################################
.updateGui <- function() {
# Get values.
val_trim <- svalue(opt_trim_chk)
val_slim <- svalue(opt_slim_chk)
folder_opt_val <- .batchImport
if (val_trim) {
enabled(trim_grp) <- TRUE
} else {
enabled(trim_grp) <- FALSE
}
if (val_slim) {
enabled(slim_grp) <- TRUE
} else {
enabled(slim_grp) <- FALSE
}
}
.loadSavedSettings <- function() {
# First check status of save flag.
if (!is.null(savegui)) {
svalue(savegui_chk) <- savegui
enabled(savegui_chk) <- FALSE
if (debug) {
print("Save GUI status set!")
}
} else {
# Load save flag.
if (exists(".strvalidator_import_gui_savegui", envir = env, inherits = FALSE)) {
svalue(savegui_chk) <- get(".strvalidator_import_gui_savegui", envir = env)
}
if (debug) {
print("Save GUI status loaded!")
}
}
if (debug) {
print(svalue(savegui_chk))
}
# Then load settings if true.
if (svalue(savegui_chk)) {
if (exists(".strvalidator_import_gui_last_dir", envir = env, inherits = FALSE)) {
.default_dir <<- get(".strvalidator_import_gui_last_dir", envir = env)
}
if (exists(".strvalidator_import_gui_last_file_dir", envir = env, inherits = FALSE)) {
.default_file_dir <<- get(".strvalidator_import_gui_last_file_dir", envir = env)
}
if (exists(".strvalidator_import_gui_last_file_name", envir = env, inherits = FALSE)) {
.default_file_name <<- get(".strvalidator_import_gui_last_file_name", envir = env)
}
if (exists(".strvalidator_import_gui_file", envir = env, inherits = FALSE)) {
svalue(opt_file_chk) <- get(".strvalidator_import_gui_file", envir = env)
}
if (exists(".strvalidator_import_gui_time", envir = env, inherits = FALSE)) {
svalue(opt_time_chk) <- get(".strvalidator_import_gui_time", envir = env)
}
if (exists(".strvalidator_import_gui_sep", envir = env, inherits = FALSE)) {
svalue(opt_sep_drp) <- get(".strvalidator_import_gui_sep", envir = env)
}
if (exists(".strvalidator_import_gui_na", envir = env, inherits = FALSE)) {
svalue(opt_na_edt) <- get(".strvalidator_import_gui_na", envir = env)
}
if (exists(".strvalidator_import_gui_ignore", envir = env, inherits = FALSE)) {
svalue(multi_case_chk) <- get(".strvalidator_import_gui_ignore", envir = env)
}
if (exists(".strvalidator_import_gui_prefix", envir = env, inherits = FALSE)) {
svalue(multi_pre_edt) <- get(".strvalidator_import_gui_prefix", envir = env)
}
if (exists(".strvalidator_import_gui_suffix", envir = env, inherits = FALSE)) {
svalue(multi_suf_edt) <- get(".strvalidator_import_gui_suffix", envir = env)
}
if (exists(".strvalidator_import_gui_extension", envir = env, inherits = FALSE)) {
svalue(multi_ext_edt) <- get(".strvalidator_import_gui_extension", envir = env)
}
if (exists(".strvalidator_import_gui_trim", envir = env, inherits = FALSE)) {
svalue(opt_trim_chk) <- get(".strvalidator_import_gui_trim", envir = env)
}
if (exists(".strvalidator_import_gui_trim_samples", envir = env, inherits = FALSE)) {
svalue(trim_samples_edt) <- get(".strvalidator_import_gui_trim_samples", envir = env)
}
if (exists(".strvalidator_import_gui_trim_invert", envir = env, inherits = FALSE)) {
svalue(trim_invert_chk) <- get(".strvalidator_import_gui_trim_invert", envir = env)
}
if (exists(".strvalidator_import_gui_slim", envir = env, inherits = FALSE)) {
svalue(opt_slim_chk) <- get(".strvalidator_import_gui_slim", envir = env)
}
if (exists(".strvalidator_import_gui_slim_fix", envir = env, inherits = FALSE)) {
svalue(slim_fix_chk) <- get(".strvalidator_import_gui_slim_fix", envir = env)
}
if (debug) {
print("Saved settings loaded!")
}
}
}
.saveSettings <- function() {
# Then save settings if true.
if (svalue(savegui_chk)) {
assign(x = ".strvalidator_import_gui_savegui", value = svalue(savegui_chk), envir = env)
assign(x = ".strvalidator_import_gui_last_dir", value = .default_dir, envir = env)
assign(x = ".strvalidator_import_gui_last_file_dir", value = .default_file_dir, envir = env)
assign(x = ".strvalidator_import_gui_last_file_name", value = .default_file_name, envir = env)
assign(x = ".strvalidator_import_gui_file", value = svalue(opt_file_chk), envir = env)
assign(x = ".strvalidator_import_gui_time", value = svalue(opt_time_chk), envir = env)
assign(x = ".strvalidator_import_gui_sep", value = svalue(opt_sep_drp), envir = env)
assign(x = ".strvalidator_import_gui_na", value = svalue(opt_na_edt), envir = env)
assign(x = ".strvalidator_import_gui_ignore", value = svalue(multi_case_chk), envir = env)
assign(x = ".strvalidator_import_gui_prefix", value = svalue(multi_pre_edt), envir = env)
assign(x = ".strvalidator_import_gui_suffix", value = svalue(multi_suf_edt), envir = env)
assign(x = ".strvalidator_import_gui_extension", value = svalue(multi_ext_edt), envir = env)
assign(x = ".strvalidator_import_gui_trim", value = svalue(opt_trim_chk), envir = env)
assign(x = ".strvalidator_import_gui_trim_samples", value = svalue(trim_samples_edt), envir = env)
assign(x = ".strvalidator_import_gui_trim_invert", value = svalue(trim_invert_chk), envir = env)
assign(x = ".strvalidator_import_gui_slim", value = svalue(opt_slim_chk), envir = env)
assign(x = ".strvalidator_import_gui_slim_fix", value = svalue(slim_fix_chk), envir = env)
} else { # or remove all saved values if false.
if (exists(".strvalidator_import_gui_savegui", envir = env, inherits = FALSE)) {
remove(".strvalidator_import_gui_savegui", envir = env)
}
if (exists(".strvalidator_import_gui_last_dir", envir = env, inherits = FALSE)) {
remove(".strvalidator_import_gui_last_dir", envir = env)
}
if (exists(".strvalidator_import_gui_last_file_dir", envir = env, inherits = FALSE)) {
remove(".strvalidator_import_gui_last_file_dir", envir = env)
}
if (exists(".strvalidator_import_gui_last_file_name", envir = env, inherits = FALSE)) {
remove(".strvalidator_import_gui_last_file_name", envir = env)
}
if (exists(".strvalidator_import_gui_file", envir = env, inherits = FALSE)) {
remove(".strvalidator_import_gui_file", envir = env)
}
if (exists(".strvalidator_import_gui_time", envir = env, inherits = FALSE)) {
remove(".strvalidator_import_gui_time", envir = env)
}
if (exists(".strvalidator_import_gui_sep", envir = env, inherits = FALSE)) {
remove(".strvalidator_import_gui_sep", envir = env)
}
if (exists(".strvalidator_import_gui_na", envir = env, inherits = FALSE)) {
remove(".strvalidator_import_gui_na", envir = env)
}
if (exists(".strvalidator_import_gui_ignore", envir = env, inherits = FALSE)) {
remove(".strvalidator_import_gui_ignore", envir = env)
}
if (exists(".strvalidator_import_gui_prefix", envir = env, inherits = FALSE)) {
remove(".strvalidator_import_gui_prefix", envir = env)
}
if (exists(".strvalidator_import_gui_suffix", envir = env, inherits = FALSE)) {
remove(".strvalidator_import_gui_suffix", envir = env)
}
if (exists(".strvalidator_import_gui_extension", envir = env, inherits = FALSE)) {
remove(".strvalidator_import_gui_extension", envir = env)
}
if (exists(".strvalidator_import_gui_trim", envir = env, inherits = FALSE)) {
remove(".strvalidator_import_gui_trim", envir = env)
}
if (exists(".strvalidator_import_gui_trim_samples", envir = env, inherits = FALSE)) {
remove(".strvalidator_import_gui_trim_samples", envir = env)
}
if (exists(".strvalidator_import_gui_trim_invert", envir = env, inherits = FALSE)) {
remove(".strvalidator_import_gui_trim_invert", envir = env)
}
if (exists(".strvalidator_import_gui_slim", envir = env, inherits = FALSE)) {
remove(".strvalidator_import_gui_slim", envir = env)
}
if (exists(".strvalidator_import_gui_slim_fix", envir = env, inherits = FALSE)) {
remove(".strvalidator_import_gui_slim_fix", envir = env)
}
if (debug) {
print("Settings cleared!")
}
}
if (debug) {
print("Settings saved!")
}
}
# END GUI ###################################################################
# Load GUI settings.
.loadSavedSettings()
.updateGui()
# Show GUI.
visible(w) <- TRUE
focus(w)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.