[Rqda-commits] r28 - in pkg: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Dec 4 13:56:57 CET 2008
Author: wincent
Date: 2008-12-04 13:56:57 +0100 (Thu, 04 Dec 2008)
New Revision: 28
Modified:
pkg/ChangeLog
pkg/R/CaseButton.R
pkg/R/CaseFun.R
pkg/R/FileButton.R
pkg/R/FileCatButton.R
pkg/R/GUIHandler.R
pkg/R/root_gui.R
pkg/TODO
pkg/man/RQDA-package.Rd
Log:
Modified: pkg/ChangeLog
===================================================================
--- pkg/ChangeLog 2008-12-03 16:59:15 UTC (rev 27)
+++ pkg/ChangeLog 2008-12-04 12:56:57 UTC (rev 28)
@@ -1,5 +1,9 @@
2008-12-04
- * Better handler colors for coding and case-mark. Now can customize colors for coding-mark (set .rqda$fore.col, default is "blue") and case-mark (set .rqda$back.col, default is "gray92").
+ * Better handler colors for coding and case-mark. Now can customize colors for coding-mark
+ (set .rqda$fore.col, default is "blue") and case-mark (set .rqda$back.col, default is "gray92").
+ * Add selected file to File-category by popup menu in Files Tab.
+ * Popup menu in Cases tab to link files with selected case.
+ * Drop selected Files from Files.of.This.Case Widget by clicking popu menu.
2008-12-03
* Attached file to case by pop-up menu in Files Tab.
Modified: pkg/R/CaseButton.R
===================================================================
--- pkg/R/CaseButton.R 2008-12-03 16:59:15 UTC (rev 27)
+++ pkg/R/CaseButton.R 2008-12-04 12:56:57 UTC (rev 28)
@@ -168,11 +168,56 @@
}
}
-
-## pop-up menu of add to case
-AddFileToCaseMenu <- list()
-AddFileToCaseMenu$AddFileTo$handler <- function(h, ...) {
+CaseNamesWidgetMenu$"AddFile(s)"$handler <- function(h, ...) {
if (is_projOpen(env = .rqda, conName = "qdacon", message = FALSE)) {
- AddFileToCaselinkage()
+ SelectedCase <- svalue(.rqda$.CasesNamesWidget)
+ caseid <- dbGetQuery(.rqda$qdacon,sprintf("select id from cases where status=1 and name='%s'",SelectedCase))[,1]
+ freefile <- dbGetQuery(.rqda$qdacon,"select name, id, file from source where status=1")
+ fileofcase <- dbGetQuery(.rqda$qdacon,sprintf("select fid from caselinkage where status=1 and caseid=%i",caseid))
+ Encoding(freefile[['name']]) <- Encoding(freefile[['file']]) <- "UTF-8"
+ if (nrow(fileofcase)!=0){
+ fileoutofcase <- subset(freefile,!(id %in% fileofcase$fid))
+ } else fileoutofcase <- freefile
+ if (length(fileoutofcase[['name']])==0) gmessage("All files are linked with this case.", cont=TRUE) else {
+ Selected <- select.list(fileoutofcase[['name']],multiple=TRUE)
+ if (length(Selected)> 0) {
+ Selected <- iconv(Selected,to="UTF-8")
+ fid <- fileoutofcase[fileoutofcase$name %in% Selected,"id"]
+ selend <- nchar(fileoutofcase[fileoutofcase$name %in% Selected,"file"])
+ Dat <- data.frame(caseid=caseid,fid=fid,selfirst=0,selend,status=1,owner=.rqda$owner,date=date(),memo="")
+ dbWriteTable(.rqda$qdacon,"caselinkage",Dat,row.names=FALSE,append=TRUE)
+ UpdateFileofCaseWidget()
+ }
+ }
}
}
+
+
+
+## pop-up menu of .rqda$.FileofCase
+FileofCaseWidgetMenu <- list() ## not used yet.
+FileofCaseWidgetMenu$"DropFile(s)"$handler <- function(h, ...) {
+ if (is_projOpen(env = .rqda, conName = "qdacon", message = FALSE)) {
+ FileOfCat <- svalue(.rqda$.FileofCase)
+ if ((NumofSelected <- length(FileOfCat)) ==0) {
+ gmessage("Please select the Files you want to delete.",con=TRUE)} else
+ {
+ ## Give a confirm msg
+ del <- gconfirm(sprintf("Delete %i file(s) from this category. Are you sure?",NumofSelected),con=TRUE,icon="question")
+ if (isTRUE(del)){
+ SelectedCase <- svalue(.rqda$.CasesNamesWidget)
+ ## Encoding(SelectedCase) <- Encoding(FileOfCat)<- "UTF-8"
+ caseid <- dbGetQuery(.rqda$qdacon,sprintf("select id from cases where status=1 and name='%s'",SelectedCase))[,1]
+ for (i in FileOfCat){
+ fid <- dbGetQuery(.rqda$qdacon,sprintf("select id from source where status=1 and name='%s'",i))[,1]
+ dbGetQuery(.rqda$qdacon,sprintf("update caselinkage set status==0 where caseid==%i and fid==%i",caseid,fid))
+ }
+ ## update Widget
+ UpdateFileofCaseWidget()
+ }
+ }
+ }
+}
+
+
+
Modified: pkg/R/CaseFun.R
===================================================================
--- pkg/R/CaseFun.R 2008-12-03 16:59:15 UTC (rev 27)
+++ pkg/R/CaseFun.R 2008-12-04 12:56:57 UTC (rev 28)
@@ -47,7 +47,7 @@
if (nrow(cases)!=0){
Encoding(cases$name) <- "UTF-8"
ans <- select.list(cases$name,multiple=FALSE)
- if (length(ans)!=0){
+ if (ans!=""){
ans <- iconv(ans,to="UTF-8")
caseid <- cases$id[cases$name %in% ans]
@@ -98,3 +98,5 @@
}
}
}
+
+
Modified: pkg/R/FileButton.R
===================================================================
--- pkg/R/FileButton.R 2008-12-03 16:59:15 UTC (rev 27)
+++ pkg/R/FileButton.R 2008-12-04 12:56:57 UTC (rev 28)
@@ -132,3 +132,19 @@
}
+
+## pop-up menu of add to case and F-cat from Files Tab
+AddFileToCaseMenu <- list()
+AddFileToCaseMenu$AddToCase$handler <- function(h, ...) {
+ if (is_projOpen(env = .rqda, conName = "qdacon", message = FALSE)) {
+ AddFileToCaselinkage()
+ UpdateFileofCaseWidget()
+ }
+ }
+
+AddFileToCaseMenu$AddToCategory$handler <- function(h, ...) {
+ if (is_projOpen(env = .rqda, conName = "qdacon", message = FALSE)) {
+ AddToFileCategory()
+ UpdateFileofCatWidget()
+ }
+ }
\ No newline at end of file
Modified: pkg/R/FileCatButton.R
===================================================================
--- pkg/R/FileCatButton.R 2008-12-03 16:59:15 UTC (rev 27)
+++ pkg/R/FileCatButton.R 2008-12-04 12:56:57 UTC (rev 28)
@@ -129,3 +129,38 @@
}
)
}
+
+
+
+AddToFileCategory<- function(){
+ ## filenames -> fid -> selfirst=0; selend=nchar(filesource)
+ filename <- svalue(.rqda$.fnames_rqda)
+ Encoding(filename) <- "unknown"
+ query <- dbGetQuery(.rqda$qdacon,sprintf("select id, file from source where name = '%s' and status=1",filename))
+ fid <- query$id
+ Encoding(query$file) <- "UTF-8"
+
+ ## select a F-cat name -> F-cat id
+ Fcat <- dbGetQuery(.rqda$qdacon,"select catid, name from filecat where status=1")
+ if (nrow(Fcat)!=0){
+ Encoding(Fcat$name) <- "UTF-8"
+ ans <- select.list(Fcat$name,multiple=FALSE)
+ if (ans!=""){
+ ans <- iconv(ans,to="UTF-8")
+ Fcatid <- Fcat$catid[Fcat$name %in% ans]
+ exist <- dbGetQuery(.rqda$qdacon,sprintf("select fid from treefile where status=1 and fid=%i and catid=%i",fid,Fcatid))
+ if (nrow(exist)==0){
+ ## write only when the selected file associated with specific f-cat is not there
+ DAT <- data.frame(fid=fid, catid=Fcatid, date=date(),dateM=date(),memo='',status=1)
+ ## should pay attention to the var order of DAT, must be the same as that of treefile table
+ success <- dbWriteTable(.rqda$qdacon,"treefile",DAT,row.name=FALSE,append=TRUE)
+ ## write to caselinkage table
+ if (success) {
+ UpdateFileofCatWidget()
+ }
+ if (!success) gmessage("Fail to write to database.")
+ }
+ }
+ }
+}
+
Modified: pkg/R/GUIHandler.R
===================================================================
--- pkg/R/GUIHandler.R 2008-12-03 16:59:15 UTC (rev 27)
+++ pkg/R/GUIHandler.R 2008-12-04 12:56:57 UTC (rev 28)
@@ -79,41 +79,41 @@
addHandlerClicked(.rqda$.codes_rqda,handler <- function(h,...){
- if (is_projOpen(env=.rqda,conName="qdacon")){
- CodeNamesUpdate(CodeNamesWidget=.rqda$.codes_rqda)
- con <- .rqda$qdacon
- SelectedCode <- currentCode <- svalue(.rqda$.codes_rqda)
- if (length(SelectedCode)!=0) {
- Encoding(SelectedCode) <- Encoding(currentCode) <- "UTF-8"
- currentCid <- dbGetQuery(con,sprintf("select id from freecode where name=='%s'",SelectedCode))[,1]
- SelectedFile <- tryCatch(svalue(.rqda$.root_edit) ## use root_edit is more reliable
- ,error=function(e){})
- if (!is.null(SelectedFile)) {
- Encoding(SelectedFile) <- "UTF-8"
- currentFid <- dbGetQuery(con,sprintf("select id from source where name=='%s'",SelectedFile))[,1]
- ## following code: Only mark the text chuck according to the current code.
- tryCatch({
- widget <- get(h$action$marktxtwidget,.rqda)
+ if (is_projOpen(env=.rqda,conName="qdacon")){
+ ## CodeNamesUpdate(CodeNamesWidget=.rqda$.codes_rqda)
+ con <- .rqda$qdacon
+ SelectedCode <- currentCode <- svalue(.rqda$.codes_rqda)
+ if (length(SelectedCode)!=0) {
+ Encoding(SelectedCode) <- Encoding(currentCode) <- "UTF-8"
+ currentCid <- dbGetQuery(con,sprintf("select id from freecode where name=='%s'",SelectedCode))[,1]
+ SelectedFile <- tryCatch(svalue(.rqda$.root_edit) ## use root_edit is more reliable
+ ,error=function(e){})
+ if (!is.null(SelectedFile)) {
+ Encoding(SelectedFile) <- "UTF-8"
+ currentFid <- dbGetQuery(con,sprintf("select id from source where name=='%s'",SelectedFile))[,1]
+ ## following code: Only mark the text chuck according to the current code.
+ tryCatch({
+ widget <- get(h$action$marktxtwidget,.rqda)
## if widget is not open, then error;which means no need to highlight anything.
- sel_index <- dbGetQuery(con,sprintf("select selfirst, selend from coding where
+ sel_index <- dbGetQuery(con,sprintf("select selfirst, selend from coding where
cid==%i and fid==%i and status==1",currentCid, currentFid))
- Maxindex <- dbGetQuery(con, sprintf("select max(selend) from coding where fid==%i", currentFid))[1,1]
- ClearMark(widget,min=0,max=Maxindex)
+ Maxindex <- dbGetQuery(con, sprintf("select max(selend) from coding where fid==%i", currentFid))[1,1]
+ ClearMark(widget,min=0,max=Maxindex)
if (nrow(sel_index)>0){
- HL(widget,index=sel_index)}
- },error=function(e){}) # end of mark text chuck
- }
- }
- }},action=list(marktxtwidget=".openfile_gui")
+ HL(widget,index=sel_index,fore.col=NULL,back.col=.rqda$back.col)}
+ },error=function(e){}) # end of mark text chuck
+ }
+ }
+ }},action=list(marktxtwidget=".openfile_gui")
)
+
-
- addHandlerMouseMotion(.rqda$.CasesNamesWidget, handler <- function(h, ...) {
- if (is_projOpen(env = .rqda, conName ="qdacon",message = FALSE)) {
- CaseNamesUpdate(.rqda$.CasesNamesWidget)
- }
- }
- )
+## addHandlerMouseMotion(.rqda$.CasesNamesWidget, handler <- function(h, ...) {
+## if (is_projOpen(env = .rqda, conName ="qdacon",message = FALSE)) {
+## CaseNamesUpdate(.rqda$.CasesNamesWidget)
+## }
+## }
+## )
@@ -136,9 +136,9 @@
sel_index <- dbGetQuery(con,sprintf("select selfirst, selend from caselinkage where
caseid==%i and fid==%i and status==1",currentCid, currentFid))
Maxindex <- dbGetQuery(con, sprintf("select max(selend) from caselinkage where fid==%i", currentFid))[1,1]
- ClearMark(widget,min=0,max=Maxindex)
+ ClearMark(widget,min=0,max=Maxindex,clear.fore.col=FALSE,clear.back.col=TRUE)
if (nrow(sel_index)>0){
- HL(widget,index=sel_index)}
+ HL(widget,index=sel_index,fore.col=NULL,back.col=.rqda$back.col)}
},error=function(e){}) # end of mark text chuck
}
}
@@ -165,6 +165,8 @@
addhandlerclicked(.rqda$.CasesNamesWidget, handler <- function(h,...) {UpdateFileofCaseWidget()})
+add3rdmousepopupmenu(.rqda$.FileofCase, FileofCaseWidgetMenu)
+
addhandlerdoubleclick(.rqda$.FileofCase, handler <- function(h,...) {
ViewFileFun(FileNameWidget=.rqda$.FileofCase)
HL_Case()
Modified: pkg/R/root_gui.R
===================================================================
--- pkg/R/root_gui.R 2008-12-03 16:59:15 UTC (rev 27)
+++ pkg/R/root_gui.R 2008-12-04 12:56:57 UTC (rev 28)
@@ -35,7 +35,7 @@
glabel(
"Author: <ronggui.huang at gmail.com>\n
License: New style BSD License\n
-Version: 0.1.5 rev 27\n",
+Version: 0.1.5 rev 28\n",
container=.proj_gui)
@@ -80,14 +80,14 @@
".case_PW" <- ggroup(cont=.case_pan,horizontal = FALSE)
".CasesNamesWidget" <- gtable("Please click Update",container=.case_PW,expand=TRUE,multiple=FALSE)
.CasesNamesWidget[] <- NULL ; names(.CasesNamesWidget) <- "Cases"
- ".FileofCase" <- gtable("Please click Update",container=.case_PW,expand=TRUE,multiple=FALSE)
+ ".FileofCase" <- gtable("Please click Update",container=.case_PW,expand=TRUE,multiple=TRUE)
.FileofCase[] <- NULL;names(.FileofCase)<-"Files of This Case"
.case_buttons[1,1] <- AddCaseButton()
.case_buttons[1,2] <- DeleteCaseButton()
.case_buttons[1,3] <- Case_RenameButton()
- .case_buttons[1,4] <- CaseMark_Button()
- .case_buttons[1,5] <- CaseMemoButton()
+ .case_buttons[1,4] <- CaseMemoButton()
+ .case_buttons[1,5] <- CaseMark_Button()
##.case_buttons[2,3] <- AddWebSearchButton("WebSearch") # use popup menu instead
@@ -103,8 +103,8 @@
.codecat_buttons[1,1] <- AddCodeCatButton("Add")
.codecat_buttons[1,2] <- DeleteCodeCatButton("Delete") ## should take care of treecode table
.codecat_buttons[1,3] <- CodeCat_RenameButton("Rename")
- .codecat_buttons[1,4] <- CodeCatAddToButton("AddTo")
- .codecat_buttons[1,5] <- CodeCatDropFromButton("DropFrom")
+ .codecat_buttons[1,4] <- CodeCatAddToButton("AddCode")
+ .codecat_buttons[1,5] <- CodeCatDropFromButton("DropCode")
######################### GUI for F-cat
#########################
@@ -118,8 +118,8 @@
.filecat_buttons[1,1] <- AddFileCatButton("Add")
.filecat_buttons[1,2] <- DeleteFileCatButton("Delete") ## should take care of treecode table
.filecat_buttons[1,3] <- FileCat_RenameButton("Rename")
- .filecat_buttons[1,4] <- FileCatAddToButton("AddTo")
- .filecat_buttons[1,5] <- FileCatDropFromButton("DropFrom")
+ .filecat_buttons[1,4] <- FileCatAddToButton("AddFile")
+ .filecat_buttons[1,5] <- FileCatDropFromButton("DropFile")
######################### GUI for settings
#########################
Modified: pkg/TODO
===================================================================
--- pkg/TODO 2008-12-03 16:59:15 UTC (rev 27)
+++ pkg/TODO 2008-12-04 12:56:57 UTC (rev 28)
@@ -1,12 +1,16 @@
-tree-like structure of files.
-
-summary functions for review of coding.
-
-functions cleaning treecode/codecat table. and the previous deletion functions should be modified.
-
-Merge *rqda from different coders.
-
-inter-coder reliability
-
-### less important
-should add document on the table structure.
+tree-like structure of files.
+
+summary functions for review of coding.
+
+functions cleaning treecode/codecat table. and the previous deletion functions should be modified.
+
+Merge *rqda from different coders.
+
+inter-coder reliability
+
+f-cat and c-cat memo
+
+unmark button in Cases Tab
+
+### less important
+should add document on the table structure.
Modified: pkg/man/RQDA-package.Rd
===================================================================
--- pkg/man/RQDA-package.Rd 2008-12-03 16:59:15 UTC (rev 27)
+++ pkg/man/RQDA-package.Rd 2008-12-04 12:56:57 UTC (rev 28)
@@ -17,7 +17,7 @@
Depends: \tab DBI, RSQLite, RGtk2, gWidgets, gWidgetsRGtk2\cr
License: \tab New style BSD License\cr
LazyLoad: \tab yes\cr
-URL: \tab http://rqda.r-forge.r-project.org/ \cr
+URL: \tab \url{http://rqda.r-forge.r-project.org/} \cr
}
%% description of the package
%% main functions.
More information about the Rqda-commits
mailing list