[Rqda-commits] r42 - pkg pkg/R www
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sat Dec 13 04:06:09 CET 2008
Author: wincent
Date: 2008-12-13 04:06:09 +0100 (Sat, 13 Dec 2008)
New Revision: 42
Modified:
pkg/ChangeLog
pkg/R/CaseButton.R
pkg/R/CaseFun.R
pkg/R/CodeCatButton.R
pkg/R/FileButton.R
pkg/R/FileCatButton.R
pkg/R/GUIHandler.R
pkg/R/ProjectFun.R
pkg/R/root_gui.R
www/documentation.html
www/index.html
Log:
Modified: pkg/ChangeLog
===================================================================
--- pkg/ChangeLog 2008-12-09 03:33:46 UTC (rev 41)
+++ pkg/ChangeLog 2008-12-13 03:06:09 UTC (rev 42)
@@ -1,3 +1,10 @@
+2008-12-12
+ * Fix bugs of SortByTime(), now should work for R < 2.8.0.
+ * New function of RunOnSelected. Use it to replace select.list.
+ * Now popup menu of add to case/ category can add multiple files at a time (Files Tab).
+
+2008-12-10
+ * New functions of SearchFiles.
2008-12-09
* New functions to summary codings: SummaryCoding, GetCodingTable.
* Add documentation.
Modified: pkg/R/CaseButton.R
===================================================================
--- pkg/R/CaseButton.R 2008-12-09 03:33:46 UTC (rev 41)
+++ pkg/R/CaseButton.R 2008-12-13 03:06:09 UTC (rev 42)
@@ -229,18 +229,23 @@
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)
+ ##Selected <- select.list(fileoutofcase[['name']],multiple=TRUE)
+ CurrentFrame <- sys.frame(sys.nframe())
+ ## sys.frame(): get the frame of n
+ ## nframe(): get n of current frame
+ ## The value of them depends on where they evaluated, should not placed inside RunOnSelected()
+ RunOnSelected(fileoutofcase[['name']],multiple=TRUE,enclos=CurrentFrame,expr={
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()
- }
- }
+ 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()
+ }})
}
}
+}
CaseNamesWidgetMenu$"Case Memo"$handler <- function(h,...){
if (is_projOpen(env=.rqda,conName="qdacon")) {
MemoWidget("Case",.rqda$.CasesNamesWidget,"cases")
Modified: pkg/R/CaseFun.R
===================================================================
--- pkg/R/CaseFun.R 2008-12-09 03:33:46 UTC (rev 41)
+++ pkg/R/CaseFun.R 2008-12-13 03:06:09 UTC (rev 42)
@@ -40,7 +40,8 @@
## 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))
+ query <- dbGetQuery(.rqda$qdacon,sprintf("select id, file from source where name in (%s) and status=1",
+ paste("'",filename,"'",sep="",collapse=",")))
fid <- query$id
Encoding(query$file) <- "UTF-8"
selend <- nchar(query$file)
@@ -49,24 +50,30 @@
cases <- dbGetQuery(.rqda$qdacon,"select id, name from cases where status=1")
if (nrow(cases)!=0){
Encoding(cases$name) <- "UTF-8"
- ans <- select.list(cases$name,multiple=FALSE)
- if (ans!=""){
- ans <- iconv(ans,to="UTF-8")
- caseid <- cases$id[cases$name %in% ans]
+## ans <- select.list(cases$name,multiple=FALSE)
+ CurrentFrame <- sys.frame(sys.nframe())
- exist <- dbGetQuery(.rqda$qdacon,sprintf("select fid from caselinkage where status=1 and fid=%i and caseid=%i",fid,caseid))
- if (nrow(exist)==0){
- ## write only when the selected file associated with specific case is not in the caselinkage table
- DAT <- data.frame(caseid=caseid, fid=fid, selfirst=0, selend=selend, status=1,owner=.rqda$owner,data=date(),memo='')
- success <- dbWriteTable(.rqda$qdacon,"caselinkage",DAT,row.name=FALSE,append=TRUE)
- ## write to caselinkage table
- if (!success) gmessage("Fail to write to database.")
- }
+ RunOnSelected(cases$name,multiple=FALSE,enclos=CurrentFrame,expr={
+ if (Selected!=""){
+ Selected <- iconv(Selected,to="UTF-8")
+ caseid <- cases$id[cases$name %in% Selected]
+
+ exist <- dbGetQuery(.rqda$qdacon,sprintf("select fid from caselinkage where status=1 and fid in (%s) and caseid=%i",paste("'",fid,"'",sep="",collapse=","),caseid))
+ if (nrow(exist)!=length(fid)){
+ ## write only when the selected file associated with specific case is not in the caselinkage table
+ DAT <- data.frame(caseid=caseid, fid=fid[!fid %in% exist$fid], selfirst=0, selend=selend, status=1,owner=.rqda$owner,data=date(),memo='')
+ success <- dbWriteTable(.rqda$qdacon,"caselinkage",DAT,row.name=FALSE,append=TRUE)
+ ## write to caselinkage table
+ if (!success) gmessage("Fail to write to database.")
+ }
+ }
+ }
+ )
}
}
-}
+
UpdateFileofCaseWidget <- function(con=.rqda$qdacon,Widget=.rqda$.FileofCase){
Selected <- svalue(.rqda$.CasesNamesWidget)
if (length(Selected)!=0){
Modified: pkg/R/CodeCatButton.R
===================================================================
--- pkg/R/CodeCatButton.R 2008-12-09 03:33:46 UTC (rev 41)
+++ pkg/R/CodeCatButton.R 2008-12-13 03:06:09 UTC (rev 42)
@@ -132,20 +132,25 @@
## compute those not in the category, then push them to select.list()
codeoutofcat <- subset(freecode,!(id %in% codeofcat$cid))
} else codeoutofcat <- freecode
- Selected <- select.list(codeoutofcat[['name']],multiple=TRUE)
- if (length(Selected)!=0){
- Selected <- iconv(Selected,to="UTF-8")
- cid <- codeoutofcat[codeoutofcat$name %in% Selected,"id"]
- Dat <- data.frame(cid=cid,catid=catid,date=date(),dateM=date(),memo="",status=1)
- ## Push selected codeList to table treecode
- dbWriteTable(.rqda$qdacon,"treecode",Dat,row.names=FALSE,append=TRUE)
- ## update .CodeofCat Widget
- UpdateCodeofCatWidget()
+## Selected <- select.list(codeoutofcat[['name']],multiple=TRUE)
+ CurrentFrame <- sys.frame(sys.nframe())
+ RunOnSelected(codeoutofcat[['name']],multiple=TRUE,enclos=CurrentFrame,expr={
+ if (length(Selected)!=0){
+ Selected <- iconv(Selected,to="UTF-8")
+ cid <- codeoutofcat[codeoutofcat$name %in% Selected,"id"]
+ Dat <- data.frame(cid=cid,catid=catid,date=date(),dateM=date(),memo="",status=1)
+ ## Push selected codeList to table treecode
+ dbWriteTable(.rqda$qdacon,"treecode",Dat,row.names=FALSE,append=TRUE)
+ ## update .CodeofCat Widget
+ UpdateCodeofCatWidget()
+ }
+ }
+ )
}
-}
)
}
-## update .rqda$.CodeofCat[] by click handler on .rqda$.CodeCatWidget
+
+ ## update .rqda$.CodeofCat[] by click handler on .rqda$.CodeCatWidget
CodeCatDropFromButton <- function(label="DropFrom",Widget=.rqda$.CodeofCat,...)
{
Modified: pkg/R/FileButton.R
===================================================================
--- pkg/R/FileButton.R 2008-12-09 03:33:46 UTC (rev 41)
+++ pkg/R/FileButton.R 2008-12-13 03:06:09 UTC (rev 42)
@@ -155,14 +155,14 @@
## pop-up menu of add to case and F-cat from Files Tab
FileNamesWidgetMenu <- list()
-FileNamesWidgetMenu$"Add To Case"$handler <- function(h, ...) {
+FileNamesWidgetMenu$"Add To Case ..."$handler <- function(h, ...) {
if (is_projOpen(env = .rqda, conName = "qdacon", message = FALSE)) {
AddFileToCaselinkage()
UpdateFileofCaseWidget()
}
}
-FileNamesWidgetMenu$"Add To Category"$handler <- function(h, ...) {
+FileNamesWidgetMenu$"Add To File Category ..."$handler <- function(h, ...) {
if (is_projOpen(env = .rqda, conName = "qdacon", message = FALSE)) {
AddToFileCategory()
UpdateFileofCatWidget()
@@ -177,6 +177,14 @@
FileNamesWidgetMenu$"Open Selected File"$handler <- function(h,...){
ViewFileFun(FileNameWidget=.rqda$.fnames_rqda)
}
+FileNamesWidgetMenu$"Search Files..."$handler <- function(h, ...) {
+ if (is_projOpen(env = .rqda, conName = "qdacon", message = FALSE)) {
+ pattern <- ginput("Please input a search pattern.",text="file like '%%'")
+ if (pattern!=""){
+ tryCatch(SearchFiles(pattern,Widget=.rqda$.fnames_rqda,is.UTF8=TRUE),error=function(e) gmessage("Error~~~."),con=TRUE)
+ }
+ }
+ }
FileNamesWidgetMenu$"Show Uncoded Files Only (Sorted)"$handler <- function(h, ...) {
if (is_projOpen(env = .rqda, conName = "qdacon", message = FALSE)) {
## UncodedFileNamesUpdate(FileNamesWidget = .rqda$.fnames_rqda)
Modified: pkg/R/FileCatButton.R
===================================================================
--- pkg/R/FileCatButton.R 2008-12-09 03:33:46 UTC (rev 41)
+++ pkg/R/FileCatButton.R 2008-12-13 03:06:09 UTC (rev 42)
@@ -94,14 +94,27 @@
if (nrow(fileofcat)!=0){
fileoutofcat <- subset(freefile,!(id %in% fileofcat$fid))
} else fileoutofcat <- freefile
- Selected <- select.list(fileoutofcat[['name']],multiple=TRUE)
+## Selected <- select.list(fileoutofcat[['name']],multiple=TRUE)
+## if (length(Selected)!=0){
+## Selected <- iconv(Selected,to="UTF-8")
+## fid <- fileoutofcat[fileoutofcat$name %in% Selected,"id"]
+## Dat <- data.frame(fid=fid,catid=catid,date=date(),dateM=date(),memo="",status=1)
+## dbWriteTable(.rqda$qdacon,"treefile",Dat,row.names=FALSE,append=TRUE)
+## UpdateFileofCatWidget()
+## }
+ CurrentFrame <- sys.frame(sys.nframe())
+ ## sys.frame(): get the frame of n
+ ## nframe(): get n of current frame
+ ## The value of them depends on where they evaluated, should not placed inside RunOnSelected()
+ RunOnSelected(fileoutofcat[['name']],multiple=TRUE,expr={
if (length(Selected)!=0){
Selected <- iconv(Selected,to="UTF-8")
fid <- fileoutofcat[fileoutofcat$name %in% Selected,"id"]
Dat <- data.frame(fid=fid,catid=catid,date=date(),dateM=date(),memo="",status=1)
dbWriteTable(.rqda$qdacon,"treefile",Dat,row.names=FALSE,append=TRUE)
UpdateFileofCatWidget()
- }
+ }},enclos=CurrentFrame)
+
}
)
}
@@ -137,7 +150,7 @@
## 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))
+ query <- dbGetQuery(.rqda$qdacon,sprintf("select id, file from source where name in(%s) and status=1",paste("'",filename,"'",sep="",collapse=","))) ## multiple fid
fid <- query$id
Encoding(query$file) <- "UTF-8"
@@ -145,14 +158,16 @@
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){
+ ##ans <- select.list(Fcat$name,multiple=FALSE)
+ CurrentFrame <- sys.frame(sys.nframe())
+ RunOnSelected(Fcat$name,multiple=TRUE,enclos=CurrentFrame,expr={
+ if (Selected!=""){ ## must use Selected to represent the value of selected items. see RunOnSelected() for info.
+ Selected <- iconv(Selected,to="UTF-8")
+ Fcatid <- Fcat$catid[Fcat$name %in% Selected]
+ exist <- dbGetQuery(.rqda$qdacon,sprintf("select fid from treefile where status=1 and fid in (%s) and catid=%i",paste("'",fid,"'",sep="",collapse=","),Fcatid))
+ if (nrow(exist)!=length(fid)){
## 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)
+ DAT <- data.frame(fid=fid[!fid %in% exist$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
@@ -160,12 +175,10 @@
UpdateFileofCatWidget()
}
if (!success) gmessage("Fail to write to database.")
- }
- }
- }
-}
+ }}})}}
+
FileCatWidgetMenu <- list()
FileCatWidgetMenu$Memo$handler <- function(h,...){
if (is_projOpen(env=.rqda,conName="qdacon")) {
Modified: pkg/R/GUIHandler.R
===================================================================
--- pkg/R/GUIHandler.R 2008-12-09 03:33:46 UTC (rev 41)
+++ pkg/R/GUIHandler.R 2008-12-13 03:06:09 UTC (rev 42)
@@ -34,7 +34,7 @@
## right click to add file to a case category
addhandlerdoubleclick(.rqda$.fnames_rqda, handler <- function(h,...) ViewFileFun(FileNameWidget=.rqda$.fnames_rqda))
-
+
## addhandlerdoubleclick(.rqda$.fnames_rqda, handler <- function(h,...)
## ##function copied from ViewFileButton handler
## {
@@ -64,6 +64,8 @@
## )
+ ## addhandlerdoubleclick(.rqda$.fsearch_rqda, handler <- function(h,...) ViewFileFun(FileNameWidget=.rqda$.fsearch_rqda))
+
## handler for .codes_rqda
## addHandlerMouseMotion(.rqda$.codes_rqda, handler <- function(h, ...) {
Modified: pkg/R/ProjectFun.R
===================================================================
--- pkg/R/ProjectFun.R 2008-12-09 03:33:46 UTC (rev 41)
+++ pkg/R/ProjectFun.R 2008-12-13 03:06:09 UTC (rev 42)
@@ -123,7 +123,9 @@
dbname <- dbGetInfo(con)$dbname
backupname <- sprintf("%s_%s",dbname,format(Sys.time(), "%H%M%S%d%m%Y"))
success <- file.copy(from=dbname, to=backupname , overwrite = FALSE)
-if (!success) {
+if (success) {
+gmessage("Succeeded!",con=TRUE,icon="info")
+} else{
gmessage("Fail to back up the project.",con=TRUE,icon="error")
}
}
Modified: pkg/R/root_gui.R
===================================================================
--- pkg/R/root_gui.R 2008-12-09 03:33:46 UTC (rev 41)
+++ pkg/R/root_gui.R 2008-12-13 03:06:09 UTC (rev 42)
@@ -46,7 +46,7 @@
###########################
".files_pan" <- gpanedgroup(container=.nb_rqdagui,horizontal=FALSE,label="Files")
".files_button" <- ggroup(container=.files_pan,horizontal=TRUE)
- ".fnames_rqda" <- gtable("Click Here to see the File list.",container=.files_pan)
+ ".fnames_rqda" <- gtable("Click Here to see the File list.",container=.files_pan,multiple=TRUE)
.fnames_rqda[] <-NULL # get around of the text argument.
names(.fnames_rqda) <- "Files"
ImportFileButton("Import",con=.files_button)
@@ -57,7 +57,7 @@
File_RenameButton(label="Rename", container=.files_button,FileWidget=.fnames_rqda)
## rename a selected file.
-
+
########################### GUI for CODES
###########################
".codes_pan" <- gpanedgroup(container=.nb_rqdagui,horizontal=FALSE,label="Codes")
@@ -124,6 +124,16 @@
.filecat_buttons[1,4] <- FileCatAddToButton("AddTo")
.filecat_buttons[1,5] <- FileCatDropFromButton("DropFrom")
+
+########################### GUI for Search
+###########################
+## ".fsearch_pan" <- gpanedgroup(container=.nb_rqdagui,horizontal=FALSE,label="F-Search")
+## ".fsearch_rqda" <- glabel("Use SearchFiles function to search files.\nSee ?SearchFiles for more.",container=.fsearch_pan)
+## ".fsearch_rqda" <- gtable("Click Here to see the File list.",container=.fsearch_pan,multiple=TRUE,expand=TRUE)
+## .fsearch_rqda[] <-NULL # get around of the text argument.
+## names(.fsearch_rqda) <- "Files Search"
+
+
######################### GUI for settings
#########################
".settings_gui" <- ggroup(container=.nb_rqdagui,horizontal=FALSE,label="Settings")
@@ -140,6 +150,7 @@
assign(".files_button",.files_button,env=.rqda)
assign(".codes_rqda",.codes_rqda,env=.rqda)
assign(".fnames_rqda",.fnames_rqda,env=.rqda)
+##assign(".fsearch_rqda",.fsearch_rqda,env=.rqda)
assign(".CasesNamesWidget",.CasesNamesWidget,env=.rqda)
assign(".FileofCase",.FileofCase,env=.rqda)
assign(".CodeCatWidget",.CodeCatWidget,env=.rqda)
Modified: www/documentation.html
===================================================================
--- www/documentation.html 2008-12-09 03:33:46 UTC (rev 41)
+++ www/documentation.html 2008-12-13 03:06:09 UTC (rev 42)
@@ -30,7 +30,8 @@
<p><b>Contributions are more than welcome</b>.
<p><b>0. Design principle </b>
-<p>Reliability is the most important thing. In order to maximize the reliability, every change will write to the *.rqda file directly, so you don't have to manually save your project.
+<p>Reliability: This is the most important thing. In order to maximize the reliability, every change will write to the *.rqda file directly, so you don't have to manually save your project.
+<p>Capacity of file management: This package is written for my own research, aiming at analyzing newspaper reports. In this case, there are lots of files, and I have put much effect on the management and organization of files (Sorting, Show coded files only, Show uncoded files only, Show those fit the searching criterion only etc.).
<p><b>1. Project </b>
<p>You can create a new project in by clicking the new project button in Project Tab. RQDA will create a *.rqda file, which is a SQLite database. All the information (e.g. files, code list, all kinds of memo, coding, and relation between codes or between files etc.) is stored in that single file. Single *.rqda file makes backup or data migration much easier.
Modified: www/index.html
===================================================================
--- www/index.html 2008-12-09 03:33:46 UTC (rev 41)
+++ www/index.html 2008-12-13 03:06:09 UTC (rev 42)
@@ -54,12 +54,11 @@
<p>
<h1>Installation</h1>
-<li>Because RGtk2 depends on GTK+, you may need to install GTK+ before install RGtk2. For windows user, <A HREF="http://downloads.sourceforge.net/gladewin32/gtk-2.10.11-win32-1.exe?modtime=1175123376&big_mirror=0">download</A> GTK+ and install it. For MacOS users, <A HREF="http://r.research.att.com/gtk2-runtime.dmg">download</A> GTK+ here and install it. For Debian-based Linux users, you may use <i>sudo apt-get install libgtk2.0-dev</i> to install GTK+ library. For other Linux users, you may have to manually install GTK+, <A HREF="http://www.gtk.org/download-linux.html"> download</A> the source tarball, and follow the <A HREF="http://library.gnome.org/devel/gtk/unstable/gtk-building.html">instructions</A> of installation.
+<li>Because RGtk2 depends on GTK+, you may need to install GTK+ before install RGtk2. For windows user, <A HREF="http://downloads.sourceforge.net/gladewin32/gtk-2.10.11-win32-1.exe?modtime=1175123376&big_mirror=0">download</A> GTK+ and install it. For MacOS users, <A HREF="http://r.research.att.com/gtk2-runtime.dmg">download</A> GTK+ here and install it. For Debian-based Linux users, you may use <i>sudo apt-get install libgtk2.0-dev</i> to install GTK+ develop library. For other Linux users, you may have to manually install GTK+, <A HREF="http://www.gtk.org/download-linux.html"> download</A> the source tarball, and follow the <A HREF="http://library.gnome.org/devel/gtk/unstable/gtk-building.html">instructions</A> of installation.
-<p>RQDA is based on R, so you have to install R and relevant packages in
-order to use RQDA.
+<p>RQDA is based on R, so you have to install R and relevant packages in order to use RQDA.
-<li>Go to <A HREF="http://cran.r-project.org/">CRAN</A>, download R and install it. For Linux and BSD users, you can download binary version of R or the sources. For Windows users, you can download the binary version of R from the <A HREF="http://cran.r-project.org/bin/windows/base/">download page</A>. For MacOS users, download the binary version of R from the <A HREF="http://cran.r-project.org/bin/macosx/">download page</A>, More instruction about installing R is in the <A HREF="http://cran.r-project.org/doc/manuals/R-admin.html">R Installation and Administration</A> Manual.
+<li>Go to <A HREF="http://cran.r-project.org/">CRAN</A>, download R (Suggest using version 2.8.0 or above) and install it. For Linux and BSD users, you can download binary version of R or the sources. For Windows users, you can download the binary version of R from the <A HREF="http://cran.r-project.org/bin/windows/base/">download page</A>. For MacOS users, download the binary version of R from the <A HREF="http://cran.r-project.org/bin/macosx/">download page</A>, More instruction about installing R is in the <A HREF="http://cran.r-project.org/doc/manuals/R-admin.html">R Installation and Administration</A> Manual.
<li>Launch R (as usual applications under Windows; or by command $R within shell terminal under Linux and FreeBSD). Then, you can see the prompt “>”,which indicates that R is ready for further commands.
More information about the Rqda-commits
mailing list