[Rqda-commits] r55 - pkg pkg/R tags tags/0.1.6 tags/0.1.6/R tags/0.1.6/inst tags/0.1.6/man www
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Dec 24 06:33:29 CET 2008
Author: wincent
Date: 2008-12-24 06:33:28 +0100 (Wed, 24 Dec 2008)
New Revision: 55
Added:
tags/0.1.6/
tags/0.1.6/ChangeLog
tags/0.1.6/DESCRIPTION
tags/0.1.6/KnownBugs
tags/0.1.6/License
tags/0.1.6/R/
tags/0.1.6/R/CaseButton.R
tags/0.1.6/R/CaseFun.R
tags/0.1.6/R/CodeCatButton.R
tags/0.1.6/R/CodesFun.R
tags/0.1.6/R/Coding_Buttons.R
tags/0.1.6/R/FileButton.R
tags/0.1.6/R/FileCatButton.R
tags/0.1.6/R/FilesFun.R
tags/0.1.6/R/GUIHandler.R
tags/0.1.6/R/ProjectButton.R
tags/0.1.6/R/ProjectFun.R
tags/0.1.6/R/Rename.R
tags/0.1.6/R/Setting.R
tags/0.1.6/R/autoCoding.R
tags/0.1.6/R/deletion.R
tags/0.1.6/R/relation.R
tags/0.1.6/R/root_gui.R
tags/0.1.6/R/sysdata.rda
tags/0.1.6/R/utils.R
tags/0.1.6/R/zzz.R
tags/0.1.6/TODO
tags/0.1.6/inst/
tags/0.1.6/inst/database_structure.txt
tags/0.1.6/man/
tags/0.1.6/man/CrossCodes.rd
tags/0.1.6/man/GetCodingTable.rd
tags/0.1.6/man/GetFileId.rd
tags/0.1.6/man/RQDA-internal.rd
tags/0.1.6/man/RQDA-package.Rd
tags/0.1.6/man/SearchFiles.rd
tags/0.1.6/man/SummaryCoding.rd
tags/0.1.6/man/list.deleted.rd
tags/0.1.6/man/relation.rd
tags/0.1.6/man/write.FileList.rd
Modified:
pkg/ChangeLog
pkg/DESCRIPTION
pkg/R/CaseButton.R
pkg/R/CodeCatButton.R
pkg/R/Coding_Buttons.R
pkg/R/FileCatButton.R
pkg/R/root_gui.R
www/ChangeLog.txt
www/documentation.html
Log:
release of 0.1.6
Modified: pkg/ChangeLog
===================================================================
--- pkg/ChangeLog 2008-12-22 16:30:48 UTC (rev 54)
+++ pkg/ChangeLog 2008-12-24 05:33:28 UTC (rev 55)
@@ -1,3 +1,7 @@
+2008-12-24
+ * Fix minor bugs of "Unmark", "AddTo", and "HL_ALL" buttons.
+ * add new content to documentation.html.
+
2008-12-21
* Fix latex related issue in SearchFiles.rd.
* Fix bug of C2Info: encoding issue.
Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION 2008-12-22 16:30:48 UTC (rev 54)
+++ pkg/DESCRIPTION 2008-12-24 05:33:28 UTC (rev 55)
@@ -2,7 +2,7 @@
Type: Package
Title: R-based Qualitative Data Analysis
Version: 0.1.6
-Date: 2008-12-18
+Date: 2008-12-25
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-22 16:30:48 UTC (rev 54)
+++ pkg/R/CaseButton.R 2008-12-24 05:33:28 UTC (rev 55)
@@ -177,6 +177,7 @@
## if the not file is open, unmark doesn't work.
if (!is.null(sel_index)) {
SelectedCase <- svalue(.rqda$.CasesNamesWidget)
+ if (length(SelectedCase)==0) {gmessage("Select a case first.",con=TRUE)} else{
## Encoding(SelectedCase) <- "UTF-8"
caseid <- dbGetQuery(.rqda$qdacon,sprintf("select id from cases where name=='%s'",SelectedCase))[,1]
SelectedFile <- svalue(.rqda$.root_edit)
@@ -193,6 +194,7 @@
ClearMark(W,min=sel_index$startN,max=sel_index$endN,clear.fore.col = FALSE, clear.back.col = TRUE)
## even for the non-current code. can improve.
}
+ }
}},action=list(widget=".openfile_gui")
)
}
Modified: pkg/R/CodeCatButton.R
===================================================================
--- pkg/R/CodeCatButton.R 2008-12-22 16:30:48 UTC (rev 54)
+++ pkg/R/CodeCatButton.R 2008-12-24 05:33:28 UTC (rev 55)
@@ -122,6 +122,7 @@
gbutton(label,handler=function(h,...) {
## SelectedCodeCat and its id (table codecat): svalue()-> Name; sql->catid
SelectedCodeCat <- svalue(.rqda$.CodeCatWidget)
+ if (length(SelectedCodeCat)==0) {gmessage("Select a code category first.",con=TRUE)} else{
catid <- dbGetQuery(.rqda$qdacon,sprintf("select catid from codecat where status=1 and name='%s'",SelectedCodeCat))[,1]
## CodeList and the id (table freecode): sql -> name and id where status==1
freecode <- dbGetQuery(.rqda$qdacon,"select name, id from freecode where status=1")
@@ -147,6 +148,7 @@
}
)
}
+ }
)
}
Modified: pkg/R/Coding_Buttons.R
===================================================================
--- pkg/R/Coding_Buttons.R 2008-12-22 16:30:48 UTC (rev 54)
+++ pkg/R/Coding_Buttons.R 2008-12-24 05:33:28 UTC (rev 55)
@@ -63,7 +63,8 @@
handler=function(h,...) {
if (is_projOpen(env=.rqda,conName="qdacon")) {
con <- .rqda$qdacon
- SelectedFile <- svalue(.rqda$.root_edit)
+ SelectedFile <- tryCatch(svalue(.rqda$.root_edit),error=function(e){NULL})
+ if (!is.null(SelectedFile)) {
Encoding(SelectedFile) <- "UTF-8"
currentFid <- dbGetQuery(con,sprintf("select id from source where name=='%s'",SelectedFile))[,1]
W <- tryCatch( get(h$action$widget,.rqda),
@@ -80,6 +81,7 @@
HL(W,index=mark_index)
}
}
+ }
},
action=list(widget=".openfile_gui")
)
@@ -167,6 +169,7 @@
## if the not file is open, unmark doesn't work.
if (!is.null(sel_index)) {
SelectedCode <- svalue(.rqda$.codes_rqda)
+ if (length(SelectedCode)==0) {gmessage("Select a code first.",con=TRUE)} else{
Encoding(SelectedCode) <- "UTF-8"
currentCid <- dbGetQuery(.rqda$qdacon,
sprintf("select id from freecode where name=='%s'",
@@ -188,6 +191,7 @@
## This clear all the marks in the gtext window,
## even for the non-current code. can improve.
}
+ }
}
},
action=list(widget=".openfile_gui")
@@ -364,13 +368,13 @@
] ## determine which codes correspond to the selection
cid <- codings_index$cid[codings_index$rowid %in% rowid]
Codes <- CodeTable$name[CodeTable$id %in% cid]
- Encoding(Codes) <- "UTF-8"
## should not use data frame as x, otherwise, svalue(c2infoWidget) is a factor rather than a character
if (length(Codes)!=0){
- tryCatch(dispose(.rqda$.c2info),error=function(e){})
- gw <- gwindow(title="Associted code-list.",heigh=min(33*length(Codes),600),parent=.rqda$.openfile_gui)
- c2infoWidget <- gtable(Codes,con=gw)
- assign(".c2info",gw,env=.rqda)
- addhandlerdoubleclick(c2infoWidget,handler=function(h,...) retrieval(CodeNameWidget=c2infoWidget))
+ Encoding(Codes) <- "UTF-8"
+ tryCatch(dispose(.rqda$.c2info),error=function(e){})
+ gw <- gwindow(title="Associted code-list.",heigh=min(33*length(Codes),600),parent=.rqda$.openfile_gui)
+ c2infoWidget <- gtable(Codes,con=gw)
+ assign(".c2info",gw,env=.rqda)
+ addhandlerdoubleclick(c2infoWidget,handler=function(h,...) retrieval(CodeNameWidget=c2infoWidget))
}
}}}
Modified: pkg/R/FileCatButton.R
===================================================================
--- pkg/R/FileCatButton.R 2008-12-22 16:30:48 UTC (rev 54)
+++ pkg/R/FileCatButton.R 2008-12-24 05:33:28 UTC (rev 55)
@@ -87,6 +87,7 @@
{
gbutton(label,handler=function(h,...) {
SelectedFileCat <- svalue(.rqda$.FileCatWidget)
+ if (length(SelectedFileCat)==0) {gmessage("Select a file category first.",con=TRUE)} else{
catid <- dbGetQuery(.rqda$qdacon,sprintf("select catid from filecat where status=1 and name='%s'",SelectedFileCat))[,1]
freefile <- dbGetQuery(.rqda$qdacon,"select name, id from source where status=1")
Encoding(SelectedFileCat) <- Encoding(freefile[['name']]) <- "UTF-8"
@@ -116,6 +117,7 @@
}},enclos=CurrentFrame)
}
+ }
)
}
Modified: pkg/R/root_gui.R
===================================================================
--- pkg/R/root_gui.R 2008-12-22 16:30:48 UTC (rev 54)
+++ pkg/R/root_gui.R 2008-12-24 05:33:28 UTC (rev 55)
@@ -36,7 +36,7 @@
glabel(
"Author: <ronggui.huang at gmail.com>\n
License: New style BSD License\n
-Version: 0.1.6 RC3\n",
+Version: 0.1.6 rev 55\n",
container=.proj_gui
)
Added: tags/0.1.6/ChangeLog
===================================================================
--- tags/0.1.6/ChangeLog (rev 0)
+++ tags/0.1.6/ChangeLog 2008-12-24 05:33:28 UTC (rev 55)
@@ -0,0 +1,149 @@
+2008-12-24
+ * Fix minor bugs of "Unmark", "AddTo", and "HL_ALL" buttons.
+ * add new content to documentation.html.
+
+2008-12-21
+ * Fix latex related issue in SearchFiles.rd.
+ * Fix bug of C2Info: encoding issue.
+ * Add new content to documentation.html.
+
+2008-12-18 (as version 0.1.6RC3)
+ * Rename CrossTable to CrossTwo
+ * New function of CrossCode
+
+2008-12-17
+ * Improve the relation function and revise MarkCodeFun accordingly.
+ * New function of CrossTable for inter-relationship between codes (The name of it may change in the future).
+
+2008-12-15
+ * Add help of GetCodingTable.
+ * Fix bugs of "Web Search-Baidu" and "Web Search-Sohu" of the case popup menu (now works for UTF-8 locale).
+ * Fix bugs of "Add to case/file category" of the fils popup menu.
+
+2008-12-14
+ * Add help of SearchFiles and GetFileId.
+ * Change the default of ask argument of undelete to TRUE.
+
+2008-12-13
+ * New function of gselect.list, gtk version of select.list (Thanks John).
+ * Add help of SummaryCoding, improve help of write.FileList.
+
+2008-12-12
+ * Fix bugs of SortByTime(), now should work for R < 2.8.0. Fix bug of GetCodingTable and SummaryCoding.
+ * 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).
+ * New Coding Button: C2Info
+
+2008-12-10
+ * New functions of SearchFiles.
+
+2008-12-09
+ * New functions to summary codings: SummaryCoding, GetCodingTable.
+ * Add documentation.
+
+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
+ * fix bug in close project button
+ * Popup menu of Files Tab: "Show uncoded files only" (useful when there are large number of files).
+
+2008-12-06 (rc2 of v1.6)
+ * bugfix of Freecode rename button and others.
+ * Memo in Popup menu in Files Tab.
+ * Enhance Mark buttons, so it will not save duplicated information in database.
+ * New function relation() for caculating relation between two coding.
+ * Improve ViewFileFun() so the codings are highlighted when a file is opened.
+ * Add some popup menus.
+ * Improve pdelete(),list.deleted() and undelete(). New function of CleanProject().
+
+2008-12-05
+ * New functionality of add memo to File category and Code category.
+ * Reorganize the memo for Cases. Now opem case memo by double-click or popup menu
+ * Unmark button for cases.
+ * Add Settings Tab, so user can change settings easily.
+
+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").
+ * 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.
+ * Now can open associated files of a case from Cases Tab.
+ * new function of write.FileList() to import a batch of files.
+
+
+2008-12-01
+ * enhance the rename buttons.
+ * bugfix of add buttons: continue only when click confirm in the ginput widget.
+ * New function write.FileList() to import files by batch.
+ * Enchance the retrieval2 function so coding on the file (openned by clicking back button) is possible.
+
+2008-11-30
+ * fix some minor bugs.
+
+2008-11-29
+ * enhancement of function list.deleted() and pdelete()
+ * better handle the encoding issue in ViewFileButton and handler for openning a file.
+ * Add F-Cat (file-category) to help organized the files.
+ * Add doubleclick handlers to CodeOfCat and FileOfCat to retrieve coding and open file.
+ * fix typo (Thanks Adrian Dusa)
+ * fix a minor bug of CodeNamesUpdate() and new_proj().
+
+2008-11-25
+ * Take care of the warning from R CMD check
+
+2008-11-24
+ * Can back to the original file from Retrieved text chunck (by retrieval2 function).
+
+2008-11-23 (as version 0.1.5)
+ * Add AddTo/DropFrom Buttons for Code-Category.
+ * Improve the display of retrieved coding.
+
+2008-11-22
+ * change "Add Code Category" Button to popup menu
+ * Open selected file by double click.
+ * Retrieve coding chuck by double click.
+ * Add/rename/delete Buttons for Code-Category.
+
+2008-11-21
+ * Add WebSearch Case button (for convienence)
+ * Add "Add Code Category" Button
+
+2008-11-19 (as verion 0.1.4)
+ * Add project memo
+ * rename of file/free code names
+ * reorganize the code for memo(s)
+ * Handle Encoding better (use UTF-8 for storage in date base)
+ * Add cases category
+
+2008-11-01(as version 0.1.3)
+ * Add functionality of file/code/coding memo.
+
+2008-10-31
+ * Add functionality of delete selected code.
+ * Add helper functions to show the temp deleted file/code/coding.
+ * Add helper functions to delete file/code/coding permanently.
+ * Add helper functions to undo the temporary deletion.
+ * Minor changes to the database structure, adding memo, owner and date.
+ * some minor bugs are fixed.
+ * Now, RQDA() will launch when the package is attached.
+
+2008-10-29
+ * Add functionality of delete selected file.
+
+2008-5-17
+ * Open coding text chunk is added.
+ * "Unmark" button works now.
+
+2008-5-14
+ * Use /R/sysdata.rda to store meta data such as .rqda environment, so no need to generate it in .GlobalEnv.
+ * Add RQDA-package.rd in /man.
Added: tags/0.1.6/DESCRIPTION
===================================================================
--- tags/0.1.6/DESCRIPTION (rev 0)
+++ tags/0.1.6/DESCRIPTION 2008-12-24 05:33:28 UTC (rev 55)
@@ -0,0 +1,12 @@
+Package: RQDA
+Type: Package
+Title: R-based Qualitative Data Analysis
+Version: 0.1.6
+Date: 2008-12-25
+Author: HUANG Ronggui
+Maintainer: HUANG Ronggui <ronggui.huang at gmail.com>
+Depends: R (>= 2.5.0), DBI, RSQLite, RGtk2, gWidgets, gWidgetsRGtk2
+Description: R package for Qualitative Data Analysis. Current version only supports plain text.
+License: New Style BSD License
+LazyLoad: yes
+URL: http://rqda.r-forge.r-project.org/
Added: tags/0.1.6/KnownBugs
===================================================================
--- tags/0.1.6/KnownBugs (rev 0)
+++ tags/0.1.6/KnownBugs 2008-12-24 05:33:28 UTC (rev 55)
@@ -0,0 +1 @@
+retreival2() has a bug: can not always (sometimes it does) scroll to the right position when click the button of back.
\ No newline at end of file
Added: tags/0.1.6/License
===================================================================
--- tags/0.1.6/License (rev 0)
+++ tags/0.1.6/License 2008-12-24 05:33:28 UTC (rev 55)
@@ -0,0 +1,12 @@
+http://www.opensource.org/licenses/bsd-license.php
+
+Copyright (c) 2008-2009, Ronggui HUANG,All rights reserved.
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.
+ * Neither the name of the owner nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
\ No newline at end of file
Added: tags/0.1.6/R/CaseButton.R
===================================================================
--- tags/0.1.6/R/CaseButton.R (rev 0)
+++ tags/0.1.6/R/CaseButton.R 2008-12-24 05:33:28 UTC (rev 55)
@@ -0,0 +1,337 @@
+AddCaseButton <- function(label="ADD"){
+ gbutton(label,handler=function(h,...) {
+ if (is_projOpen(env=.rqda,conName="qdacon")) {
+ CaseName <- ginput("Enter new Case Name. ", icon="info")
+ if (CaseName!="") {
+ Encoding(CaseName) <- "UTF-8"
+ AddCase(CaseName)
+ CaseNamesUpdate()
+ }
+ }
+ }
+ )
+}
+
+DeleteCaseButton <- function(label="Delete"){
+ gbutton(label,
+ handler=function(h,...)
+ {
+ if (is_projOpen(env=.rqda,conName="qdacon") &
+ length(svalue(.rqda$.CasesNamesWidget))!=0) {
+ del <- gconfirm("Really delete the Case?",icon="question")
+ if (isTRUE(del)){
+ SelectedCase <- svalue(.rqda$.CasesNamesWidget)
+ Encoding(SelectedCase) <- "UTF-8"
+ caseid <- dbGetQuery(.rqda$qdacon,sprintf("select id from cases where name=='%s'",SelectedCase))$id
+ dbGetQuery(.rqda$qdacon,sprintf("update cases set status=0 where name=='%s'",SelectedCase))
+ ## set status in table freecode to 0
+ dbGetQuery(.rqda$qdacon,sprintf("update caselinkage set status=0 where caseid=%i",caseid))
+ ## set status in table caselinkage to 0
+ CaseNamesUpdate()
+ }
+ }
+ }
+ )
+}
+
+Case_RenameButton <- function(label="Rename",CaseNamesWidget=.rqda$.CasesNamesWidget,...)
+{
+ ## rename of selected case.
+ gbutton(label,handler=function(h,...) {
+ if (is_projOpen(env=.rqda,"qdacon")) {
+ ## if project is open, then continue
+ selectedCaseName <- svalue(CaseNamesWidget)
+ if (length(selectedCaseName)==0){
+ gmessage("Select a Case first.",text=selectedCaseName,icon="error",con=TRUE)
+ }
+ else {
+ ## get the new file names
+ NewName <- ginput("Enter new Case name. ", text=selectedCaseName, icon="info")
+ if (NewName != ""){
+ Encoding(NewName) <- "UTF-8"
+ rename(selectedCaseName,NewName,"cases")
+ CaseNamesUpdate()
+ }
+ }
+ }
+ }
+ )
+}
+
+
+
+CaseMemoButton <- function(label="Memo",...){
+## no longer used
+ gbutton(label, handler=function(h,...) {
+ ## code memo: such as meaning of code etc.
+ if (is_projOpen(env=.rqda,"qdacon")) {
+ currentCase <- svalue(.rqda$.CasesNamesWidget)
+ if (length(currentCase)==0){
+ gmessage("Select a Case first.",icon="error",con=TRUE)
+ }
+ else {
+ tryCatch(dispose(.rqda$.casememo),error=function(e) {})
+ assign(".casememo",gwindow(title=paste("Case Memo",.rqda$currentCase,sep=":"),
+ parent=c(370,10),width=600,height=400),env=.rqda)
+ .casememo <- .rqda$.casememo
+ .casememo2 <- gpanedgroup(horizontal = FALSE, con=.casememo)
+ gbutton("Save Case Memo",con=.casememo2,handler=function(h,...){
+ newcontent <- svalue(W)
+ Encoding(newcontent) <- "UTF-8"
+ newcontent <- enc(newcontent) ## take care of double quote.
+ Encoding(currentCase) <- "UTF-8"
+ dbGetQuery(.rqda$qdacon,sprintf("update cases set memo='%s' where name='%s'",newcontent,currentCase))
+ }
+ )## end of save memo button
+ assign(".casememoW",gtext(container=.casememo2,font.attr=c(sizes="large")),env=.rqda)
+ prvcontent <- dbGetQuery(.rqda$qdacon, sprintf("select memo from cases where name='%s'",currentCase))[1,1]
+ if (is.na(prvcontent)) prvcontent <- ""
+ Encoding(prvcontent) <- "UTF-8"
+ W <- .rqda$.casememoW
+ add(W,prvcontent,font.attr=c(sizes="large"),do.newline=FALSE)
+ }
+ }
+ }
+ )
+}
+
+
+CaseMark_Button<-function(){
+ gbutton("Mark",
+ handler=function(h,...) {MarkCaseFun()}
+ )
+}
+
+MarkCaseFun <- function(){
+ if (is_projOpen(env=.rqda,conName="qdacon")) {
+ con <- .rqda$qdacon
+ tryCatch({
+ ans <- mark(get(".openfile_gui",env=.rqda),fore.col=NULL,back.col=.rqda$back.col)
+ ## can change the color
+ if (ans$start != ans$end){
+ ## when selected no text, makes on sense to do anything.
+ SelectedCase <- svalue(.rqda$.CasesNamesWidget)
+ Encoding(SelectedCase) <- "UTF-8"
+ currentCid <- dbGetQuery(con,sprintf("select id from cases where name=='%s'",
+ SelectedCase))[,1]
+ SelectedFile <- svalue(.rqda$.root_edit)
+ Encoding(SelectedFile) <- "UTF-8"
+ currentFid <- dbGetQuery(con,sprintf("select id from source where name=='%s'",
+ SelectedFile))[,1]
+ ## Query of caselinkage
+ ExistLinkage <- dbGetQuery(con,sprintf("select rowid, selfirst, selend,status from caselinkage where caseid==%i and fid=%i and status=1",currentCid,currentFid))
+ DAT <- data.frame(cid=currentCid,fid=currentFid,
+ selfirst=ans$start,selend=ans$end,status=1,
+ owner=.rqda$owner,date=date(),memo="")
+ if (nrow(ExistLinkage)==0){
+ ## if there are no relevant caselinkage, write the caselinkage table
+ success <- dbWriteTable(.rqda$qdacon,"caselinkage",DAT,row.name=FALSE,append=TRUE)
+ if (!success) gmessage("Fail to write to database.")
+ } else {
+ Relations <- apply(ExistLinkage,1,FUN=function(x) relation(x[c("selfirst","selend")],c(ans$start,ans$end)))
+ ExistLinkage$Relation <- sapply(Relations,FUN=function(x)x$Relation)
+ if (!any(ExistLinkage$Relation=="exact")){
+ ## if there are exact caselinkage, skip; if no exact linkage then continue
+ ExistLinkage$WhichMin <- sapply(Relations,FUN=function(x)x$WhichMin)
+ ExistLinkage$Start <- sapply(Relations,FUN=function(x)x$UnionIndex[1])
+ ExistLinkage$End <- sapply(Relations,FUN=function(x)x$UnionIndex[2])
+ if (all(ExistLinkage$Relation=="proximity")){
+ success <- dbWriteTable(.rqda$qdacon,"caselinkage",DAT,row.name=FALSE,append=TRUE)
+ if (!success) gmessage("Fail to write to database.")
+ } else {
+ del1 <- ExistLinkage$WhichMin==2 & ExistLinkage$Relation =="inclusion"; del1[is.na(del1)] <- FALSE
+ del2 <- ExistLinkage$Relation =="overlap"; del2[is.na(del2)] <- FALSE
+ del <- (del1 | del2)
+ if (any(del)){
+ Sel <- c(min(ExistLinkage$Start[del]), max(ExistLinkage$End[del]))
+ memo <- dbGetQuery(.rqda$qdacon,sprintf("select memo from caselinkage where rowid in (%s)",
+ paste(ExistLinkage$rowid[del],collapse=",",sep="")))$memo
+ memo <- paste(memo,collapse="",sep="")
+ dbGetQuery(.rqda$qdacon,sprintf("delete from caselinkage where rowid in (%s)",
+ paste(ExistLinkage$rowid[del],collapse=",",sep="")))
+ DAT <- data.frame(cid=currentCid,fid=currentFid,
+ selfirst=Sel[1],selend=Sel[2],status=1,
+ owner=.rqda$owner,date=date(),memo=memo)
+ success <- dbWriteTable(.rqda$qdacon,"caselinkage",DAT,row.name=FALSE,append=TRUE)
+ if (!success) gmessage("Fail to write to database.")
+ }
+ }
+ }
+ }
+ }
+ },error=function(e){}
+ )
+ }
+}
+
+
+
+CaseUnMark_Button<-function(label="Unmark"){
+ gbutton(label,
+ handler=function(h,...) {
+ if (is_projOpen(env=.rqda,conName="qdacon")) {
+ con <- .rqda$qdacon
+ W <- tryCatch(get(h$action$widget,env=.rqda),error=function(e){})
+ ## get the widget for file display. If it does not exist, then return NULL.
+ sel_index <- tryCatch(sindex(W),error=function(e) {})
+ ## if the not file is open, unmark doesn't work.
+ if (!is.null(sel_index)) {
+ SelectedCase <- svalue(.rqda$.CasesNamesWidget)
+ if (length(SelectedCase)==0) {gmessage("Select a case first.",con=TRUE)} else{
+ ## Encoding(SelectedCase) <- "UTF-8"
+ caseid <- dbGetQuery(.rqda$qdacon,sprintf("select id from cases where name=='%s'",SelectedCase))[,1]
+ SelectedFile <- svalue(.rqda$.root_edit)
+ ## Encoding(SelectedFile) <- "UTF-8"
+ currentFid <- dbGetQuery(con,sprintf("select id from source where name=='%s'", SelectedFile))[,1]
+ codings_index <- dbGetQuery(con,sprintf("select rowid, caseid, fid, selfirst, selend from caselinkage where caseid==%i and fid==%i", caseid, currentFid))
+ ## should only work with those related to current case and current file.
+ rowid <- codings_index$rowid[(codings_index$selfirst >= sel_index$startN) &
+ (codings_index$selend <= sel_index$endN)]
+ if (is.numeric(rowid)) for (j in rowid) {
+ dbGetQuery(con,sprintf("update caselinkage set status=0 where rowid=%i", j))
+ }
+ ## better to get around the loop by sqlite condition expression.
+ ClearMark(W,min=sel_index$startN,max=sel_index$endN,clear.fore.col = FALSE, clear.back.col = TRUE)
+ ## even for the non-current code. can improve.
+ }
+ }
+ }},action=list(widget=".openfile_gui")
+ )
+ }
+
+## AddWebSearchButton <- function(label="WebSearch",CaseNamesWidget=.rqda$.CasesNamesWidget){
+## gbutton(label,handler=function(h,...) {
+## if (is_projOpen(env=.rqda,conName="qdacon")) {
+## KeyWord <- svalue(CaseNamesWidget)
+## engine <- select.list(c("Baidu","Google","Yahoo"))
+## if (engine=="Baidu") {
+## KeyWord <- iconv(KeyWord, from="UTF-8")
+## browseURL(sprintf("http://www.baidu.com/s?wd=%s",paste("%",paste(charToRaw(KeyWord),sep="",collapse="%"),sep="",collapse="")))
+## }
+## if (engine=="Yahoo") {
+## KeyWord <- iconv(KeyWord, from="UTF-8")
+## browseURL(sprintf("http://search.yahoo.com/search;_ylt=A0oGkmFV.CZJNssAOK.l87UF?p=%s&ei=UTF-8&iscqry=&fr=sfp&fr2=sfp"
+## ,KeyWord))
+## }
+## if (engine=="Google")browseURL(sprintf("http://www.google.com/search?q=%s",KeyWord))
+## }
+## }
+## )
+## }
+
+CaseNamesWidgetMenu <- list()
+CaseNamesWidgetMenu$"Add File(s)"$handler <- function(h, ...) {
+ if (is_projOpen(env = .rqda, conName = "qdacon", message = FALSE)) {
+ 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)
+ 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()
+ }})
+ }
+ }
+}
+CaseNamesWidgetMenu$"Case Memo"$handler <- function(h,...){
+ if (is_projOpen(env=.rqda,conName="qdacon")) {
+ MemoWidget("Case",.rqda$.CasesNamesWidget,"cases")
+ ## see CodeCatButton.R for definition of MemoWidget
+ }
+}
+CaseNamesWidgetMenu$"Sort by created time"$handler <- function(h,...){
+CaseNamesUpdate(.rqda$.CasesNamesWidget)
+}
+CaseNamesWidgetMenu$"Web Search"$Google$handler <- function(h,...){
+ KeyWord <- svalue(.rqda$.CasesNamesWidget)
+ if (length(KeyWord)!=0){
+ KeyWord <- iconv(KeyWord, from="UTF-8")
+ browseURL(sprintf("http://www.google.com/search?q=%s",KeyWord))
+ }
+}
+CaseNamesWidgetMenu$"Web Search"$Yahoo$handler <- function(h,...){
+ KeyWord <- svalue(.rqda$.CasesNamesWidget)
+ if (length(KeyWord)!=0){
+ KeyWord <- iconv(KeyWord, from="UTF-8")
+ browseURL(sprintf("http://search.yahoo.com/search;_ylt=A0oGkmFV.CZJNssAOK.l87UF?p=%s&ei=UTF-8&iscqry=&fr=sfp&fr2=sfp"
+ ,KeyWord))
+ }
+}
+CaseNamesWidgetMenu$"Web Search"$Baidu$handler <- function(h,...){
+ KeyWord <- svalue(.rqda$.CasesNamesWidget)
+ if (length(KeyWord)!=0){
+ KeyWord <- iconv(KeyWord, from="UTF-8",to="CP936") ## should be in CP936 to work properly.
+ browseURL(sprintf("http://www.baidu.com/s?wd=%s",paste("%",paste(charToRaw(KeyWord),sep="",collapse="%"),sep="",collapse="")))
+ }
+}
+CaseNamesWidgetMenu$"Web Search"$Sogou$handler <- function(h,...){
+ KeyWord <- svalue(.rqda$.CasesNamesWidget)
+ if (length(KeyWord)!=0){
+ KeyWord <- iconv(KeyWord, from="UTF-8",to="CP936")## should be in CP936 to work properly.
+ browseURL(sprintf("http://www.sogou.com/sohu?query=%s",paste("%",paste(charToRaw(KeyWord),sep="",collapse="%"),sep="",collapse="")))
+ }
+}
+
+
+## pop-up menu of .rqda$.FileofCase
+FileofCaseWidgetMenu <- list() ## not used yet.
+FileofCaseWidgetMenu$"Drop Selected File(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()
+ }
+ }
+ }
+ }
+FileofCaseWidgetMenu$"File Memo"$handler <- function(h,...){
+ MemoWidget("File",.rqda$.FileofCase,"source")
+}
+FileofCaseWidgetMenu$"Show Uncoded Files Only (sorted)"$handler <- function(h,...){
+if (is_projOpen(env=.rqda,conName="qdacon")) {
+ fid <- GetFileId(condition="case",type="uncoded")
+ FileNameWidgetUpdate(FileNamesWidget=.rqda$.FileofCase,FileId=fid)
+ }
+}
+FileofCaseWidgetMenu$"Show Coded Files Only (sorted)"$handler <- function(h,...){
+if (is_projOpen(env=.rqda,conName="qdacon")) {
+ fid <- GetFileId(condition="case",type="coded")
+ FileNameWidgetUpdate(FileNamesWidget=.rqda$.FileofCase,FileId=fid)
+ }
+}
+FileofCaseWidgetMenu$"Sort by imported time"$handler <- function(h,...){
+## UpdateFileofCaseWidget()
+if (is_projOpen(env=.rqda,conName="qdacon")) {
+ fid <- GetFileId(condition="case",type="all")
+ FileNameWidgetUpdate(FileNamesWidget=.rqda$.FileofCase,FileId=fid)
+ }
+}
+
Added: tags/0.1.6/R/CaseFun.R
===================================================================
--- tags/0.1.6/R/CaseFun.R (rev 0)
+++ tags/0.1.6/R/CaseFun.R 2008-12-24 05:33:28 UTC (rev 55)
@@ -0,0 +1,113 @@
+CaseNamesUpdate <- function(CaseNamesWidget=.rqda$.CasesNamesWidget,decreasing=FALSE,...)
+{
+ if (isIdCurrent(.rqda$qdacon)){
+ 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){})
+ }
+}
+
+#################
+###############
+AddCase <- function(name,conName="qdacon",assignenv=.rqda,...) {
+ if (name != ""){
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/rqda -r 55
More information about the Rqda-commits
mailing list