[Rqda-commits] r35 - pkg pkg/R pkg/man www
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Dec 5 20:35:10 CET 2008
Author: wincent
Date: 2008-12-05 20:35:09 +0100 (Fri, 05 Dec 2008)
New Revision: 35
Added:
pkg/R/relation.R
pkg/man/relation.rd
Modified:
pkg/ChangeLog
pkg/DESCRIPTION
pkg/R/CaseButton.R
pkg/R/Coding_Buttons.R
pkg/R/FileButton.R
pkg/R/FilesFun.R
pkg/R/GUIHandler.R
pkg/R/root_gui.R
pkg/man/RQDA-internal.rd
pkg/man/RQDA-package.Rd
www/ChangeLog.txt
Log:
Modified: pkg/ChangeLog
===================================================================
--- pkg/ChangeLog 2008-12-05 04:31:44 UTC (rev 34)
+++ pkg/ChangeLog 2008-12-05 19:35:09 UTC (rev 35)
@@ -1,85 +1,91 @@
-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.
+2008-12-06
+ * 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.
+
+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.
Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION 2008-12-05 04:31:44 UTC (rev 34)
+++ pkg/DESCRIPTION 2008-12-05 19:35:09 UTC (rev 35)
@@ -1,7 +1,7 @@
Package: RQDA
Type: Package
Title: Qualitative Data Analysis
-Version: 0.1.5-34
+Version: 0.1.5-35
Date: 2008-11-01
Author: HUANG Ronggui
Maintainer: HUANG Ronggui <ronggui.huang at gmail.com>
Modified: pkg/R/CaseButton.R
===================================================================
--- pkg/R/CaseButton.R 2008-12-05 04:31:44 UTC (rev 34)
+++ pkg/R/CaseButton.R 2008-12-05 19:35:09 UTC (rev 35)
@@ -47,6 +47,7 @@
if (NewName != ""){
Encoding(NewName) <- "UTF-8"
rename(selectedCaseName,NewName,"cases")
+ CaseNamesUpdate()
}
}
}
@@ -94,38 +95,74 @@
CaseMark_Button<-function(){
gbutton("Mark",
- handler=function(h,...) {
- if (is_projOpen(env=.rqda,conName="qdacon")) {
- con <- .rqda$qdacon
- tryCatch({
- ans <- mark(get(h$action$widget,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]
- DAT <- data.frame(cid=currentCid,fid=currentFid,
- selfirst=ans$start,selend=ans$end,status=1,
- owner=.rqda$owner,date=date(),memo="")
- success <- dbWriteTable(.rqda$qdacon,"caselinkage",DAT,row.name=FALSE,append=TRUE)
- if (!success) gmessage("Fail to write to database.")
- }
- },error=function(e){}
- )
- }
- },
- action=list(widget=".openfile_gui")
+ 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,...) {
@@ -157,63 +194,62 @@
)
}
- 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))
- }
- }
- )
-}
+## 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$WebSearch$Baidu$handler <- function(h,...){
- KeyWord <- svalue(.rqda$.CasesNamesWidget)
- if (length(KeyWord)!=0){
+CaseNamesWidgetMenu <- list()
+CaseNamesWidgetMenu$"Web Search"$Baidu$handler <- function(h,...){
+ KeyWord <- svalue(.rqda$.CasesNamesWidget)
+ if (length(KeyWord)!=0){
KeyWord <- iconv(KeyWord, from="UTF-8")
browseURL(sprintf("http://www.baidu.com/s?wd=%s",paste("%",paste(charToRaw(KeyWord),sep="",collapse="%"),sep="",collapse="")))
}
- }
-CaseNamesWidgetMenu$WebSearch$Google$handler <- function(h,...){
+}
+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$WebSearch$Yahoo$handler <- function(h,...){
- KeyWord <- svalue(.rqda$.CasesNamesWidget)
- if (length(KeyWord)!=0){
+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))
+ ,KeyWord))
}
}
-
- CaseNamesWidgetMenu$"AddFile(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))
+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)
- if (length(Selected)> 0) {
+ 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"])
@@ -221,29 +257,27 @@
dbWriteTable(.rqda$qdacon,"caselinkage",Dat,row.names=FALSE,append=TRUE)
UpdateFileofCaseWidget()
}
- }
}
}
-
-
-CaseNamesWidgetMenu$Memo$handler <- function(h,...){
+ }
+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
+ }
}
-}
-
-
+
+
## 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) {
+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")
+ {
+ ## 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"
@@ -255,7 +289,6 @@
## update Widget
UpdateFileofCaseWidget()
}
- }
+ }
}
}
-
Modified: pkg/R/Coding_Buttons.R
===================================================================
--- pkg/R/Coding_Buttons.R 2008-12-05 04:31:44 UTC (rev 34)
+++ pkg/R/Coding_Buttons.R 2008-12-05 19:35:09 UTC (rev 35)
@@ -86,36 +86,67 @@
Mark_Button<-function(){
gbutton("Mark",
- handler=function(h,...) {
- if (is_projOpen(env=.rqda,conName="qdacon")) {
- con <- .rqda$qdacon
- tryCatch({
- ans <- mark(get(h$action$widget,env=.rqda)) ## can change the color
- if (ans$start != ans$end){
- ## when selected no text, makes on sense to do anything.
- SelectedCode <- svalue(.rqda$.codes_rqda)
- Encoding(SelectedCode) <- "UTF-8"
- currentCid <- dbGetQuery(con,sprintf("select id from freecode where name=='%s'",
- SelectedCode))[,1]
- SelectedFile <- svalue(.rqda$.root_edit)
- Encoding(SelectedFile) <- "UTF-8"
- currentFid <- dbGetQuery(con,sprintf("select id from source where name=='%s'",
- SelectedFile))[,1]
- DAT <- data.frame(cid=currentCid,fid=currentFid,seltext=ans$text,
- selfirst=ans$start,selend=ans$end,status=1,
- owner=.rqda$owner,date=date(),memo="")
- success <- dbWriteTable(.rqda$qdacon,"coding",DAT,row.name=FALSE,append=TRUE)
- if (!success) gmessage("Fail to write to database.")
- }
- },error=function(e){}
- )
- }
- },
- action=list(widget=".openfile_gui")
+ handler=function(h,...) {MarkCodeFun()}
)
}
-
+MarkCodeFun <- function(){
+ if (is_projOpen(env=.rqda,conName="qdacon")) {
+ con <- .rqda$qdacon
+ tryCatch({
+ W <- get(".openfile_gui",env=.rqda)
+ ans <- mark(W) ## can change the color
+ if (ans$start != ans$end){
+ ## when selected no text, makes on sense to do anything.
+ SelectedCode <- svalue(.rqda$.codes_rqda)
+ Encoding(SelectedCode) <- "UTF-8"
+ currentCid <- dbGetQuery(con,sprintf("select id from freecode where name=='%s'",SelectedCode))[,1]
+ SelectedFile <- svalue(.rqda$.root_edit)
+ Encoding(SelectedFile) <- "UTF-8"
+ currentFid <- dbGetQuery(con,sprintf("select id from source where name=='%s'",SelectedFile))[,1]
+ Exist <- dbGetQuery(con,sprintf("select rowid, selfirst, selend from coding where cid==%i and fid=%i and status=1",currentCid,currentFid))
+ DAT <- data.frame(cid=currentCid,fid=currentFid,seltext=ans$text,selfirst=ans$start,selend=ans$end,status=1,
+ owner=.rqda$owner,date=date(),memo="")
+ if (nrow(Exist)==0){
+ success <- dbWriteTable(.rqda$qdacon,"coding",DAT,row.name=FALSE,append=TRUE)
+ if (!success) gmessage("Fail to write to database.")
+ } else {
+ Relations <- apply(Exist,1,FUN=function(x) relation(x[c("selfirst","selend")],c(ans$start,ans$end)))
+ Exist$Relation <- sapply(Relations,FUN=function(x)x$Relation)
+ if (!any(Exist$Relation=="exact")){
+ Exist$WhichMin <- sapply(Relations,FUN=function(x)x$WhichMin)
+ Exist$Start <- sapply(Relations,FUN=function(x)x$UnionIndex[1])
+ Exist$End <- sapply(Relations,FUN=function(x)x$UnionIndex[2])
+ if (all(Exist$Relation=="proximity")){
+ success <- dbWriteTable(.rqda$qdacon,"coding",DAT,row.name=FALSE,append=TRUE)
+ if (!success) gmessage("Fail to write to database.")
+ } else {
+ del1 <- Exist$WhichMin==2 & Exist$Relation =="inclusion"; del1[is.na(del1)] <- FALSE
+ del2 <- Exist$Relation =="overlap"; del2[is.na(del2)] <- FALSE
+ del <- (del1 | del2)
+ if (any(del)){
+ Sel <- c(min(Exist$Start[del]), max(Exist$End[del]))
+ memo <- dbGetQuery(.rqda$qdacon,sprintf("select memo from coding where rowid in (%s)",
+ paste(Exist$rowid[del],collapse=",",sep="")))$memo
+ memo <- paste(memo,collapse="",sep="")
+ dbGetQuery(.rqda$qdacon,sprintf("delete from coding where rowid in (%s)",
+ paste(Exist$rowid[del],collapse=",",sep="")))
+ tt <- svalue(W); Encoding(tt) <- "UTF-8"
+ DAT <- data.frame(cid=currentCid,fid=currentFid,seltext=substr(tt,Sel[1],Sel[2]),
+ selfirst=Sel[1],selend=Sel[2],status=1,
+ owner=.rqda$owner,date=date(),memo=memo)
+ success <- dbWriteTable(.rqda$qdacon,"coding",DAT,row.name=FALSE,append=TRUE)
+ if (!success) gmessage("Fail to write to database.")
+ }
+ }
+ }
+ }
+ }
+ },error=function(e){}
+ )
+ }
+}
+
Unmark_Button <- function(){
gbutton("Unmark",
handler=function(h,...) {
@@ -272,6 +303,7 @@
## update the name in source table by a function
rename(selectedCodeName,NewCodeName,"freecode")
## (name is the only field should be modifed, as other table use ID rather than name)
+ CodeNamesUpdate()
}
}
}
Modified: pkg/R/FileButton.R
===================================================================
--- pkg/R/FileButton.R 2008-12-05 04:31:44 UTC (rev 34)
+++ pkg/R/FileButton.R 2008-12-05 19:35:09 UTC (rev 35)
@@ -7,6 +7,7 @@
if (path!=""){
Encoding(path) <- "UTF-8" ## have to convert, otherwise, can not find the file.
ImportFile(path,con=.rqda$qdacon)
+ FileNamesUpdate()
}
}
}
@@ -123,6 +124,7 @@
## Newfilename <- iconv(codename,from="UTF-8") ## now use UTF-8 for SQLite data set.
## update the name in source table by a function
rename(selectedFN,NewFileName,"source")
+ FileNamesUpdate()
## (name is the only field should be modifed, as other table use fid rather than name)
}
}
@@ -134,17 +136,30 @@
## pop-up menu of add to case and F-cat from Files Tab
-AddFileToCaseMenu <- list()
-AddFileToCaseMenu$AddToCase$handler <- function(h, ...) {
+FileNamesWidgetMenu <- list()
+FileNamesWidgetMenu$"Add To Case"$handler <- function(h, ...) {
if (is_projOpen(env = .rqda, conName = "qdacon", message = FALSE)) {
AddFileToCaselinkage()
UpdateFileofCaseWidget()
}
}
-AddFileToCaseMenu$AddToCategory$handler <- function(h, ...) {
+FileNamesWidgetMenu$"Add To Category"$handler <- function(h, ...) {
if (is_projOpen(env = .rqda, conName = "qdacon", message = FALSE)) {
AddToFileCategory()
UpdateFileofCatWidget()
}
- }
\ No newline at end of file
+ }
+
+FileNamesWidgetMenu$"Sorted by import time"$handler <- function(h, ...) {
+ if (is_projOpen(env = .rqda, conName = "qdacon", message = FALSE)) {
+ FileNamesUpdate(FileNamesWidget=.rqda$.fnames_rqda)
+ }
+ }
+
+FileNamesWidgetMenu$"File Memo"$handler <- function(h,...){
+ if (is_projOpen(env=.rqda,conName="qdacon")) {
+ MemoWidget("File",.rqda$.fnames_rqda,"source")
+## see CodeCatButton.R for definition of MemoWidget
+}
+}
\ No newline at end of file
Modified: pkg/R/FilesFun.R
===================================================================
--- pkg/R/FilesFun.R 2008-12-05 04:31:44 UTC (rev 34)
+++ pkg/R/FilesFun.R 2008-12-05 19:35:09 UTC (rev 35)
@@ -121,7 +121,10 @@
FileNames <- names(FileList)
FileNames[FileNames==""] <- as.character(1:sum(FileNames==""))
- for (i in 1:length(FileList)) {
- WriteToTable(FileNames[i],FileList[[i]])
- }
+ if (isIdCurrent(con)) {
+ for (i in 1:length(FileList)) {
+ WriteToTable(FileNames[i],FileList[[i]])
+ }
+ FileNamesUpdate(FileNamesWidget=.rqda$.fnames_rqda)
+ } else gmessage("Open a project first.", con=TRUE)
}
Modified: pkg/R/GUIHandler.R
===================================================================
--- pkg/R/GUIHandler.R 2008-12-05 04:31:44 UTC (rev 34)
+++ pkg/R/GUIHandler.R 2008-12-05 19:35:09 UTC (rev 35)
@@ -14,13 +14,13 @@
## handler for .fnames_rqda (gtable holding the file names)
- addHandlerClicked(.rqda$.fnames_rqda, handler <- function(h, ...) {
- ## updating the file name list, and update the status of curent selected file.
- if (is_projOpen(env = .rqda, conName = "qdacon", message = FALSE)) {
- FileNamesUpdate(FileNamesWidget=.rqda$.fnames_rqda)
- }
- }
- )
+## addHandlerClicked(.rqda$.fnames_rqda, handler <- function(h, ...) {
+## ## updating the file name list, and update the status of curent selected file.
+## if (is_projOpen(env = .rqda, conName = "qdacon", message = FALSE)) {
+## FileNamesUpdate(FileNamesWidget=.rqda$.fnames_rqda)
+## }
+## }
+## )
## addHandlerMouseMotion(.rqda$.fnames_rqda, handler <- function(h,...) {
## if (is_projOpen(env = .rqda, conName = "qdacon", message = FALSE)) {
@@ -30,7 +30,7 @@
## )
-add3rdmousepopupmenu(.rqda$.fnames_rqda, AddFileToCaseMenu)
+add3rdmousepopupmenu(.rqda$.fnames_rqda, FileNamesWidgetMenu)
## right click to add file to a case category
Added: pkg/R/relation.R
===================================================================
--- pkg/R/relation.R (rev 0)
+++ pkg/R/relation.R 2008-12-05 19:35:09 UTC (rev 35)
@@ -0,0 +1,64 @@
+relation <- function(index1,index2){
+ ## index1 and index2 are length-2 numeric vectors
+ ## results:
+ ## Relation: type of relation
+ ## WhichMin: which argument containts min(c(index1,index2))
+ ## Distance: The distance between to index when Relation is proximity
+ ## the index of the overlap of index1 and index2.
+ if ( !is.vector(index1) || !is.vector(index1) ) stop("index1 and index2 must be vector.")
+ if (any(is.na(c(index1,index2)))) stop("index1 or index2 should not have any NA.")
+ names(index1) <- names(index2) <- NULL
+ if (length(index1)==2 || length(index1)==2){
+ Max <- max(c(index1,index2))
+ Min <- min(c(index1,index2))
+ ans <- list(Relation=NA,WhichMin=NA,Distance=NA,OverlapIndex=c(NA,NA),UnionIndex=c(NA,NA))
+ if (sum(index1 %in% c(Min,Max))==2 || sum(index2 %in% c(Min,Max))==2) {
+ ans$Relation <- "inclusion"
+ if ((index1[1]==Min && index1[2] == Max)) {
+ ans$WhichMin <- 1
+ ans$OverlapIndex <- index2
+ ans$UnionIndex <- index1
+ }
+ else {
+ ans$WhichMin <- 2
+ ans$OverlapIndex <- index1
+ ans$UnionIndex<- index2
+ }
+ ##if (identical(ans$Index,c(index1,index2)[c(ans$WhichMin*2-1,ans$WhichMin*2)])){
+ ##ans$Relation <- "exact"
+ ##ans$WhichMin <- NULL
+ ##}
+ if (identical(ans$UnionIndex,ans$OverlapIndex)) {
+ ans$Relation <- "exact"
+ ans$WhichMin <- NA
+ }
+ } else {
+ if (min(index1) < min(index2) &&
+ max(index1) > min(index2)) {
+ ans$Relation <- "overlap"
+ ans$WhichMin <- 1
+ ans$OverlapIndex <- c(min(index2),max(index1))
+ ans$UnionIndex <- c(min(index1),max(index2))
+ }
+ if (min(index2) < min(index1) &&
+ max(index2) > min(index1)) {
+ ans$Relation <- "overlap"
+ ans$WhichMin <- 2
+ ans$OverlapIndex<- c(min(index1),max(index2))
+ ans$UnionIndex<- c(min(index2),max(index1))
+ }
+ if (max(index1) <= min(index2)){
+ ans$Relation <- "proximity"
+ ans$WhichMin <- 1
+ ans$Distance <- min(index2) -max(index1)
+ }
+ if (max(index2) <= min(index1)){
+ ans$Relation <- "proximity"
+ ans$WhichMin <- 2
+ ans$Distance <- min(index1) -max(index2)
+ }
+ }
+ ans
+ }
+}
+
Modified: pkg/R/root_gui.R
===================================================================
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/rqda -r 35
More information about the Rqda-commits
mailing list