[Rqda-commits] r65 - in pkg: . R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Mar 18 09:20:08 CET 2009
Author: wincent
Date: 2009-03-18 09:20:07 +0100 (Wed, 18 Mar 2009)
New Revision: 65
Modified:
pkg/ChangeLog
pkg/NAMESPACE
pkg/R/CaseButton.R
pkg/R/CaseFun.R
pkg/R/ProjectButton.R
pkg/R/ProjectFun.R
pkg/R/Variables.R
pkg/R/root_gui.R
Log:
Upgrade databaseversion, and add attributes Tab.
Modified: pkg/ChangeLog
===================================================================
--- pkg/ChangeLog 2009-03-17 04:39:22 UTC (rev 64)
+++ pkg/ChangeLog 2009-03-18 08:20:07 UTC (rev 65)
@@ -1,5 +1,12 @@
+2009-03-18
+ * upgrade databaseversion to "0.1.6" (three tables are added for attributes by UpgradeTables()).
+ * Attrs Tab for case/file attributes.
+ * fix some minor bugs.
+
2009-03-17
* Variable/Attributes of Case.
+ * Improvement of mark case button.
+ * The default order of case is alphabetical,that is sort(case).
2009-03-16
* The default order of codes is alphabetical.
Modified: pkg/NAMESPACE
===================================================================
--- pkg/NAMESPACE 2009-03-17 04:39:22 UTC (rev 64)
+++ pkg/NAMESPACE 2009-03-18 08:20:07 UTC (rev 65)
@@ -1,5 +1,5 @@
export(CleanProject,CrossCode,CrossTwo,GetCodingTable,GetFileId,
list.deleted,pdelete,relation,RQDA,
- SearchFiles,SummaryCoding,write.FileList)
+ SearchFiles,SummaryCoding,undelete,write.FileList)
S3method(print,SummaryCoding)
import(RGtk2)
Modified: pkg/R/CaseButton.R
===================================================================
--- pkg/R/CaseButton.R 2009-03-17 04:39:22 UTC (rev 64)
+++ pkg/R/CaseButton.R 2009-03-18 08:20:07 UTC (rev 65)
@@ -42,12 +42,12 @@
## if project is open, then continue
selectedCaseName <- svalue(CaseNamesWidget)
if (length(selectedCaseName)==0){
- gmessage("Select a Case first.",text=selectedCaseName,icon="error",con=TRUE)
+ gmessage("Select a Case first.",icon="error",con=TRUE)
}
else {
## get the new file names
NewName <- ginput("Enter new Case name. ", text=selectedCaseName, icon="info")
- if (NewName != ""){
+ if (!is.na(NewName)){
Encoding(NewName) <- "UTF-8"
rename(selectedCaseName,NewName,"cases")
CaseNamesUpdate()
@@ -98,7 +98,10 @@
CaseMark_Button<-function(){
gbutton("Mark",
- handler=function(h,...) {MarkCaseFun()}
+ handler=function(h,...) {
+ MarkCaseFun()
+ CaseNamesUpdate()
+ }
)
}
@@ -256,17 +259,15 @@
}
CaseNamesWidgetMenu$"Add Variables..."$handler <- function(h,...){
if (is_projOpen(env=.rqda,conName="qdacon")) {
- if (!dbExistsTable(.rqda$qdacon,"caseAttr")) { ## create a table
- dbGetQuery(.rqda$qdacon,"create table caseAttr (variable text, value text, caseID integer)")
- }
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)
}
-}
+}}
CaseNamesWidgetMenu$"Sort by created time"$handler <- function(h,...){
CaseNamesUpdate(.rqda$.CasesNamesWidget)
}
Modified: pkg/R/CaseFun.R
===================================================================
--- pkg/R/CaseFun.R 2009-03-17 04:39:22 UTC (rev 64)
+++ pkg/R/CaseFun.R 2009-03-18 08:20:07 UTC (rev 65)
@@ -1,13 +1,16 @@
-CaseNamesUpdate <- function(CaseNamesWidget=.rqda$.CasesNamesWidget,decreasing=FALSE,...)
+CaseNamesUpdate <- function(CaseNamesWidget=.rqda$.CasesNamesWidget,sortByTime=FALSE,decreasing=FALSE,...)
{
if (isIdCurrent(.rqda$qdacon)){
+## CaseName <- dbGetQuery(.rqda$qdacon, "select name, id,date from cases where status=1 order by lower(name)")
CaseName <- dbGetQuery(.rqda$qdacon, "select name, id,date from cases where status=1")
if (nrow(CaseName)==0) {
case <- NULL
} else {
case <- CaseName$name
Encoding(case) <- "UTF-8"
+ if (!sortByTime) {case <- sort(case)} else {
case <- case[OrderByTime(CaseName$date,decreasing=decreasing)]
+ }
}
tryCatch(CaseNamesWidget[] <- case, error=function(e){})
}
Modified: pkg/R/ProjectButton.R
===================================================================
--- pkg/R/ProjectButton.R 2009-03-17 04:39:22 UTC (rev 64)
+++ pkg/R/ProjectButton.R 2009-03-18 08:20:07 UTC (rev 65)
@@ -16,6 +16,7 @@
if (path!=""){
Encoding(path) <- "UTF-8"
open_proj(path,assignenv=.rqda)
+ UpgradeTables()
tryCatch(CodeNamesUpdate(sortByTime=FALSE),error=function(e){})
tryCatch(FileNamesUpdate(),error=function(e){})
tryCatch(CaseNamesUpdate(),error=function(e){})
Modified: pkg/R/ProjectFun.R
===================================================================
--- pkg/R/ProjectFun.R 2009-03-17 04:39:22 UTC (rev 64)
+++ pkg/R/ProjectFun.R 2009-03-18 08:20:07 UTC (rev 65)
@@ -59,9 +59,9 @@
owner text, date text, memo text)")
if (dbExistsTable(con,"project")) dbRemoveTable(con, "project")
## coding: information about the project
- dbGetQuery(con,"create table project (encoding text, detabaseversion text, date text,dateM text,
+ dbGetQuery(con,"create table project (encoding text, databaseversion text, date text,dateM text,
memo text,BOM integer)")
- dbGetQuery(con,sprintf("insert into project (detabaseversion,date,memo) values ('0.1.5','%s','')",date()))
+ dbGetQuery(con,sprintf("insert into project (databaseversion,date,memo) values ('0.1.6','%s','')",date()))
if (dbExistsTable(con,"cases")) dbRemoveTable(con, "cases")
dbGetQuery(con,"create table cases (name text, memo text,
owner text,date text,dateM text,
@@ -70,6 +70,13 @@
dbGetQuery(con,"create table caselinkage (caseid integer, fid integer,
selfirst real, selend real, status integer,
owner text, date text, memo text)")
+
+ if (dbExistsTable(con,"attributes")) dbRemoveTable(con, "attributes")
+ dbGetQuery(.rqda$qdacon,"create table attributes (name text, status integer, date text, dateM text, owner text)")
+ if (dbExistsTable(con,"caseAttr")) dbRemoveTable(con, "caseAttr")
+ dbGetQuery(.rqda$qdacon,"create table caseAttr (variable text, value text, caseID integer, date text, dateM text, owner text)")
+ if (dbExistsTable(con,"fileAttr")) dbRemoveTable(con, "fileAttr")
+ dbGetQuery(.rqda$qdacon,"create table fileAttr (variable text, value text, fileID integer, date text, dateM text, owner text)")
}
}
}
Modified: pkg/R/Variables.R
===================================================================
--- pkg/R/Variables.R 2009-03-17 04:39:22 UTC (rev 64)
+++ pkg/R/Variables.R 2009-03-18 08:20:07 UTC (rev 65)
@@ -4,3 +4,104 @@
## reshape(DF,v.name="value",idvar="caseName",direction="wide",timevar="varName")
## use AddVarWidget to add/change values
## use gdf to view and change the value
+
+
+UpgradeTables <- function(){
+ Fields <- dbListFields(.rqda$qdacon,"project")
+ if (!"databaseversion" %in% Fields) {
+ dbGetQuery(.rqda$qdacon,"alter table project add column databaseversion text")
+ dbGetQuery(.rqda$qdacon,"update project set databaseversion=='0.1.5'")
+ }
+ currentVersion <- dbGetQuery(.rqda$qdacon,"select databaseversion from project")[[1]]
+ if (currentVersion=="0.1.5") {
+ ##from="0.1.5"
+ dbGetQuery(.rqda$qdacon,"create table caseAttr (variable text, value text, caseID integer, date text, dateM text, owner text)")
+ ## caseAttr table
+ dbGetQuery(.rqda$qdacon,"create table fileAttr (variable text, value text, fileID integer, date text, dateM text, owner text)")
+ ## fileAttr table
+ dbGetQuery(.rqda$qdacon,"create table attributes (name text, status integer, date text, dateM text, owner text)")
+ ## attributes table
+ dbGetQuery(.rqda$qdacon,"update project set databaseversion='0.1.6'")
+ ## reset the version.
+ }
+}
+
+
+AttrNamesUpdate <- function(Widget=.rqda$.AttrNamesWidget,sortByTime=FALSE,decreasing=FALSE,...)
+{
+ if (isIdCurrent(.rqda$qdacon)){
+ attr <- dbGetQuery(.rqda$qdacon, "select name, date from attributes where status=1")
+ if (nrow(attr)==0) {
+ attr <- NULL
+ } else {
+ attr <- attr$name
+ Encoding(attr) <- "UTF-8"
+ if (!sortByTime) {attr <- sort(attr)} else {
+ attr <- attr[OrderByTime(attr$date,decreasing=decreasing)]
+ }
+ }
+ tryCatch(Widget[] <- attr, error=function(e){})
+ }
+}
+
+AddAttrNames <- function(name,...) {
+ if (name != ""){
+ con <- .rqda$qdacon
+ dup <- dbGetQuery(con,sprintf("select name from attributes where name=='%s'",name))
+ if (nrow(dup)==0) {
+ dbGetQuery(con,sprintf("insert into attributes (name,status,date,owner) values ('%s', %i,%s, %s)",
+ name,1, shQuote(date()),shQuote(.rqda$owner)))
+ }
+ }
+}
+
+AddAttrButton <- function(label="ADD"){
+ gbutton(label,handler=function(h,...) {
+ if (is_projOpen(env=.rqda,conName="qdacon")) {
+ AttrName <- ginput("Enter new Attr Name. ", icon="info")
+ if (!is.na(AttrName)) {
+ Encoding(AttrName) <- "UTF-8"
+ AddAttrNames(AttrName)
+ AttrNamesUpdate()
+ }
+ }
+ }
+ )
+}
+
+DeleteAttrButton <- function(label="Delete"){
+ gbutton(label,handler=function(h,...) {
+ if (is_projOpen(env=.rqda,conName="qdacon") & length(svalue(.rqda$.AttrNamesWidget))!=0)
+ {
+ del <- gconfirm("Really delete the Attribute?",icon="question")
+ if (isTRUE(del)){
+ Selected <- svalue(.rqda$.AttrNamesWidget)
+ Encoding(Selected) <- "UTF-8"
+ dbGetQuery(.rqda$qdacon,sprintf("update attributes set status=0 where name=='%s'",Selected))
+ AttrNamesUpdate()
+ }
+ }
+ }
+ )
+}
+
+RenameAttrButton <- function(label="Rename"){
+ gbutton(label,handler=function(h,...) {
+ if (is_projOpen(env=.rqda,conName="qdacon")) {
+ selected <- svalue(.rqda$.AttrNamesWidget)
+ if (length(selected)==0){
+ gmessage("Select a attribute first.",icon="error",con=TRUE)
+ }
+ else {
+ ## get the new file names
+ NewName <- ginput("Enter new attribute name. ", text=selected, icon="info")
+ if (!is.na(NewName)){
+ Encoding(NewName) <- "UTF-8"
+ dbGetQuery(.rqda$qdacon, sprintf("update attributes set name = '%s' where name == '%s' ",NewName,selected))
+ AttrNamesUpdate()
+ }
+ }
+ }
+ }
+ )
+}
Modified: pkg/R/root_gui.R
===================================================================
--- pkg/R/root_gui.R 2009-03-17 04:39:22 UTC (rev 64)
+++ pkg/R/root_gui.R 2009-03-18 08:20:07 UTC (rev 65)
@@ -95,6 +95,17 @@
##.case_buttons[2,3] <- AddWebSearchButton("WebSearch") # use popup menu instead
+########################### GUI for Attributes
+###########################
+ ".attr_pan" <- gpanedgroup(container=.nb_rqdagui,horizontal=FALSE,label="Attrs")
+ ".attr_buttons" <- glayout(container=.attr_pan)
+ ".attr_PW" <- ggroup(cont=.attr_pan,horizontal = FALSE)
+ ".AttrNamesWidget" <- gtable("Please click Update",container=.attr_PW,expand=TRUE,multiple=FALSE)
+ .AttrNamesWidget[] <- NULL ; names(.AttrNamesWidget) <- "Attributes"
+ .attr_buttons[1,1] <- AddAttrButton()
+ .attr_buttons[1,2] <- DeleteAttrButton()
+ .attr_buttons[1,3] <- RenameAttrButton()
+
######################### GUI for C-cat
#########################
".codecat_pan" <- gpanedgroup(container=.nb_rqdagui,horizontal=FALSE,label="C-Cat")
@@ -153,6 +164,7 @@
assign(".fnames_rqda",.fnames_rqda,env=.rqda)
##assign(".fsearch_rqda",.fsearch_rqda,env=.rqda)
assign(".CasesNamesWidget",.CasesNamesWidget,env=.rqda)
+assign(".AttrNamesWidget",.AttrNamesWidget,env=.rqda)
assign(".FileofCase",.FileofCase,env=.rqda)
assign(".CodeCatWidget",.CodeCatWidget,env=.rqda)
assign(".CodeofCat",.CodeofCat,env=.rqda)
@@ -165,6 +177,7 @@
svalue(.codecat_pan)<-0.07
svalue(.filecat_pan)<-0.07
svalue(.case_pan)<-0.07
+svalue(.attr_pan)<-0.07
##########################
Handler()
More information about the Rqda-commits
mailing list