Hard work to make the project management safe

At the moment it is distracting, as modification tracking of projects is
not implemented yet

1 files changed, 180 insertions, 152 deletions

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 = "<b>Project name</b>",

                  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 = "<b>Dataset title</b>", 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("<div class = 'news' style = 'marg
 

 svalue(right) <- 1

 

-

+# Update meta objects and their depending widgets

+update_p.df()

 # vim: set foldmethod=marker ts=2 sw=2 expandtab: {{{1