[Rqda-commits] r38 - pkg pkg/R pkg/man www
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Dec 8 08:40:08 CET 2008
Author: wincent
Date: 2008-12-08 08:40:08 +0100 (Mon, 08 Dec 2008)
New Revision: 38
Added:
pkg/R/utils.R
www/documentation.html
Modified:
pkg/ChangeLog
pkg/DESCRIPTION
pkg/R/CaseButton.R
pkg/R/CaseFun.R
pkg/R/CodeCatButton.R
pkg/R/CodesFun.R
pkg/R/Coding_Buttons.R
pkg/R/FileButton.R
pkg/R/FileCatButton.R
pkg/R/FilesFun.R
pkg/R/ProjectButton.R
pkg/R/root_gui.R
pkg/TODO
pkg/man/RQDA-internal.rd
www/ChangeLog.txt
www/index.html
Log:
Modified: pkg/ChangeLog
===================================================================
--- pkg/ChangeLog 2008-12-07 02:15:54 UTC (rev 37)
+++ pkg/ChangeLog 2008-12-08 07:40:08 UTC (rev 38)
@@ -1,3 +1,9 @@
+2008-12-08
+ * New function of OrderByTime() for computing time order explicitly.
+ * "Show Uncoded files only" popup menu will sort the uncoded file by imported time.
+ * Add "Show Coded files only" popup menu in Files Tabs and F-cat Tab.
+ * "Sort by ..." in the all the popup-menus call OrderByTime to sort the data.
+
2008-12-07
* Better handler the issue of write permission in new project and open project button
* new function/button to backup project
@@ -2,2 +8,3 @@
* fix bug in close project button
+ * Popup menu of Files Tab: "Show uncoded files only" (useful when there are large number of files).
Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION 2008-12-07 02:15:54 UTC (rev 37)
+++ pkg/DESCRIPTION 2008-12-08 07:40:08 UTC (rev 38)
@@ -1,8 +1,8 @@
Package: RQDA
Type: Package
Title: Qualitative Data Analysis
-Version: 0.1.5-37
-Date: 2008-11-01
+Version: 0.1.5-38
+Date: 2008-12-08
Author: HUANG Ronggui
Maintainer: HUANG Ronggui <ronggui.huang at gmail.com>
Depends: R (>= 2.5.0), DBI, RSQLite, RGtk2, gWidgets, gWidgetsRGtk2
Modified: pkg/R/CaseButton.R
===================================================================
--- pkg/R/CaseButton.R 2008-12-07 02:15:54 UTC (rev 37)
+++ pkg/R/CaseButton.R 2008-12-08 07:40:08 UTC (rev 38)
@@ -305,6 +305,9 @@
}
}
}
+FileofCaseWidgetMenu$"File Memo"$handler <- function(h,...){
+ MemoWidget("File",.rqda$.FileofCase,"source")
+}
FileofCaseWidgetMenu$"Sort by imported time"$handler <- function(h,...){
UpdateFileofCaseWidget()
}
Modified: pkg/R/CaseFun.R
===================================================================
--- pkg/R/CaseFun.R 2008-12-07 02:15:54 UTC (rev 37)
+++ pkg/R/CaseFun.R 2008-12-08 07:40:08 UTC (rev 38)
@@ -1,14 +1,17 @@
-CaseNamesUpdate <- function(CaseNamesWidget=.rqda$.CasesNamesWidget,...)
+CaseNamesUpdate <- function(CaseNamesWidget=.rqda$.CasesNamesWidget,decreasing=FALSE,...)
{
if (isIdCurrent(.rqda$qdacon)){
- CaseName <- dbGetQuery(.rqda$qdacon, "select name, id from cases where status=1")
- if (nrow(CaseName)!=0) {
- Encoding(CaseName[['name']]) <- "UTF-8"
- tryCatch(CaseNamesWidget[] <- CaseName[['name']], error=function(e){})
- } else tryCatch(CaseNamesWidget[] <- NULL, error=function(e){})
-## when nrow(CaseName)==0, update it to NULL
+ 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"
+ case <- case[OrderByTime(CaseName$date,decreasing=decreasing)]
+ }
+ tryCatch(CaseNamesWidget[] <- case, error=function(e){})
+ }
}
-}
#################
###############
@@ -71,14 +74,15 @@
## Encoding(Selected) <- "UTF-8"
Total_fid <- dbGetQuery(con,sprintf("select fid from caselinkage where status==1 and caseid==%i",caseid))
if (nrow(Total_fid)!=0){
- items <- dbGetQuery(con,"select name,id from source where status==1")
+ items <- dbGetQuery(con,"select name,id,date from source where status==1")
if (nrow(items)!=0) {
- items <- items[items$id %in% Total_fid$fid,"name"]
+ items <- items[items$id %in% Total_fid$fid,c("name","date")]
+ items <- items$name[OrderByTime(items$date)]
Encoding(items) <- "UTF-8"
} else items <- NULL
} else items <- NULL
} else items <- NULL
- tryCatch(Widget[] <- items,error=function(e){})
+ tryCatch(Widget[] <- items,error=function(e){})
}
HL_Case <- function(){
Modified: pkg/R/CodeCatButton.R
===================================================================
--- pkg/R/CodeCatButton.R 2008-12-07 02:15:54 UTC (rev 37)
+++ pkg/R/CodeCatButton.R 2008-12-08 07:40:08 UTC (rev 38)
@@ -2,9 +2,9 @@
UpdateTableWidget <- function(Widget,FromdbTable,con=.rqda$qdacon,...)
{
if (isIdCurrent(con)){
- items <- dbGetQuery(con, sprintf("select name from %s where status=1",FromdbTable))
+ items <- dbGetQuery(con, sprintf("select name,date from %s where status=1",FromdbTable))
if (nrow(items)!=0) {
- items <- items[['name']]
+ items <- items$name[OrderByTime(items$date)] ## sort according to date
Encoding(items) <- "UTF-8"
} else items <- NULL
tryCatch(eval(substitute(W[] <- items,list(W=quote(Widget)))), error=function(e){})
@@ -106,9 +106,10 @@
catid <- dbGetQuery(.rqda$qdacon,sprintf("select catid from codecat where status=1 and name='%s'",SelectedCodeCat))[,1]
Total_cid <- dbGetQuery(con,sprintf("select cid from treecode where status==1 and catid==%i",catid))
if (nrow(Total_cid)!=0){
- items <- dbGetQuery(con,"select name,id from freecode where status==1")
+ items <- dbGetQuery(con,"select name,id,date from freecode where status==1")
if (nrow(items)!=0) {
- items <- items[items$id %in% Total_cid$cid,"name"]
+ items <- items[items$id %in% Total_cid$cid,c("name","date")]
+ items <- items$name[OrderByTime(items$date)] ## sort accoding to date
Encoding(items) <- "UTF-8"
} else items <- NULL
} else items <- NULL
@@ -174,40 +175,41 @@
-MemoWidget <- function(prefix,widget,dbTable){
- ## prefix of window tile. E.g. "Code" -> tile of gwindow becomes "Code Memo:"
- ## widget of the F-cat/C-cat list, such as widget=.rqda$.fnames_rqda
+## MemoWidget <- function(prefix,widget,dbTable){
+## ##moved to utils.R
+## ## prefix of window tile. E.g. "Code" -> tile of gwindow becomes "Code Memo:"
+## ## widget of the F-cat/C-cat list, such as widget=.rqda$.fnames_rqda
- if (is_projOpen(env=.rqda,"qdacon")) {
- Selected <- svalue(widget)
- if (length(Selected)==0){
- gmessage("Select first.",icon="error",con=TRUE)
- }
- else {
- tryCatch(eval(parse(text=sprintf("dispose(.rqda$.%smemo)",prefix))),error=function(e) {})
- assign(sprintf(".%smemo",prefix),gwindow(title=sprintf("%s Memo:%s",prefix,Selected),
- parent=c(395,10),width=600,height=400),env=.rqda)
- assign(sprintf(".%smemo2",prefix),
- gpanedgroup(horizontal = FALSE, con=get(sprintf(".%smemo",prefix),env=.rqda)),
- env=.rqda)
- gbutton("Save Memo",con=get(sprintf(".%smemo2",prefix),env=.rqda),handler=function(h,...){
- newcontent <- svalue(W)
- Encoding(newcontent) <- "UTF-8"
- newcontent <- enc(newcontent) ## take care of double quote.
- Encoding(Selected) <- "UTF-8"
- dbGetQuery(.rqda$qdacon,sprintf("update %s set memo='%s' where name='%s'",dbTable,newcontent,Selected))
- }
- )## end of save memo button
- assign(sprintf(".%smemoW",prefix),gtext(container=get(sprintf(".%smemo2",prefix),env=.rqda),
- font.attr=c(sizes="large")),env=.rqda)
- prvcontent <- dbGetQuery(.rqda$qdacon, sprintf("select memo from %s where name='%s'",dbTable,Selected))[1,1]
- if (is.na(prvcontent)) prvcontent <- ""
- Encoding(prvcontent) <- "UTF-8"
- W <- get(sprintf(".%smemoW",prefix),env=.rqda)
- add(W,prvcontent,font.attr=c(sizes="large"),do.newline=FALSE)
- }
- }
- }
+## if (is_projOpen(env=.rqda,"qdacon")) {
+## Selected <- svalue(widget)
+## if (length(Selected)==0){
+## gmessage("Select first.",icon="error",con=TRUE)
+## }
+## else {
+## tryCatch(eval(parse(text=sprintf("dispose(.rqda$.%smemo)",prefix))),error=function(e) {})
+## assign(sprintf(".%smemo",prefix),gwindow(title=sprintf("%s Memo:%s",prefix,Selected),
+## parent=c(395,10),width=600,height=400),env=.rqda)
+## assign(sprintf(".%smemo2",prefix),
+## gpanedgroup(horizontal = FALSE, con=get(sprintf(".%smemo",prefix),env=.rqda)),
+## env=.rqda)
+## gbutton("Save Memo",con=get(sprintf(".%smemo2",prefix),env=.rqda),handler=function(h,...){
+## newcontent <- svalue(W)
+## Encoding(newcontent) <- "UTF-8"
+## newcontent <- enc(newcontent) ## take care of double quote.
+## Encoding(Selected) <- "UTF-8"
+## dbGetQuery(.rqda$qdacon,sprintf("update %s set memo='%s' where name='%s'",dbTable,newcontent,Selected))
+## }
+## )## end of save memo button
+## assign(sprintf(".%smemoW",prefix),gtext(container=get(sprintf(".%smemo2",prefix),env=.rqda),
+## font.attr=c(sizes="large")),env=.rqda)
+## prvcontent <- dbGetQuery(.rqda$qdacon, sprintf("select memo from %s where name='%s'",dbTable,Selected))[1,1]
+## if (is.na(prvcontent)) prvcontent <- ""
+## Encoding(prvcontent) <- "UTF-8"
+## W <- get(sprintf(".%smemoW",prefix),env=.rqda)
+## add(W,prvcontent,font.attr=c(sizes="large"),do.newline=FALSE)
+## }
+## }
+## }
CodeCatWidgetMenu <- list()
@@ -218,7 +220,8 @@
}
CodeCatWidgetMenu$"Sort by created time"$handler <- function(h,...){
if (is_projOpen(env=.rqda,conName="qdacon")) {
- UpdateCodeofCatWidget()
+ UpdateTableWidget(Widget=.rqda$.CodeCatWidget,FromdbTable="codecat")
+ ## UpdateCodeofCatWidget() ## wrong function
}
}
Modified: pkg/R/CodesFun.R
===================================================================
--- pkg/R/CodesFun.R 2008-12-07 02:15:54 UTC (rev 37)
+++ pkg/R/CodesFun.R 2008-12-08 07:40:08 UTC (rev 38)
@@ -20,14 +20,19 @@
-CodeNamesUpdate <- function(CodeNamesWidget=.rqda$.codes_rqda,...)
+CodeNamesUpdate <- function(CodeNamesWidget=.rqda$.codes_rqda,sort=TRUE,decreasing = FALSE,...)
{
if (isIdCurrent(.rqda$qdacon)){
- codesName <- dbGetQuery(.rqda$qdacon, "select name, id from freecode where status=1")
- if (nrow(codesName)!=0) {
- Encoding(codesName[['name']]) <- "UTF-8"
- tryCatch(CodeNamesWidget[] <- codesName[['name']], error=function(e){})
- }} else gmessage("Cannot update Code List in the Widget. Project is closed already.\n",con=TRUE)
+ freecode <- dbGetQuery(.rqda$qdacon, "select name, id,date from freecode where status=1")
+ codeName <- freecode$name
+ if (nrow(freecode)!=0) {
+ Encoding(codeName) <- "UTF-8"
+ if (sort){
+ codeName <- codeName[OrderByTime(codeName,decreasing=decreasing)]
+ }
+ }
+ tryCatch(CodeNamesWidget[] <- codeName, error=function(e){})
+ } else gmessage("Cannot update Code List in the Widget. Project is closed already.\n",con=TRUE)
}
Modified: pkg/R/Coding_Buttons.R
===================================================================
--- pkg/R/Coding_Buttons.R 2008-12-07 02:15:54 UTC (rev 37)
+++ pkg/R/Coding_Buttons.R 2008-12-08 07:40:08 UTC (rev 38)
@@ -250,7 +250,9 @@
SelectedCode <- svalue(.rqda$.codes_rqda); Encoding(SelectedCode) <- "UTF-8"
if (length(SelectedCode)==0) gmessage("Select a code first!") else {
currentCid <- dbGetQuery(con,sprintf("select id from freecode where name=='%s'",SelectedCode))[,1]
- SelectedFile <- svalue(.rqda$.fnames_rqda); Encoding(SelectedFile) <- "UTF-8"
+ ## SelectedFile <- svalue(.rqda$.fnames_rqda); Encoding(SelectedFile) <- "UTF-8"
+ ## confused when selected file is not the open one
+ SelectedFile <- svalue(.rqda$.root_edit); Encoding(SelectedFile) <- "UTF-8" ## more reliable
currentFid <- dbGetQuery(con,sprintf("select id from source where name=='%s'",SelectedFile))[,1]
codings_index <- dbGetQuery(con,sprintf("select rowid, cid, fid, selfirst, selend from coding where
cid==%i and fid==%i ",currentCid, currentFid))
Modified: pkg/R/FileButton.R
===================================================================
--- pkg/R/FileButton.R 2008-12-07 02:15:54 UTC (rev 37)
+++ pkg/R/FileButton.R 2008-12-08 07:40:08 UTC (rev 38)
@@ -177,11 +177,21 @@
FileNamesWidgetMenu$"Open Selected File"$handler <- function(h,...){
ViewFileFun(FileNameWidget=.rqda$.fnames_rqda)
}
-FileNamesWidgetMenu$"Sort by import time"$handler <- function(h, ...) {
+FileNamesWidgetMenu$"Show Uncoded Files Only (Sorted)"$handler <- function(h, ...) {
if (is_projOpen(env = .rqda, conName = "qdacon", message = FALSE)) {
- FileNamesUpdate(FileNamesWidget=.rqda$.fnames_rqda)
+ ## UncodedFileNamesUpdate(FileNamesWidget = .rqda$.fnames_rqda)
+ FileNameWidgetUpdate(FileNamesWidget=.rqda$.fnames_rqda,FileId=GetFileId(condition="unconditional",type="uncoded"))
+ ## By default, the file names in the widget will be sorted.
}
}
-
-
-
+FileNamesWidgetMenu$"Show Coded Files Only (Sorted)"$handler <- function(h,...){
+ if (is_projOpen(env=.rqda,conName="qdacon")) {
+ FileNameWidgetUpdate(FileNamesWidget=.rqda$.fnames_rqda,FileId=GetFileId(condition="unconditional",type="coded"))
+ }
+}
+FileNamesWidgetMenu$"Sort All By Imported Time"$handler <- function(h, ...) {
+ if (is_projOpen(env = .rqda, conName = "qdacon", message = FALSE)) {
+ ##FileNamesUpdate(FileNamesWidget=.rqda$.fnames_rqda)
+ FileNameWidgetUpdate(FileNamesWidget=.rqda$.fnames_rqda,FileId=GetFileId(condition="unconditional",type="all"))
+ }
+ }
Modified: pkg/R/FileCatButton.R
===================================================================
--- pkg/R/FileCatButton.R 2008-12-07 02:15:54 UTC (rev 37)
+++ pkg/R/FileCatButton.R 2008-12-08 07:40:08 UTC (rev 38)
@@ -72,9 +72,10 @@
catid <- dbGetQuery(.rqda$qdacon,sprintf("select catid from filecat where status=1 and name='%s'",SelectedFileCat))[,1]
Total_fid <- dbGetQuery(con,sprintf("select fid from treefile where status==1 and catid==%i",catid))
if (nrow(Total_fid)!=0){
- items <- dbGetQuery(con,"select name,id from source where status==1")
+ items <- dbGetQuery(con,"select name,id,date from source where status==1")
if (nrow(items)!=0) {
- items <- items[items$id %in% Total_fid$fid,"name"]
+ items <- items[items$id %in% Total_fid$fid,c("name","date")]
+ items <- items$name[OrderByTime(items$date)] ## sort by date
Encoding(items) <- "UTF-8"
} else items <- NULL
} else items <- NULL
@@ -181,9 +182,31 @@
## popup menu for files of this category
FileofCatWidgetMenu <- list()
-FileofCatWidgetMenu$"Sort by created time"$handler <- function(h,...)
+FileofCatWidgetMenu$"Open Selected File"$handler <- function(h,...){
+ViewFileFun(FileNameWidget=.rqda$.FileofCat)
+}
+FileofCatWidgetMenu$"Show Uncoded Files Only (Sorted)"$handler <- function(h,...){
+ if (is_projOpen(env=.rqda,conName="qdacon")) {
+ fid <- GetFileId(condition="filecategory",type="uncoded")
+ FileNameWidgetUpdate(FileNamesWidget=.rqda$.FileofCat,FileId=fid)
+ }
+}
+FileofCatWidgetMenu$"Show Coded Files Only (Sorted)"$handler <- function(h,...){
+ if (is_projOpen(env=.rqda,conName="qdacon")) {
+ fid <- GetFileId(condition="filecategory",type="coded")
+ FileNameWidgetUpdate(FileNamesWidget=.rqda$.FileofCat,FileId=fid)
+ }
+}
+## FileofCatWidgetMenu$"Sort All By Created Time"$handler <- function(h,...)
+## {
+## if (is_projOpen(env=.rqda,conName="qdacon")) {
+## UpdateFileofCatWidget()
+## }
+## }
+FileofCatWidgetMenu$"Sort All By Created Time"$handler <- function(h,...)
{
if (is_projOpen(env=.rqda,conName="qdacon")) {
- UpdateFileofCatWidget()
+ fid <- GetFileId(condition="filecategory",type="all")
+ FileNameWidgetUpdate(FileNamesWidget=.rqda$.FileofCat,FileId=fid)
}
}
Modified: pkg/R/FilesFun.R
===================================================================
--- pkg/R/FilesFun.R 2008-12-07 02:15:54 UTC (rev 37)
+++ pkg/R/FilesFun.R 2008-12-08 07:40:08 UTC (rev 38)
@@ -37,23 +37,52 @@
}
-
-FileNamesUpdate <- function(FileNamesWidget=.rqda$.fnames_rqda,...){
+FileNamesUpdate <- function(FileNamesWidget=.rqda$.fnames_rqda,sort=TRUE,decreasing = FALSE,...){
##update file names list in the FileNamesWidget
wopt <- options(warn=-2)
on.exit(options(wopt))
- fnames <- dbGetQuery(.rqda$qdacon, "select name, id from source where status=1")
- if (nrow(fnames)!=0) Encoding(fnames[['name']]) <- "UTF-8"
- tryCatch(FileNamesWidget[] <- fnames[['name']],error=function(e){})
+ source <- dbGetQuery(.rqda$qdacon, "select name, date, id from source where status=1")
+ if (nrow(source)!=0) {
+ fnames <- source$name
+ Encoding(fnames) <- "UTF-8"
+ if (sort){
+ fnames <- fnames[OrderByTime(source$date,decreasing=decreasing)]
+ }
+ tryCatch(FileNamesWidget[] <- fnames,error=function(e){})
+ }
}
-setEncoding <- function(encoding="unknown"){
- ## specify what encoding is used in the imported files.
- .rqda$encoding <- encoding
-}
+## UncodedFileNamesUpdate <- function(FileNamesWidget = .rqda$.fnames_rqda, sort=TRUE, decreasing = FALSE){
+## replaced by the general function of FileNameWigetUpdate() and GetFileId()
+## ## only show the uncoded file names in the .rqda$.fnames_rqda
+## ## The fnames will be sort if sort=TRUE
+## fid <- dbGetQuery(.rqda$qdacon,"select id from source where status==1 group by id")$id
+## if (!is.null(fid)){
+## fid_coded <- dbGetQuery(.rqda$qdacon,"select fid from coding where status==1 group by fid")$fid
+## fid_uncoded <- fid[! (fid %in% fid_coded)]
+## source <- dbGetQuery(.rqda$qdacon,
+## sprintf("select name,date, id from source where status=1 and id in (%s)",
+## paste(fid_uncoded,sep="",collapse=",")))
+## if (nrow(source) != 0){
+## fnames <- source$name
+## Encoding(fnames) <- "UTF-8"
+## if (sort){
+## fnames <- fnames[OrderByTime(source$date,decreasing=decreasing)]
+## }
+## }
+## tryCatch(FileNamesWidget[] <- fnames, error = function(e) {})
+## }
+## }
+
+## setEncoding <- function(encoding="unknown"){
+ ## moved to utils.R
+## ## specify what encoding is used in the imported files.
+## .rqda$encoding <- encoding
+## }
+
enc <- function(x) gsub("'", "''", x)
## replace " with two '. to make insert smoothly.
@@ -136,3 +165,124 @@
FileNamesUpdate(FileNamesWidget=.rqda$.fnames_rqda)
} else gmessage("Open a project first.", con=TRUE)
}
+
+
+ProjectMemoWidget <- function(){
+ if (is_projOpen(env=.rqda,"qdacon")) {
+ ## use enviroment, so you can refer to the same object easily, this is the beauty of environment
+ ## if project is open, then continue
+ tryCatch(dispose(.rqda$.projmemo),error=function(e) {})
+ ## Close the open project memo first, then open a new one
+ ## .projmemo is the container of .projmemocontent,widget for the content of memo
+ assign(".projmemo",gwindow(title="Project Memo", parent=c(395,10),width=600,height=400),env=.rqda)
+ .projmemo <- get(".projmemo",.rqda)
+ .projmemo2 <- gpanedgroup(horizontal = FALSE, con=.projmemo)
+ ## use .projmemo2, so can add a save button to it.
+ gbutton("Save memo",con=.projmemo2,handler=function(h,...){
+ ## send the new content of memo back to database
+ newcontent <- svalue(W)
+ Encoding(newcontent) <- "UTF-8"
+ newcontent <- enc(newcontent) ## take care of double quote.
+ dbGetQuery(.rqda$qdacon,sprintf("update project set memo='%s' where rowid==1", ## only one row is needed
+ newcontent)
+ ## have to quote the character in the sql expression
+ )
+ }
+ )## end of save memo button
+ assign(".projmemocontent",gtext(container=.projmemo2,font.attr=c(sizes="large")),env=.rqda)
+ prvcontent <- dbGetQuery(.rqda$qdacon, "select memo from project")[1,1]
+ ## [1,1]turn data.frame to 1-length character. Existing content of memo
+ if (length(prvcontent)==0) {
+ dbGetQuery(.rqda$qdacon,"replace into project (memo) values('')")
+ prvcontent <- ""
+ ## if there is no record in project table, it fails to save memo, so insert sth into it
+ }
+ W <- .rqda$.projmemocontent
+ Encoding(prvcontent) <- "UTF-8"
+ add(W,prvcontent,font.attr=c(sizes="large"),do.newline=FALSE)
+ ## do.newline:do not add a \n (new line) at the beginning
+ ## push the previous content to the widget.
+ }
+}
+
+
+
+FileNameWidgetUpdate <- function(FileNamesWidget=.rqda$.fnames_rqda,sort=TRUE,decreasing = FALSE,FileId=NULL,...){
+ ##update file names list in the FileNamesWidget
+ wopt <- options(warn=-2)
+ on.exit(options(wopt))
+ source <- dbGetQuery(.rqda$qdacon, "select name, date, id from source where status=1")
+ if (nrow(source)==0){
+ fnames <- NULL
+ } else {
+ Encoding(source$name) <- "UTF-8"
+ if (!is.null(FileId)){
+ source <- source[source$id %in% FileId,]
+ fnames <- source$name ## when FileId is not in source$id, fnames is character(0), still works.
+ date <- source$date
+ } else{
+ fnames <- source$name
+ date <- source$date
+ }
+ if (sort){
+ fnames <- fnames[OrderByTime(date,decreasing=decreasing)]
+ }
+ }
+ tryCatch(FileNamesWidget[] <- fnames,error=function(e){})
+}
+
+GetFileId <- function(condition=c("unconditional","case","filecategory"),type=c("all","coded","uncoded"))
+{
+ ## helper function
+ unconditionalFun <- function(type)
+ {
+ allfid <- dbGetQuery(.rqda$qdacon,"select id from source where status==1 group by id")$id
+ if (type!="all"){
+ fid_coded <- dbGetQuery(.rqda$qdacon,"select fid from coding where status==1 group by fid")$fid
+ }
+ if (type=="all") {
+ ans <- allfid
+ } else if (type=="coded"){
+ ans <- fid_coded
+ } else if (type=="uncoded"){
+ ans <- allfid[! (allfid %in% fid_coded)]
+ }
+ ans
+ }
+
+ FidOfCaseFun <- function(type){
+ Selected <- svalue(.rqda$.CasesNamesWidget)
+ if (length(Selected)==0){
+ ans <- NULL
+ } else {
+ caseid <- dbGetQuery(.rqda$qdacon,sprintf("select id from cases where status=1 and name='%s'",Selected))$id
+ fidofcase <- dbGetQuery(.rqda$qdacon,
+ sprintf("select fid from caselinkage where status==1 and caseid==%i",caseid))$fid
+ allfid <- unconditionalFun(type=type)
+ ans <- intersect(fidofcase,allfid)
+ }
+ ans
+ }
+
+ FidOfCatFun <- function(type){
+ Selected <- svalue(.rqda$.FileCatWidget)
+ if (length(Selected)==0){
+ ans <- NULL
+ } else {
+ catid <- dbGetQuery(.rqda$qdacon,sprintf("select catid from filecat where status=1 and name='%s'",Selected))$catid
+ fidofcat <- dbGetQuery(.rqda$qdacon,sprintf("select fid from treefile where status==1 and catid==%i",catid))$fid
+ allfid <- unconditionalFun(type=type)
+ ans <- intersect(fidofcat,allfid)
+ }
+ ans
+ }
+
+ condition <- match.arg(condition)
+ type <- match.arg(type)
+ fid <- switch(condition,
+ unconditional=unconditionalFun(type=type),
+ case=FidOfCaseFun(type=type),
+ filecategory=FidOfCatFun(type=type)
+ )
+fid
+}
Modified: pkg/R/ProjectButton.R
===================================================================
--- pkg/R/ProjectButton.R 2008-12-07 02:15:54 UTC (rev 37)
+++ pkg/R/ProjectButton.R 2008-12-08 07:40:08 UTC (rev 38)
@@ -74,41 +74,7 @@
## label of button
## name of contaianer or TRUE
proj_memo <- gbutton(label, contain=container, handler=function(h,...) {
- if (is_projOpen(env=.rqda,"qdacon")) {
- ## use enviroment, so you can refer to the same object easily, this is the beauty of environment
- ## if project is open, then continue
- tryCatch(dispose(.rqda$.projmemo),error=function(e) {})
- ## Close the open project memo first, then open a new one
- ## .projmemo is the container of .projmemocontent,widget for the content of memo
- assign(".projmemo",gwindow(title="Project Memo", parent=c(370,10),width=600,height=400),env=.rqda)
- .projmemo <- get(".projmemo",.rqda)
- .projmemo2 <- gpanedgroup(horizontal = FALSE, con=.projmemo)
- ## use .projmemo2, so can add a save button to it.
- gbutton("Save memo",con=.projmemo2,handler=function(h,...){
- ## send the new content of memo back to database
- newcontent <- svalue(W)
- Encoding(newcontent) <- "UTF-8"
- newcontent <- enc(newcontent) ## take care of double quote.
- dbGetQuery(.rqda$qdacon,sprintf("update project set memo='%s' where rowid==1", ## only one row is needed
- newcontent)
- ## have to quote the character in the sql expression
- )
- }
- )## end of save memo button
- assign(".projmemocontent",gtext(container=.projmemo2,font.attr=c(sizes="large")),env=.rqda)
- prvcontent <- dbGetQuery(.rqda$qdacon, "select memo from project")[1,1]
- ## [1,1]turn data.frame to 1-length character. Existing content of memo
- if (length(prvcontent)==0) {
- dbGetQuery(.rqda$qdacon,"replace into project (memo) values('')")
- prvcontent <- ""
- ## if there is no record in project table, it fails to save memo, so insert sth into it
- }
- W <- .rqda$.projmemocontent
- Encoding(prvcontent) <- "UTF-8"
- add(W,prvcontent,font.attr=c(sizes="large"),do.newline=FALSE)
- ## do.newline:do not add a \n (new line) at the beginning
- ## push the previous content to the widget.
- }
+ ProjectMemoWidget()
}
)
}
Modified: pkg/R/root_gui.R
===================================================================
--- pkg/R/root_gui.R 2008-12-07 02:15:54 UTC (rev 37)
+++ pkg/R/root_gui.R 2008-12-08 07:40:08 UTC (rev 38)
@@ -24,12 +24,12 @@
########################### GUI FOR PROJECT
###########################
".proj_gui" <- ggroup(container=.nb_rqdagui,horizontal=FALSE,label="Project")
- ".newproj_gui" <- NewProjectButton(container=.proj_gui)
- ".open.proj_gui" <- OpenProjectButton(container=.proj_gui)
- ".project_memo" <- Proj_MemoButton(label = "Project Memo", container = .proj_gui)
+ NewProjectButton(container=.proj_gui)
+ OpenProjectButton(container=.proj_gui)
+ CloseProjectButton(container=.proj_gui)
+ Proj_MemoButton(label = "Project Memo", container = .proj_gui)
## project memo button
- ".close.proj_gui" <- CloseProjectButton(container=.proj_gui)
- ".projinfo_gui" <- ProjectInforButton(container=.proj_gui)
+ ProjectInforButton(container=.proj_gui)
BackupProjectButton(container=.proj_gui)
gbutton("About",container=.proj_gui, handler=function(h,...) {browseURL("http://rqda.r-forge.r-project.org/")})
@@ -37,7 +37,8 @@
"Author: <ronggui.huang at gmail.com>\n
License: New style BSD License\n
Version: 0.1.6 RC2\n",
- container=.proj_gui)
+ container=.proj_gui
+ )
@@ -76,7 +77,7 @@
######################### GUI for cases
#########################
- ".case_pan" <- gpanedgroup(container=.nb_rqdagui,horizontal=FALSE,label="Case")
+ ".case_pan" <- gpanedgroup(container=.nb_rqdagui,horizontal=FALSE,label="Cases")
".case_buttons" <- glayout(container=.case_pan)
".case_PW" <- ggroup(cont=.case_pan,horizontal = FALSE)
".CasesNamesWidget" <- gtable("Please click Update",container=.case_PW,expand=TRUE,multiple=FALSE)
Added: pkg/R/utils.R
===================================================================
--- pkg/R/utils.R (rev 0)
+++ pkg/R/utils.R 2008-12-08 07:40:08 UTC (rev 38)
@@ -0,0 +1,54 @@
+OrderByTime <- function(date,decreasing = FALSE){
+## return tbe permutation of the date which is get by sql "select date from ..."
+## see order for the meaning of permutation. It can be used as index to sort vector or date frame
+oldLCTIME<- Sys.getlocale("LC_TIME")
+Sys.setlocale("LC_TIME","C")
+on.exit(Sys.setlocale("LC_TIME",oldLCTIME))
+Newdate <- strptime(date, "%a %b %d %H:%M:%S %Y")
+permutation <- order(Newdate,decreasing = decreasing)
+}
+## dd<- dbGetQuery(.rqda$qdacon,"select date from source")$date
+## sort(dd) == dd[order(dd)] ## but the order is not correct.
+## dd[OrderByTime(dd)]
+
+
+setEncoding <- function(encoding="unknown"){
+ ## specify what encoding is used in the imported files.
+ .rqda$encoding <- encoding
+}
+
+
+MemoWidget <- function(prefix,widget,dbTable){
+ ## prefix of window tile. E.g. "Code" -> tile of gwindow becomes "Code Memo:"
+ ## widget of the F-cat/C-cat list, such as widget=.rqda$.fnames_rqda
+
+ if (is_projOpen(env=.rqda,"qdacon")) {
+ Selected <- svalue(widget)
+ if (length(Selected)==0){
+ gmessage("Select first.",icon="error",con=TRUE)
+ }
+ else {
+ tryCatch(eval(parse(text=sprintf("dispose(.rqda$.%smemo)",prefix))),error=function(e) {})
+ assign(sprintf(".%smemo",prefix),gwindow(title=sprintf("%s Memo:%s",prefix,Selected),
+ parent=c(395,10),width=600,height=400),env=.rqda)
+ assign(sprintf(".%smemo2",prefix),
+ gpanedgroup(horizontal = FALSE, con=get(sprintf(".%smemo",prefix),env=.rqda)),
+ env=.rqda)
+ gbutton("Save Memo",con=get(sprintf(".%smemo2",prefix),env=.rqda),handler=function(h,...){
+ newcontent <- svalue(W)
+ Encoding(newcontent) <- "UTF-8"
+ newcontent <- enc(newcontent) ## take care of double quote.
+ Encoding(Selected) <- "UTF-8"
+ dbGetQuery(.rqda$qdacon,sprintf("update %s set memo='%s' where name='%s'",dbTable,newcontent,Selected))
+ }
+ )## end of save memo button
+ assign(sprintf(".%smemoW",prefix),gtext(container=get(sprintf(".%smemo2",prefix),env=.rqda),
+ font.attr=c(sizes="large")),env=.rqda)
+ prvcontent <- dbGetQuery(.rqda$qdacon, sprintf("select memo from %s where name='%s'",dbTable,Selected))[1,1]
+ if (is.na(prvcontent)) prvcontent <- ""
+ Encoding(prvcontent) <- "UTF-8"
+ W <- get(sprintf(".%smemoW",prefix),env=.rqda)
+ add(W,prvcontent,font.attr=c(sizes="large"),do.newline=FALSE)
+ }
+ }
+ }
Modified: pkg/TODO
===================================================================
--- pkg/TODO 2008-12-07 02:15:54 UTC (rev 37)
+++ pkg/TODO 2008-12-08 07:40:08 UTC (rev 38)
@@ -2,7 +2,7 @@
summary functions for review of coding.
-Merge *rqda from different coders.
+Merge *rqda from different coders
inter-coder reliability
Modified: pkg/man/RQDA-internal.rd
===================================================================
--- pkg/man/RQDA-internal.rd 2008-12-07 02:15:54 UTC (rev 37)
+++ pkg/man/RQDA-internal.rd 2008-12-08 07:40:08 UTC (rev 38)
@@ -86,6 +86,11 @@
\alias{FileofCatWidgetMenu}
\alias{backup_proj}
\alias{BackupProjectButton}
+\alias{UncodedFileNamesUpdate}
+\alias{ProjectMemoWidget}
+\alias{FileNameWidgetUpdate}
+\alias{GetFileId}
+\alias{OrderByTime}
%% add related alias functions here.
\title{Internal Functions}
Modified: www/ChangeLog.txt
===================================================================
--- www/ChangeLog.txt 2008-12-07 02:15:54 UTC (rev 37)
+++ www/ChangeLog.txt 2008-12-08 07:40:08 UTC (rev 38)
@@ -1,3 +1,9 @@
+2008-12-08
+ * New function of OrderByTime() for computing time order explicitly.
+ * "Show Uncoded files only" popup menu will sort the uncoded file by imported time.
+ * Add "Show Coded files only" popup menu in Files Tabs and F-cat Tab.
+ * "Sort by ..." in the all the popup-menus call OrderByTime to sort the data.
+
2008-12-07
* Better handler the issue of write permission in new project and open project button
* new function/button to backup project
@@ -2,2 +8,3 @@
* fix bug in close project button
+ * Popup menu of Files Tab: "Show uncoded files only" (useful when there are large number of files).
Added: www/documentation.html
===================================================================
--- www/documentation.html (rev 0)
+++ www/documentation.html 2008-12-08 07:40:08 UTC (rev 38)
@@ -0,0 +1,45 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
+<HTML>
+<HEAD>
+ <META HTTP-EQUIV="CONTENT-TYPE" CONTENT="text/html; charset=UTF-8">
+ <TITLE>Documentation of RQDA Project</TITLE>
+ <META NAME="AUTHOR" CONTENT="wincent">
+ <style type="text/css">
+body {
+ padding-left: 3em;
+ padding-right: 3em;
+ font-family: "Times New Roman",Times, serif;
+ color: darkblue;
+ font-size:13px}
+h1 {
+ font-family: Helvetica, Arial,SunSans-Regular, sans-serif;
+ font-size:14px
+ }
+ </style>
+
+</HEAD>
+
+<BODY>
+
+<h1><a id="user manual">User's Manual</a></h1>
+<p>Under construction (contributions are more than welcome).
+
+<p>Basic usage: 1. Open or create new project. 2. Import files. 3. Select a file and open it by click button open. 4. Add codes. 5. Select a codes, select text segment in the open file, and press button mark. Select the same text segment and click button Unmark, you can undo the action. 6. Do more coding as step 5. 7. Select a code and click button retrieval to see what text segments have been attached to that code.
+
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/rqda -r 38
More information about the Rqda-commits
mailing list