InstallModules <- setRefClass(
"InstallModules",
fields = list(
manager = "ANY",
installWin = "ANY",
from = "ANY",
g_repo = "ANY",
g_url = "ANY",
g_file = "ANY",
filename = "ANY",
fname = "ANY",
url = "ANY",
add_tbl = "ANY",
addons_available = "logical",
inst_repo_btn = "ANY",
inst_url_btn = "ANY",
inst_file_btn = "ANY"
),
methods = list(
initialize = function(mngr) {
initFields(manager = mngr)
installWin <<- gwindow("Install custom module",
parent = manager$GUI$win,
width = size(manager$win)[1],
height = size(manager$win)[2],
visible = FALSE
)
g <- gvbox(container = installWin, expand = TRUE, fill = TRUE)
g$set_borderwidth(10)
# Choose where to install from:
from_grp <- ggroup(container = g)
lbl <- glabel("Install modules from: ")
font(lbl) <- list(weight = "bold")
add(from_grp, lbl)
from <<- gcombobox(
c("Addon repository", "URL", "Local file"),
selected = 0,
container = from_grp,
expand = TRUE,
handler = function(h, ...) {
visible(g_repo) <<- FALSE
visible(g_url) <<- FALSE
visible(g_file) <<- FALSE
j <- svalue(from)
visible(g_repo) <<- j == "Addon repository"
visible(g_url) <<- j == "URL"
visible(g_file) <<- j == "Local file"
}
)
# A box for the controls
ctrl_g <- gvbox(container = g, expand = TRUE)
addSpace(ctrl_g, 10)
init_repo()
init_url()
init_file()
add(ctrl_g, g_repo, expand = TRUE, fill = TRUE)
add(ctrl_g, g_url)
add(ctrl_g, g_file)
if (addons_available) {
svalue(from) <<- "Addon repository"
} else {
from$set_items(c("URL", "Local file"))
svalue(from) <<- "Local file"
}
# When the window is closed ...
addHandlerUnrealize(installWin,
handler = function(h, ...) {
close()
TRUE
}
)
manager$hide_win()
visible(installWin) <<- TRUE
invisible(.self)
},
init_repo = function() {
g_repo <<- gvbox()
visible(g_repo) <<- FALSE
## Fetch list
#addon_file <- file.path(manager$repo_url, "addons.txt")
#addon_list <- tempfile(fileext = ".txt")
#download.file(addon_file, addon_list, quiet = TRUE)
addons <- manager$repo_addons
addons_available <<- nrow(addons) > 0
if (!addons_available) {
glabel("No addons available.", container = g_repo)
return()
}
addons <- data.frame(Install = logical(nrow(addons)), addons)
## Display list
add_tbl <<- gdf(addons,
container = g_repo,
expand = TRUE
)
add_tbl$remove_popup_menu()
add_tbl$hide_row_names(TRUE)
add_tbl$cmd_coerce_column(1, as.logical)
addHandlerChanged(add_tbl,
handler = function(h, ...) {
enabled(inst_repo_btn) <<-
sum(h$obj$get_frame()$Install) > 0
}
)
## Buttons (Cancel + Install)
btn_grp <- ggroup(container = g_repo)
addSpring(btn_grp)
# Cancel button:
cancelBtn <- gbutton("Cancel",
container = btn_grp,
handler = function(h, ...) close()
)
size(cancelBtn) <- c(100, -1)
# Install button
inst_repo_btn <<- gbutton("Install selected",
container = btn_grp,
handler = function(h, ...) {
w <- which(add_tbl$get_frame()$Install)
urls <- file.path(
manager$repo_url,
add_tbl$get_frame()$filename[w]
)
ok <- sapply(urls,
function(url) {
f <- file.path(tempdir(), basename(url))
on.exit(unlink(f))
download.file(url, f, quiet = TRUE)
installmodule(f, manager$m_dir)
}
)
if (all(ok)) close()
else gmessage("Unable to install", parent = installWin)
}
)
size(inst_repo_btn) <<- c(150, -1)
enabled(inst_repo_btn) <<- FALSE
},
init_url = function() {
g_url <<- gvbox()
visible(g_url) <<- FALSE
g_choose <- ggroup(container = g_url)
lbl <- glabel("URL :")
font(lbl) <- list(weight = "bold")
add(g_choose, lbl)
url <<- gedit("", container = g_choose, expand = TRUE)
addSpring(g_url)
# Buttons!!
btn_grp <- ggroup(container = g_url)
addSpring(btn_grp)
# Cancel button:
cancelBtn <- gbutton("Cancel",
container = btn_grp,
handler = function(h, ...) close()
)
size(cancelBtn) <- c(100, -1)
# Install button
inst_url_btn <<- gbutton("Install",
container = btn_grp,
handler = function(h, ...) {
f <- file.path(tempdir(), basename(svalue(url)))
on.exit(unlink(f))
download.file(svalue(url), f, quiet = TRUE)
if (installmodule(f, manager$m_dir)) close()
else gmessage("Unable to install", parent = installWin)
}
)
size(inst_url_btn) <<- c(100, -1)
},
init_file = function(g) {
g_file <<- gvbox()
visible(g_file) <<- FALSE
lbl <- glabel("To install a local module file, Browse to the file location and choose Open, then click Install.")
font(lbl) <- list(size = 9)
add(g_file, lbl, anchor = c(-1, 0))
g_choose <- ggroup(container = g_file)
lbl <- glabel("File Name :")
font(lbl) <- list(weight = "bold")
add(g_choose, lbl)
filename <<- gedit("Select a file ...",
container = g_choose,
expand = TRUE
)
btn_choose <- gbutton("Browse ...",
container = g_choose,
handler = function(h, ...) {
svalue(filename) <<- gfile(
text = "Choose a file",
initial.dir = file.path("."),
filter = list("R file" = list(patterns = c("*.R"))),
quote = FALSE,
container = g_choose
)
}
)
addHandlerChanged(filename,
handler = function(h, ...) {
fname <<- svalue(h$obj)
}
)
addHandlerKeystroke(filename,
handler = function(h, ...) {
fname <<- svalue(h$obj)
}
)
addSpring(g_file)
# Module information
# tbl <- glayout(container = g_file)
# lbl <- glabel("Name: ")
# font(lbl) <- list(weight = "bold")
# mod_name <- glabel("")
# tbl[1, expand = TRUE] <- lbl
# Buttons!!
btn_grp <- ggroup(container = g_file)
addSpring(btn_grp)
# Cancel button:
cancelBtn <- gbutton("Cancel",
container = btn_grp,
handler = function(h, ...) close()
)
size(cancelBtn) <- c(100, -1)
# Install button
inst_file_btn <<- gbutton("Install",
container = btn_grp,
handler = function(h, ...) {
if (installmodule(fname, manager$m_dir)) close()
else gmessage("Unable to install", parent = installWin)
}
)
size(inst_file_btn) <<- c(100, -1)
},
close = function() {
visible(installWin) <<- FALSE
manager$show_win()
manager$update_menu()
dispose(installWin)
}
)
)
installmodule <- function(file, dir, overwrite = FALSE) {
if (checkfile(file)) {
if (!overwrite && file.exists(file.path(dir, basename(file)))) {
if (gconfirm("Module already exists - do you wish to overwrite it?")) {
overwrite <- TRUE
}
}
if (file.copy(file, dir, overwrite = overwrite)) {
TRUE
} else {
gmessage("Could not install addon", icon = "error")
FALSE
}
} else {
gmessage("Selected file is not an iNZight addon module", icon = "error")
FALSE
}
}
checkfile <- function(file) {
file.contents <- readLines(file)
any(grepl("^[a-zA-Z]+[a-zA-Z0-9]*\\s*<-\\s*setRefClass", file.contents))
}
removemodule <- function(module) {
msg <- sprintf("Are you sure you want to delete module '%s'?",
module$display_name
)
if (gconfirm(msg)) {
file.remove(module$path)
} else {
FALSE
}
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.