[Rqda-commits] r66 - pkg/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Mar 18 15:59:03 CET 2009
Author: wincent
Date: 2009-03-18 15:59:03 +0100 (Wed, 18 Mar 2009)
New Revision: 66
Modified:
pkg/R/AddVarWidget.R
pkg/R/CaseButton.R
pkg/R/Coding_Buttons.R
pkg/R/ProjectButton.R
Log:
Modified: pkg/R/AddVarWidget.R
===================================================================
--- pkg/R/AddVarWidget.R 2009-03-18 08:20:07 UTC (rev 65)
+++ pkg/R/AddVarWidget.R 2009-03-18 14:59:03 UTC (rev 66)
@@ -146,3 +146,137 @@
window$showAll()
invisible(window)
}
+
+
+EditVarWidget <- function(ExistingItems=NULL,container=NULL,title=NULL,ID=NULL,saveFUN=NULL,...){
+ ## modified from RGtk2 package
+ ## ExistingItems: existing data set for a case/file etc. It is data frame of 2 columns, the first is Variable
+ ## saveFUN is character.
+ ## container: similar to that of gWidget package.
+ COLUMN <- c(Variable = 0, Value = 1, editable = 2)
+ articles <- NULL
+
+ create.model <- function()
+ {
+ ## create the array of data
+ articles <<- list()
+ ## create list store
+ model <- gtkListStoreNew( "gchararray", "gchararray", "gboolean")
+ ## add item from ExistingItems
+ ## needs modification
+ if (!is.null(ExistingItems)){
+ articles <<- c(articles,unlist(apply(ExistingItems,1,function(x) list(list(Variable=x[1],Value=x[2],editable=TRUE))),FALSE))
+ for (i in 1:length(articles))
+ {
+ iter <- model$append()$iter
+ model$set(iter, COLUMN["Variable"], articles[[i]]$Variable,
+ COLUMN["Value"], articles[[i]]$Value,
+ COLUMN["editable"], articles[[i]]$editable)
+ }
+ }
+ return(model)
+ }
+
+ cell.edited <- function(cell, path.string, new.text, data)
+ {
+ checkPtrType(data, "GtkListStore")
+ model <- data
+ path <- gtkTreePathNewFromString(path.string)
+ column <- cell$getData("column")
+ iter <- model$getIter(path)$iter
+ if (column==1){
+ i <- path$getIndices()[[1]]+1
+ articles[[i]]$Value <<- new.text
+ model$set(iter, column, articles[[i]]$Value)
+ }
+ }
+
+ add.columns <- function(treeview)
+ {
+ model <- treeview$getModel()
+ ## Variable column
+ renderer <- gtkCellRendererTextNew()
+ gSignalConnect(renderer, "edited", cell.edited, model)
+ renderer$setData("column", COLUMN["Variable"])
+ treeview$insertColumnWithAttributes(-1, "Variable", renderer,text = COLUMN[["Variable"]], editable = COLUMN[["editable"]])
+ ## Value column
+ renderer <- gtkCellRendererTextNew()
+ gSignalConnect(renderer, "edited", cell.edited, model)
+ renderer$setData("column", COLUMN["Value"])
+ treeview$insertColumnWithAttributes(-1, "Value", renderer, text = COLUMN[["Value"]],editable = COLUMN[["editable"]])
+ }
+
+ saveFUN <- get(saveFUN,mode="function")
+
+ ## create window, etc
+ window <- gtkWindowNew("toplevel", show = F)
+ window$setTitle(paste("Var:",title))
+ window$setBorderWidth(5)
+ vbox <- gtkVBoxNew(FALSE, 5)
+ window$add(vbox)
+ sw <- gtkScrolledWindowNew(NULL, NULL)
+ sw$setShadowType("etched-in")
+ sw$setPolicy("automatic", "automatic")
+ vbox$packStart(sw, TRUE, TRUE, 0)
+ ## create model
+ model <- create.model()
+ ## create tree view
+ treeview <- gtkTreeViewNewWithModel(model)
+ treeview$setRulesHint(TRUE)
+ treeview$getSelection()$setMode("single")
+ add.columns(treeview)
+ sw$add(treeview)
+ ## some buttons
+ hbox <- gtkHBoxNew(TRUE, 4)
+ vbox$packStart(hbox, FALSE, FALSE, 0)
+ button <- gtkButtonNewWithLabel("Save and Close")
+ gSignalConnect(button, "clicked",saveFUN,list(model,window,list(...)))
+ hbox$packStart(button, TRUE, TRUE, 0)
+ window$setDefaultSize(200, 350)
+ window$showAll()
+ invisible(window)
+}
+
+saveAndClose <- function(button,data){
+ ## the first arg must button, and data as second.
+ ## push dataset into project file.
+ model <- data[[1]]
+ window <- data[[2]]
+ MoreArgs <- data[[3]]
+ IterFirst <- model$getIterFirst()
+ cond <- IterFirst[[1]]
+ iter <- IterFirst$iter
+ ans <- c()
+ while(cond) {
+ dat <- unlist(model$get(iter, 0, 1))
+ ans <- c(ans,dat)
+ cond <- model$iterNext(iter)
+ }
+ n <- length(ans)
+ if (n >= 2){
+ idx1 <- seq(1,to=n,by=2)
+ idx2 <- seq(2,to=n,by=2)
+ ans <- data.frame(Variable=ans[idx1],Value=ans[idx2])
+ ans <- cbind(ans,caseID=MoreArgs$caseId)
+ ## cal which variable is added and which is modified
+ ## alter the table for the modified variable
+ ## add the new variable to table
+ print(ans)
+ ## dbWriteTable(.rqda$qdacon, "caseAttr", ans, append = TRUE,row.names=FALSE)
+ }
+ window$Destroy()## close
+}
+
+CaseAttrFun <- function(caseId,title=NULL){
+ attrs <- dbGetQuery(.rqda$qdacon,"select name from attributes where status==1")[[1]]
+ if (length(attrs)==0) gmessage("add attribute in Attrs Tabe first.",con=T) else{
+ attrs2 <- data.frame(variable=attrs,value=NA)
+ variables <- dbGetQuery(.rqda$qdacon,sprintf("select variable, value from caseAttr where caseID==%i",caseId))
+ if (nrow(variables)!=0){
+ idx <- attrs2[[1]] %in% variables[[1]]
+ attrs2[idx,] <- variables
+ }
+ EditVarWidget(ExistingItems=attrs2,saveFUN="saveAndClose",title=title,caseId=caseId)
+ ## get attrs list and turn it to a data frame, pass it to ExistingItems, then call EditVarWidget
+ }
+}
Modified: pkg/R/CaseButton.R
===================================================================
--- pkg/R/CaseButton.R 2009-03-18 08:20:07 UTC (rev 65)
+++ pkg/R/CaseButton.R 2009-03-18 14:59:03 UTC (rev 66)
@@ -100,7 +100,7 @@
gbutton("Mark",
handler=function(h,...) {
MarkCaseFun()
- CaseNamesUpdate()
+ UpdateFileofCaseWidget()
}
)
}
@@ -262,10 +262,7 @@
SelectedCase <- svalue(.rqda$.CasesNamesWidget)
if (length(SelectedCase!=0)){
caseid <- dbGetQuery(.rqda$qdacon,sprintf("select id from cases where status=1 and name='%s'",SelectedCase))[,1]
- ## get existingItems first
- existingItems <- dbGetQuery(.rqda$qdacon,sprintf("select variable, value from caseAttr where caseid='%s'",caseid))
- if (nrow(existingItems) == 0) existingItems <- NULL
- AddVarWidget(ExistingItems=existingItems,title=SelectedCase,ID=caseid)
+ CaseAttrFun(caseId=caseid,title=SelectedCase)
}
}}
CaseNamesWidgetMenu$"Sort by created time"$handler <- function(h,...){
Modified: pkg/R/Coding_Buttons.R
===================================================================
--- pkg/R/Coding_Buttons.R 2009-03-18 08:20:07 UTC (rev 65)
+++ pkg/R/Coding_Buttons.R 2009-03-18 14:59:03 UTC (rev 66)
@@ -317,7 +317,7 @@
else {
## get the new file names
NewCodeName <- ginput("Enter new code name. ", text=selectedCodeName, icon="info")
- if (NewCodeName != "") {
+ if (!is.na(NewCodeName)) {
Encoding(NewCodeName) <- "UTF-8"
## update the name in source table by a function
rename(selectedCodeName,NewCodeName,"freecode")
Modified: pkg/R/ProjectButton.R
===================================================================
--- pkg/R/ProjectButton.R 2009-03-18 08:20:07 UTC (rev 65)
+++ pkg/R/ProjectButton.R 2009-03-18 14:59:03 UTC (rev 66)
@@ -24,7 +24,7 @@
tryCatch(UpdateCodeofCatWidget(),error=function(e){})
tryCatch(UpdateTableWidget(Widget=.rqda$.FileCatWidget,FromdbTable="filecat"),error=function(e){})
tryCatch(UpdateFileofCatWidget(),error=function(e){})
-
+ tryCatch(AttrNamesUpdate(),error=function(e){})
}
}
)
@@ -40,6 +40,7 @@
tryCatch(.rqda$.CodeofCat[]<-NULL,error=function(e){})
tryCatch(.rqda$.FileCatWidget[]<-NULL,error=function(e){})
tryCatch(.rqda$.FileofCat[]<-NULL,error=function(e){})
+ tryCatch(AttrNamesUpdate(),error=function(e){})
close_proj(assignenv=.rqda)
}
)
More information about the Rqda-commits
mailing list