From 46a092c54133fb1d1d2fafb356d8605789d7100d Mon Sep 17 00:00:00 2001 From: Johannes Ranke Date: Fri, 23 Oct 2015 16:59:17 +0200 Subject: Hard work to make the project management safe At the moment it is distracting, as modification tracking of projects is not implemented yet --- inst/GUI/gmkin.R | 332 ++++++++++++++++++++++++++++++------------------------- 1 file changed, 180 insertions(+), 152 deletions(-) (limited to 'inst') diff --git a/inst/GUI/gmkin.R b/inst/GUI/gmkin.R index 45d04ad..bcf2b68 100644 --- a/inst/GUI/gmkin.R +++ b/inst/GUI/gmkin.R @@ -24,7 +24,7 @@ left_width = 250 right_width = 500 save_keybinding = "Ctrl-X" -# Widgets {{{2 +# Three panel layout {{{2 window_title <- paste0("gmkin ", packageVersion("gmkin"), "- Browser based GUI for kinetic evaluations using mkin") w <- gwindow(window_title) @@ -68,14 +68,21 @@ update_p.df <- function() { } else { p.df <<- p.df.package } + p.gtable[,] <- p.df + p.line.import.p[,] <- c("", p.df$Name) } # Update dataframe with datasets {{{2 update_ds.df <- function() { - ds.df <<- data.frame(Title = sapply(ws$ds, function(x) x$title)) + if (is.na(ws$ds[1])) ds.df <<- ds.df.empty + else ds.df <<- data.frame(Title = sapply(ws$ds, function(x) x$title)) + ds.gtable[,] <- ds.df + update_ds_editor() + ds.delete$call_Ext("disable") } # Update dataframe with models {{{2 update_m.df <- function() { - m.df <<- data.frame(Name = names(ws$m)) + if (is.na(ws$m[1])) m.df <<- m.df.empty + else m.df <<- data.frame(Name = sapply(ws$m, function(x) x$name)) } # Update dataframe with fits {{{2 update_f.df <- function() { @@ -84,12 +91,14 @@ update_f.df <- function() { f.df[1, "Name"] <- c("Temporary (not fitted)") } if (!is.na(ws$f[1])) { - f.df.ws <- data.frame(Name = names(ws$f), stringsAsFactors = FALSE) + f.df.ws <- data.frame(Name = sapply(ws$f, function(x) x$name), + stringsAsFactors = FALSE) f.df <- rbind(f.df, f.df.ws) } f.df <<- f.df } # Generate the initial workspace {{{1 +# Project workspace {{{2 ws <- gmkinws$new() ws.import <- NA # Initialise meta data objects so assignments within functions using <<- will {{{2 @@ -97,10 +106,19 @@ ws.import <- NA # Also create initial versions of meta data in order to be able to clear the workspace p.df <- p.df.package <- data.frame(Name = c("FOCUS_2006", "FOCUS_2006_Z"), Source = rep("gmkin package", 2), stringsAsFactors = FALSE) - -update_p.df() +# Datasets {{{2 +ds.cur <- ds.empty <- mkinds$new( + title = "", time_unit = "", unit = "", + data = data.frame( + name = "parent", + time = c(0, 1), + value = c(100, NA), + override = "NA", err = 1, + stringsAsFactors = FALSE)) ds.df <- ds.df.empty <- data.frame(Title = "", stringsAsFactors = FALSE) +# Models {{{2 m.df <- m.df.empty <- data.frame(Name = "", stringsAsFactors = FALSE) +# Fits {{{2 f.df <- f.df.empty <- data.frame(Name = "", stringsAsFactors = FALSE) ftmp <- NA # left: Explorer tables {{{1 @@ -116,31 +134,58 @@ f.gf <- gframe("Results", cont = left) # The former must be manually amended if additional workspaces should be available p.gtable <- gtable(p.df, cont = p.gf, width = left_width - 10, height = 120) size(p.gtable) <- list(columnWidths = c(130, 100)) +p.loaded <- NA # The index of the loaded project. We reset the selection to this when the user + # does not confirm +p.modified <- TRUE # Keep track of modifications after loading p.switcher <- function(h, ...) { - p.cur <- h$row_index - Name <- p.df[p.cur, "Name"] - if (p.df[p.cur, "Source"] == "working directory") { - load(paste0(Name, ".gmkinws")) - ws <<- ws + p.cur <- h$row_index # h$row_index for clicked or doubleclick handlers, h$value for change + project_switched <- FALSE + switch_project <- function() { + Name <- p.df[p.cur, "Name"] + if (p.df[p.cur, "Source"] == "working directory") { + load(paste0(Name, ".gmkinws")) + ws <<- ws + } else { + ws <<- get(Name) + } + svalue(center) <- 1 + svalue(c.ds) <- empty_conf_labels[1] + svalue(c.m) <- empty_conf_labels[2] + update_p_editor(p.cur) + update_ds.df() + update_m.df() + m.gtable[,] <<- m.df + update_f.df() + f.gtable[,] <<- f.df + p.loaded <<- p.cur + project_switched <- TRUE + p.gtable$set_index(p.cur) + } + if (p.modified) { + gconfirm("When you switch projects, you loose any unsaved changes. Proceed to switch?", + handler = function(h, ...) { + switch_project() + }) } else { - ws <<- get(Name) + switch_project() + } + # We can reset the selection only if the project was not + # switched. The following code gets executed during the confirmation dialogue, + # i.e. before the potential switching + if (!project_switched) { + if (is.na(p.loaded)) { + p.gtable$clear_selection() + } else { + p.gtable$set_index(p.loaded) + } } - svalue(center) <- 1 - svalue(c.ds) <- empty_conf_labels[1] - svalue(c.m) <- empty_conf_labels[2] - update_p_editor(p.cur) - update_ds.df() - ds.gtable[,] <<- ds.df - update_m.df() - m.gtable[,] <<- m.df - update_f.df() - f.gtable[,] <<- f.df } addHandlerClicked(p.gtable, p.switcher) # Dataset explorer {{{2 ds.switcher <- function(h, ...) { - ws$ds.cur <<- h$row_index - svalue(c.ds) <- ds.df[ws$ds.cur, "Title"] + ds.i <- h$row_index + svalue(c.ds) <- ds.df[ds.i, "Title"] + ds.cur <<- ws$ds[[ds.i]] update_ds_editor() svalue(center) <- 2 } @@ -148,8 +193,8 @@ ds.gtable <- gtable(ds.df, cont = ds.gf, width = left_width - 10, height = 160) addHandlerClicked(ds.gtable, ds.switcher) # Model explorer {{{2 m.switcher <- function(h, ...) { - ws$m.cur <<- h$row_index - svalue(c.m) <- m.df[ws$m.cur, "Name"] + m.i <- h$row_index + svalue(c.m) <- m.df[m.i, "Name"] #update_m_editor() svalue(center) <- 3 } @@ -157,8 +202,8 @@ m.gtable <- gtable(m.df, cont = m.gf, width = left_width - 10, height = 160) addHandlerClicked(m.gtable, m.switcher) # Fit explorer {{{2 f.switcher <- function(h, ...) { - ws$f.cur <<- h$row_index - 1 - if (ws$f.cur > 0) { + f.cur <<- h$row_index - 1 + if (f.cur > 0) { ftmp <<- ws$f[[ws$f.cur]] stmp <<- ws$s[[ws$f.cur]] c.ds$call_Ext("setText", @@ -181,8 +226,8 @@ c.conf <- gbutton("Configure fit", cont = c.gf, handler = function(h, ...) svalu p.editor <- gframe("", horizontal = FALSE, cont = center, label = "Project") # New project {{{2 -p.line.clear <- ggroup(cont = p.editor, horizontal = TRUE) -p.line.clear.b <- gbutton("New project", cont = p.line.clear, +p.line.buttons <- ggroup(cont = p.editor, horizontal = TRUE) +p.new <- gbutton("New project", cont = p.line.buttons, handler = function(h, ...) { project_name <- "New project" svalue(p.name) <- project_name @@ -190,61 +235,59 @@ p.line.clear.b <- gbutton("New project", cont = p.line.clear, p.delete$call_Ext("disable") ws <<- gmkinws$new() update_ds.df() - ds.gtable[,] <- ds.df update_m.df() m.gtable[,] <- m.df update_f.df() f.gtable[,] <- f.df }) -# Working directory {{{2 -p.line.wd <- ggroup(cont = p.editor, horizontal = TRUE) -wd_handler <- function(h, ...) { - target_wd <- svalue(p.wde) - wd <- try(setwd(target_wd)) - if (inherits(wd, "try-error")) { - gmessage(paste("Could not set working directory to", target_wd), parent = w) - } else { - svalue(sb) <- paste("Changed working directory to", wd) - update_p.df() - p.gtable[,] <- p.df - p.line.import.p[,] <- c("", p.df$Name) - } +p.delete.handler = function(h, ...) { + filename <- file.path(getwd(), paste0(svalue(p.name), ".gmkinws")) + gconfirm(paste0("Are you sure you want to delete ", filename, "?"), + parent = w, + handler = function(h, ...) { + if (inherits(try(unlink(filename)), "try-error")) { + gmessage("Deleting failed for an unknown reason", cont = w) + } else { + svalue(sb) <- paste("Deleted", filename) + svalue(p.filename) <- "" + p.delete$call_Ext("disable") + update_p.df() + } + }) } -p.wde <- gedit(getwd(), cont = p.line.wd, label = "Working directory", width = 50) -p.wde$add_handler_enter(wd_handler) -p.wdb <- gbutton("Change", cont = p.line.wd, handler = wd_handler) -tooltip(p.wdb) <- "Edit the box on the left and press enter to change" +p.delete <- gbutton("Delete project", cont = p.line.buttons, + handler = p.delete.handler, + ext.args = list(disabled = TRUE)) # Project name {{{2 p.line.name <- ggroup(cont = p.editor, horizontal = TRUE) -p.name <- gedit("New project", label = "Project name", +p.name <- gedit("New project", label = "Project name", width = 50, cont = p.line.name) -p.save <- gaction("Save", parent = w, - handler = function(h, ...) { - filename <- paste0(svalue(p.name), ".gmkinws") - try_to_save <- function (filename) { - if (!inherits(try(save(ws, file = filename)), - "try-error")) { - svalue(sb) <- paste("Saved project to file", filename, - "in working directory", getwd()) - update_p.df() - p.gtable[,] <- p.df - } else { - gmessage("Saving failed for an unknown reason", parent = w) - } - } - if (file.exists(filename)) { - gconfirm(paste("File", filename, "exists. Overwrite?"), - parent = w, - handler = function(h, ...) { - try_to_save(filename) - }) - } else { - try_to_save(filename) - } - }) -p.save.button <- gbutton(action = p.save, cont = p.line.name) -p.save$add_keybinding(save_keybinding) -tooltip(p.save.button) <- paste("Press", save_keybinding, "to save") +p.save.action <- gaction("Save", parent = w, + handler = function(h, ...) { + filename <- paste0(svalue(p.name), ".gmkinws") + try_to_save <- function (filename) { + if (!inherits(try(save(ws, file = filename)), + "try-error")) { + svalue(sb) <- paste("Saved project to file", filename, + "in working directory", getwd()) + update_p.df() + } else { + gmessage("Saving failed for an unknown reason", parent = w) + } + } + if (file.exists(filename)) { + gconfirm(paste("File", filename, "exists. Overwrite?"), + parent = w, + handler = function(h, ...) { + try_to_save(filename) + }) + } else { + try_to_save(filename) + } + }) +p.save.action$add_keybinding(save_keybinding) +p.save <- gbutton(action = p.save.action, cont = p.line.name) +tooltip(p.save) <- paste("Press", save_keybinding, "to save") update_p_editor <- function(p.cur) { project_name <- as.character(p.df[p.cur, "Name"]) @@ -257,29 +300,27 @@ update_p_editor <- function(p.cur) { p.delete$call_Ext("enable") } } +# Working directory {{{2 +p.line.wd <- ggroup(cont = p.editor, horizontal = TRUE) +wd_handler <- function(h, ...) { + target_wd <- svalue(p.wde) + wd <- try(setwd(target_wd)) + if (inherits(wd, "try-error")) { + gmessage(paste("Could not set working directory to", target_wd), parent = w) + } else { + svalue(sb) <- paste("Changed working directory to", wd) + update_p.df() + } +} +p.wde <- gedit(getwd(), cont = p.line.wd, label = "Working directory", width = 50) +p.wde$add_handler_enter(wd_handler) +p.wdb <- gbutton("Change", cont = p.line.wd, handler = wd_handler) +tooltip(p.wdb) <- "Edit the box on the left and press enter to change" # File name {{{2 p.line.file <- ggroup(cont = p.editor, horizontal = TRUE) -p.filename.gg <- ggroup(width = 400, cont = p.line.file) -p.filename <- glabel("", cont = p.filename.gg) -p.delete.handler = function(h, ...) { - filename <- file.path(getwd(), paste0(svalue(p.name), ".gmkinws")) - gconfirm(paste0("Are you sure you want to delete ", filename, "?"), - parent = w, - handler = function(h, ...) { - if (inherits(try(unlink(filename)), "try-error")) { - gmessage("Deleting failed for an unknown reason", cont = w) - } else { - svalue(sb) <- paste("Deleted", filename) - svalue(p.filename) <- "" - p.delete$call_Ext("disable") - update_p.df() - p.gtable[,] <- p.df - } - }) -} -p.delete <- gbutton("Delete", cont = p.line.file, - handler = p.delete.handler) -p.delete$call_Ext("disable") +p.filename.gg <- ggroup(width = 105, cont = p.line.file) # for spacing +p.filename.label <- glabel("Project file:", cont = p.filename.gg) +p.filename <- glabel("", cont = p.line.file) # Import {{{2 p.line.import <- ggroup(cont = p.editor, horizontal = TRUE) p.line.import.p <- gcombobox(c("", p.df$Name), label = "Import from", cont = p.line.import, @@ -294,54 +335,41 @@ p.line.import.p <- gcombobox(c("", p.df$Name), label = "Import from", cont = p.l } p.line.import.dst[,] <- data.frame(Title = sapply(ws.import$ds, function(x) x$title), stringsAsFactors = FALSE) - p.line.import.mt[,] <- data.frame(Name = names(ws.import$m), + p.line.import.mt[,] <- data.frame(Name = sapply(ws.import$m, function(x) x$name), stringsAsFactors = FALSE) }) p.line.import.frames <- ggroup(cont = p.editor, horizontal = TRUE) p.line.import.dsf <- gframe("Datasets for import", cont = p.line.import.frames, horizontal = FALSE) p.line.import.dst <- gtable(ds.df.empty, cont = p.line.import.dsf, multiple = TRUE, - width = left_width - 10, height = 160) + width = left_width - 10, height = 160, + handler = function(h, ...) p.line.import.dsb$call_Ext("enable")) p.line.import.dsb <- gbutton("Import selected", cont = p.line.import.dsf, + ext.args = list(disabled = TRUE), handler = function(h, ...) { i <- svalue(p.line.import.dst, index = TRUE) - ws$ds <<- append(ws$ds, ws.import$ds[i]) + ws$add_ds(ws.import$ds[i]) update_ds.df() - ds.gtable[,] <- ds.df } ) p.line.import.mf <- gframe("Models for import", cont = p.line.import.frames, horizontal = FALSE) p.line.import.mt <- gtable(m.df.empty, cont = p.line.import.mf, multiple = TRUE, - width = left_width - 10, height = 160) + width = left_width - 10, height = 160, + handler = function(h, ...) p.line.import.mb$call_Ext("enable")) p.line.import.mb <- gbutton("Import selected", cont = p.line.import.mf, + ext.args = list(disabled = TRUE), handler = function(h, ...) { i <- svalue(p.line.import.mt, index = TRUE) - ws$m <<- append(ws$m, ws.import$m[i]) + ws$add_m(ws.import$m[i]) update_m.df() m.gtable[,] <- m.df } ) # center: Dataset editor {{{1 ds.editor <- gframe("", horizontal = FALSE, cont = center, - label = "Dataset editor") -# # Handler functions {{{2 -# ds.empty <- list( -# study_nr = 1, -# title = "", -# sampling_times = c(0, 1), -# time_unit = "", -# observed = "parent", -# unit = "", -# replicates = 1, -# data = data.frame( -# name = "parent", -# time = c(0, 1), -# value = c(100, NA), -# override = "NA", -# err = 1, -# stringsAsFactors = FALSE)) - + label = "Dataset") +# Handler functions {{{2 # copy_dataset_handler <- function(h, ...) { # ds.old <- ds.cur # ds.cur <<- as.character(1 + length(ds)) @@ -350,27 +378,23 @@ ds.editor <- gframe("", horizontal = FALSE, cont = center, # update_ds.df() # ds.gtable[,] <- ds.df # } -# -# delete_dataset_handler <- function(h, ...) { -# if (length(ds) > 1) { -# ds[[ds.cur]] <<- NULL -# names(ds) <<- as.character(1:length(ds)) -# ds.cur <<- names(ds)[[1]] -# update_ds.df() -# ds.gtable[,] <- ds.df -# update_ds_editor() -# } else { -# galert("Deleting the last dataset is not supported", parent = w) -# } -# } -# -# new_dataset_handler <- function(h, ...) { -# ds.cur <<- as.character(1 + length(ds)) -# ds[[ds.cur]] <<- ds.empty -# update_ds.df() -# ds.gtable[,] <- ds.df -# update_ds_editor() -# } + +delete_dataset_handler <- function(h, ...) { + ds.i <- svalue(ds.gtable, index = TRUE) + ws$delete_ds(ds.i) + update_ds.df() +} + +new_dataset_handler <- function(h, ...) { + ds.new <- ds.empty + ds.new$title <- "New dataset" + ws$add_ds(list(ds.new)) + ds.i <- length(ws$ds) + ds.cur <<- ws$ds[[ds.i]] + update_ds.df() + ds.gtable[,] <- ds.df + update_ds_editor() +} # tmptextheader <- character(0) # load_text_file_with_data <- function(h, ...) { @@ -471,15 +495,17 @@ ds.editor <- gframe("", horizontal = FALSE, cont = center, # # Widget setup {{{2 # Line 1 {{{3 -ds.e.1 <- ggroup(cont = ds.editor, horizontal = TRUE) -ds.title.ge <- gedit("", label = "Title", width = 50, cont = ds.e.1) +ds.e.buttons <- ggroup(cont = ds.editor, horizontal = TRUE) +ds.e.new <- gbutton("New dataset", cont = ds.e.buttons, handler = new_dataset_handler) +#gbutton("Copy dataset", cont = ds.e.1, handler = copy_dataset_handler) +ds.delete <- gbutton("Delete dataset", cont = ds.e.buttons, + handler = delete_dataset_handler, ext.args = list(disabled = TRUE)) +ds.e.2 <- ggroup(cont = ds.editor, horizontal = TRUE) +ds.title.ge <- gedit("", label = "Dataset title", width = 50, cont = ds.e.2) # # Line 2 {{{3 # ds.e.2 <- ggroup(cont = ds.editor, horizontal = TRUE) # ds.e.2a <- ggroup(cont = ds.e.2, horizontal = FALSE) -# gbutton("Copy dataset", cont = ds.e.2a, handler = copy_dataset_handler) -# gbutton("Delete dataset", cont = ds.e.2a, handler = delete_dataset_handler) -# gbutton("New dataset", cont = ds.e.2a, handler = new_dataset_handler) # ds.e.2b <- ggroup(cont = ds.e.2) # tmptextfile <- "" # Initialize file name for imported data @@ -557,7 +583,8 @@ ds.title.ge <- gedit("", label = "Title", width = 50, cont = ds.e.1) # # Update the dataset editor {{{3 update_ds_editor <- function() { - svalue(ds.title.ge) <- ws$ds[[ws$ds.cur]]$title + svalue(ds.title.ge) <- ds.cur$title + ds.delete$call_Ext("enable") # svalue(ds.study.gc, index = TRUE) <- ds[[ds.cur]]$study_nr # svalue(ds.e.st) <- paste(ds[[ds.cur]]$sampling_times, collapse = ", ") @@ -570,13 +597,13 @@ update_ds_editor <- function() { } # center: Model editor {{{1 m.editor <- gframe("", horizontal = FALSE, cont = center, - label = "Model editor") + label = "Model") # center: Fit configuration {{{1 f.config <- gframe("", horizontal = FALSE, cont = center, - label = "Fit configuration") + label = "Configuration") # center: Results viewer {{{1 r.viewer <- gframe("", horizontal = FALSE, cont = center, - label = "Result viewer") + label = "Result") svalue(center) <- 1 # right: Viewing area {{{1 # Workflow {{{2 @@ -652,5 +679,6 @@ changes.gh <- ghtml(label = "Changes", paste0("