[Rqda-commits] r36 - pkg pkg/R pkg/man www
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sat Dec 6 11:03:44 CET 2008
Author: wincent
Date: 2008-12-06 11:03:43 +0100 (Sat, 06 Dec 2008)
New Revision: 36
Added:
www/Settings.png
Modified:
pkg/ChangeLog
pkg/DESCRIPTION
pkg/R/CaseButton.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/GUIHandler.R
pkg/R/Setting.R
pkg/R/deletion.R
pkg/R/root_gui.R
pkg/TODO
pkg/man/RQDA-internal.rd
pkg/man/list.deleted.rd
www/index.html
Log:
version 0.1.6 RC2
Modified: pkg/ChangeLog
===================================================================
--- pkg/ChangeLog 2008-12-05 19:35:09 UTC (rev 35)
+++ pkg/ChangeLog 2008-12-06 10:03:43 UTC (rev 36)
@@ -1,8 +1,11 @@
-2008-12-06
+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.
Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION 2008-12-05 19:35:09 UTC (rev 35)
+++ pkg/DESCRIPTION 2008-12-06 10:03:43 UTC (rev 36)
@@ -1,12 +1,12 @@
Package: RQDA
Type: Package
Title: Qualitative Data Analysis
-Version: 0.1.5-35
+Version: 0.1.5-36
Date: 2008-11-01
Author: HUANG Ronggui
Maintainer: HUANG Ronggui <ronggui.huang at gmail.com>
-Depends: DBI, RSQLite, RGtk2, gWidgets, gWidgetsRGtk2
-Description: Qualitative Data Analysis based on R language. Current version only supports plain text.
-License: FreeBSD
+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/
Modified: pkg/R/CaseButton.R
===================================================================
--- pkg/R/CaseButton.R 2008-12-05 19:35:09 UTC (rev 35)
+++ pkg/R/CaseButton.R 2008-12-06 10:03:43 UTC (rev 36)
@@ -22,8 +22,11 @@
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()
}
}
@@ -215,28 +218,6 @@
## }
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$"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$"Add File(s)"$handler <- function(h, ...) {
if (is_projOpen(env = .rqda, conName = "qdacon", message = FALSE)) {
SelectedCase <- svalue(.rqda$.CasesNamesWidget)
@@ -266,11 +247,36 @@
## see CodeCatButton.R for definition of MemoWidget
}
}
+CaseNamesWidgetMenu$"Sort by created time"$handler <- function(h,...){
+CaseNamesUpdate(.rqda$.CasesNamesWidget)
+}
+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$"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))
+ }
+}
- ## pop-up menu of .rqda$.FileofCase
+## pop-up menu of .rqda$.FileofCase
FileofCaseWidgetMenu <- list() ## not used yet.
-FileofCaseWidgetMenu$"DropFile(s)"$handler <- function(h, ...) {
+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) {
@@ -292,3 +298,7 @@
}
}
}
+FileofCaseWidgetMenu$"Sort by imported time"$handler <- function(h,...){
+ UpdateFileofCaseWidget()
+}
+
Modified: pkg/R/CodeCatButton.R
===================================================================
--- pkg/R/CodeCatButton.R 2008-12-05 19:35:09 UTC (rev 35)
+++ pkg/R/CodeCatButton.R 2008-12-06 10:03:43 UTC (rev 36)
@@ -66,8 +66,7 @@
tryCatch(dbGetQuery(.rqda$qdacon,sprintf("update treecode set status=0 where catid=='%s'",catid)),error=function(e){})
## should delete all the related codelists
UpdateCodeofCatWidget() ## update the code of cat widget
- } else gmessage("The Category Name is not unique.",con=TRUE)
-
+ } else gmessage("The Category Name is not unique.",con=TRUE)
}
}
}
@@ -182,12 +181,12 @@
if (is_projOpen(env=.rqda,"qdacon")) {
Selected <- svalue(widget)
if (length(Selected)==0){
- gmessage("No selection first.",icon="error",con=TRUE)
+ 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(370,10),width=600,height=400),env=.rqda)
+ 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)
@@ -217,4 +216,16 @@
MemoWidget("CodeCat",.rqda$.CodeCatWidget,"codecat")
}
}
+CodeCatWidgetMenu$"Sort by created time"$handler <- function(h,...){
+ if (is_projOpen(env=.rqda,conName="qdacon")) {
+ UpdateCodeofCatWidget()
+}
+}
+##
+CodeofCatWidgetMenu <- list()
+CodeofCatWidgetMenu$"Sort by created time"$handler <- function(h,...){
+ if (is_projOpen(env=.rqda,conName="qdacon")) {
+ UpdateCodeofCatWidget()
+}
+}
Modified: pkg/R/CodesFun.R
===================================================================
--- pkg/R/CodesFun.R 2008-12-05 19:35:09 UTC (rev 35)
+++ pkg/R/CodesFun.R 2008-12-06 10:03:43 UTC (rev 36)
@@ -138,7 +138,7 @@
retrieval <- retrieval[order( retrieval$fid),]
fid <- unique(retrieval$fid)
retrieval$fname <-""
- .gw <- gwindow(title=sprintf("Retrieved text: %s",currentCode),parent=c(370,10),width=600,height=600)
+ .gw <- gwindow(title=sprintf("Retrieved text: %s",currentCode),parent=c(395,10),width=600,height=600)
.retreivalgui <- gtext(con=.gw)
for (i in fid){
FileName <- dbGetQuery(.rqda$qdacon,sprintf("select name from source where status==1 and id==%i",i))[['name']]
@@ -173,7 +173,7 @@
## use sql to order the fid
fid <- unique(retrieval$fid)
retrieval$fname <-""
- .gw <- gwindow(title=sprintf("Retrieved text: %s",currentCode),parent=c(370,10),width=600,height=600)
+ .gw <- gwindow(title=sprintf("Retrieved text: %s",currentCode),parent=c(395,10),width=600,height=600)
.retreivalgui <- gtext(con=.gw)
for (i in fid){
FileName <- dbGetQuery(.rqda$qdacon,sprintf("select name from source where status==1 and id==%i",i))[['name']]
@@ -187,7 +187,7 @@
ComputeCallbackFun <- function(BeginPosition,EndPosition,FileName){
CallBackFUN <- function(button){
tryCatch(dispose(.rqda$.root_edit),error=function(e) {})
- root <- gwindow(title=FileName, parent=c(370,40),width=580,height=300)
+ root <- gwindow(title=FileName, parent=c(395,40),width=580,height=300)
## use the same names as the of ViewFile, so can do coding when back to the original file.
assign(".root_edit",root,env=.rqda)
displayFile <- gtext(container=.rqda$.root_edit,font.attr=c(sizes="large"))
Modified: pkg/R/Coding_Buttons.R
===================================================================
--- pkg/R/Coding_Buttons.R 2008-12-05 19:35:09 UTC (rev 35)
+++ pkg/R/Coding_Buttons.R 2008-12-06 10:03:43 UTC (rev 36)
@@ -25,8 +25,11 @@
if (isTRUE(del)){
SelectedCode <- svalue(.rqda$.codes_rqda)
Encoding(SelectedCode) <- "UTF-8"
+ cid <- dbGetQuery(.rqda$qdacon,sprintf("select id from freecode where name=='%s'",SelectedCode))$id
dbGetQuery(.rqda$qdacon,sprintf("update freecode set status=0 where name=='%s'",SelectedCode))
## set status in table freecode to 0
+ dbGetQuery(.rqda$qdacon,sprintf("update coding set status=0 where cid==%i",cid))
+ ## set status in table coding to 0
CodeNamesUpdate()
}
}
@@ -174,8 +177,9 @@
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 coding set status=0 where rowid=%i", j)) }
+ dbGetQuery(con,sprintf("update coding set status=-1 where rowid=%i", j)) }
## better to get around the loop by sqlite condition expression.
+ ## status=-1 to differentiate the result of delete button
ClearMark(W,min=sel_index$startN,max=sel_index$endN)
## This clear all the marks in the gtext window,
## even for the non-current code. can improve.
@@ -190,38 +194,43 @@
CodeMemoButton <- function(label="C-Memo",...){
- gbutton(label, handler=function(h,...) {
- ## code memo: such as meaning of code etc.
- if (is_projOpen(env=.rqda,"qdacon")) {
- currentCode <- svalue(.rqda$.codes_rqda)
- if (length(currentCode)==0){
- gmessage("Select a code first.",icon="error",con=TRUE)
- }
- else {
- tryCatch(dispose(.rqda$.codememo),error=function(e) {})
- assign(".codememo",gwindow(title=paste("Code Memo",.rqda$currentCode,sep=":"),
- parent=c(370,10),width=600,height=400),env=.rqda)
- .codememo <- .rqda$.codememo
- .codememo2 <- gpanedgroup(horizontal = FALSE, con=.codememo)
- gbutton("Save Code Memo",con=.codememo2,handler=function(h,...){
- newcontent <- svalue(W)
- Encoding(newcontent) <- "UTF-8"
- newcontent <- enc(newcontent) ## take care of double quote.
- Encoding(currentCode) <- "UTF-8"
- dbGetQuery(.rqda$qdacon,sprintf("update freecode set memo='%s' where name='%s'",newcontent,currentCode))
- }
- )## end of save memo button
- assign(".cmemocontent",gtext(container=.codememo2,font.attr=c(sizes="large")),env=.rqda)
- prvcontent <- dbGetQuery(.rqda$qdacon, sprintf("select memo from freecode where name='%s'",currentCode))[1,1]
- if (is.na(prvcontent)) prvcontent <- ""
- Encoding(prvcontent) <- "UTF-8"
- W <- .rqda$.cmemocontent
- add(W,prvcontent,font.attr=c(sizes="large"),do.newline=FALSE)
- }
- }
+ gbutton(label, handler=function(h,...){
+ MemoWidget("code",.rqda$.codes_rqda,"freecode")
}
)
}
+## {
+## ## code memo: such as meaning of code etc.
+## if (is_projOpen(env=.rqda,"qdacon")) {
+## currentCode <- svalue(.rqda$.codes_rqda)
+## if (length(currentCode)==0){
+## gmessage("Select a code first.",icon="error",con=TRUE)
+## }
+## else {
+## tryCatch(dispose(.rqda$.codememo),error=function(e) {})
+## assign(".codememo",gwindow(title=paste("Code Memo",.rqda$currentCode,sep=":"),
+## parent=c(370,10),width=600,height=400),env=.rqda)
+## .codememo <- .rqda$.codememo
+## .codememo2 <- gpanedgroup(horizontal = FALSE, con=.codememo)
+## gbutton("Save Code Memo",con=.codememo2,handler=function(h,...){
+## newcontent <- svalue(W)
+## Encoding(newcontent) <- "UTF-8"
+## newcontent <- enc(newcontent) ## take care of double quote.
+## Encoding(currentCode) <- "UTF-8"
+## dbGetQuery(.rqda$qdacon,sprintf("update freecode set memo='%s' where name='%s'",newcontent,currentCode))
+## }
+## )## end of save memo button
+## assign(".cmemocontent",gtext(container=.codememo2,font.attr=c(sizes="large")),env=.rqda)
+## prvcontent <- dbGetQuery(.rqda$qdacon, sprintf("select memo from freecode where name='%s'",currentCode))[1,1]
+## if (is.na(prvcontent)) prvcontent <- ""
+## Encoding(prvcontent) <- "UTF-8"
+## W <- .rqda$.cmemocontent
+## add(W,prvcontent,font.attr=c(sizes="large"),do.newline=FALSE)
+## }
+## }
+## }
+## )
+## }
@@ -257,7 +266,7 @@
tryCatch(dispose(.rqda$.codingmemo),error=function(e) {})
## Close the coding memo first, then open a new one
assign(".codingmemo",gwindow(title=paste("Coding Memo for",SelectedCode,sep=":"),
- parent=c(370,10),width=600,height=400
+ parent=c(395,10),width=600,height=400
), env=.rqda
)
.codingmemo <- get(".codingmemo",env=.rqda)
@@ -311,3 +320,16 @@
)
}
+## popup-menu
+CodesNamesWidgetMenu <- list()
+CodesNamesWidgetMenu$"Code Memo"$handler <- function(h, ...) {
+ if (is_projOpen(env = .rqda, conName = "qdacon", message = FALSE)) {
+ MemoWidget("code",.rqda$.codes_rqda,"freecode")
+ }
+ }
+CodesNamesWidgetMenu$"Sort by created time"$handler <- function(h, ...) {
+ if (is_projOpen(env = .rqda, conName = "qdacon", message = FALSE)) {
+ CodeNamesUpdate()
+ }
+ }
+
Modified: pkg/R/FileButton.R
===================================================================
--- pkg/R/FileButton.R 2008-12-05 19:35:09 UTC (rev 35)
+++ pkg/R/FileButton.R 2008-12-06 10:03:43 UTC (rev 36)
@@ -25,8 +25,12 @@
con <- .rqda$qdacon
SelectedFile <- svalue(.rqda$.fnames_rqda)
Encoding(SelectedFile) <- "UTF-8"
+ fid <- dbGetQuery(.rqda$qdacon, sprintf("select id from source where name='%s'",SelectedFile))$id
dbGetQuery(.rqda$qdacon, sprintf("update source set status=0 where name='%s'",SelectedFile))
## set the status of the selected file to 0
+ dbGetQuery(.rqda$qdacon, sprintf("update caselinkage set status=0 where fid=%i",fid))
+ dbGetQuery(.rqda$qdacon, sprintf("update treefile set status=0 where fid=%i",fid))
+ ## set the status of the related case/f-cat to 0
FileNamesUpdate()
}
}
@@ -35,73 +39,87 @@
)
}
-ViewFileButton <- function(label="Open", container,...){
- gbutton(label,contain=container,h=function(h,...){
- if (is_projOpen(env=.rqda,conName="qdacon")) {
- if (length(svalue(.rqda$.fnames_rqda))==0){gmessage("Select a file first.",icon="error",con=TRUE)}
- else {
- tryCatch(dispose(.rqda$.root_edit),error=function(e) {})
- ## notice the error handler
- SelectedFileName <- svalue(.rqda$.fnames_rqda)
- assign(".root_edit",gwindow(title=SelectedFileName, parent=c(370,10),width=600,height=600),env=.rqda)
- .root_edit <- get(".root_edit",.rqda)
- assign(".openfile_gui",gtext(container=.root_edit,font.attr=c(sizes="large")),env=.rqda)
- Encoding(SelectedFileName) <- "unknown"
- content <- dbGetQuery(.rqda$qdacon, sprintf("select file from source where name='%s'",SelectedFileName))[1,1]
- Encoding(content) <- "UTF-8" ## so it display correct in the gtext widget
- ## turn data.frame to 1-length character.
- W <- get(".openfile_gui",.rqda)
- add(W,content,font.attr=c(sizes="large"))
- slot(W,"widget")@widget$SetEditable(FALSE)
- ## make sure it is read only file in the text window.
- }
- }
- }
+ViewFileButton <- function(label="Open", container,...)
+{
+ gbutton(label,contain=container,h=function(h,...)
+ {
+ ViewFileFun(FileNameWidget=.rqda$.fnames_rqda)
+ }
)
}
+## {
+## if (is_projOpen(env=.rqda,conName="qdacon")) {
+## if (length(svalue(.rqda$.fnames_rqda))==0){gmessage("Select a file first.",icon="error",con=TRUE)}
+## else {
+## tryCatch(dispose(.rqda$.root_edit),error=function(e) {})
+## ## notice the error handler
+## SelectedFileName <- svalue(.rqda$.fnames_rqda)
+## assign(".root_edit",gwindow(title=SelectedFileName, parent=c(370,10),width=600,height=600),env=.rqda)
+## .root_edit <- get(".root_edit",.rqda)
+## assign(".openfile_gui",gtext(container=.root_edit,font.attr=c(sizes="large")),env=.rqda)
+## Encoding(SelectedFileName) <- "unknown"
+## content<-dbGetQuery(.rqda$qdacon, sprintf("select file from source where name='%s'",SelectedFileName))[1,1]
+## Encoding(content) <- "UTF-8" ## so it display correct in the gtext widget
+## ## turn data.frame to 1-length character.
+## W <- get(".openfile_gui",.rqda)
+## add(W,content,font.attr=c(sizes="large"))
+## slot(W,"widget")@widget$SetEditable(FALSE)
+## ## make sure it is read only file in the text window.
+## }
+## }
+## }
+## )
+## }
File_MemoButton <- function(label="F-Memo", container=.rqda$.files_button,FileWidget=.rqda$.fnames_rqda,...){
## memo of selected file.
gbutton(label, contain=container, handler=function(h,...) {
if (is_projOpen(env=.rqda,"qdacon")) {
- ## if project is open, then continue
- selectedFN <- svalue(FileWidget) ## svalue(.fnames_rqda) is the name of selected file.
- if (length(selectedFN)==0){
- ## if no file is selected, then no need to memo.
- gmessage("Select a file first.",icon="error",con=TRUE)
- }
- else {
- tryCatch(dispose(.rqda$.filememo),error=function(e) {})
- ## Close the open file memo first, then open a new one
- ## .filememo is the container of .fmemocontent,widget for the content of memo
- assign(".filememo",gwindow(title=paste("File Memo",selectedFN,sep=":"),
- parent=c(370,10),width=600,height=400),env=.rqda)
- .filememo <- .rqda$.filememo
- .filememo2 <- gpanedgroup(horizontal = FALSE, con=.filememo)
- ## use .filememo2, so can add a save button to it.
- gbutton("Save memo",con=.filememo2,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 source set memo='%s' where name='%s'",newcontent,selectedFN))
- ## have to quote the character in the sql expression
- }
- )
- assign(".fmemocontent",gtext(container=.filememo2,font.attr=c(sizes="large")),env=.rqda)
- prvcontent <- dbGetQuery(.rqda$qdacon, sprintf("select memo from source where name='%s'",svalue(FileWidget)))[1,1]
- ## [1,1]turn data.frame to 1-length character. Existing content of memo
- if (is.na(prvcontent)) prvcontent <- ""
- Encoding(prvcontent) <- "UTF-8" ## important
- W <- .rqda$.fmemocontent
- add(W,prvcontent,font.attr=c(sizes="large"),do.newline=FALSE)
- ## push the previous content to the widget.
- }
+ MemoWidget("File",FileWidget,"source")
}
}
)
}
+
+## if (is_projOpen(env=.rqda,"qdacon")) {
+## ## if project is open, then continue
+## selectedFN <- svalue(FileWidget) ## svalue(.fnames_rqda) is the name of selected file.
+## if (length(selectedFN)==0){
+## ## if no file is selected, then no need to memo.
+## gmessage("Select a file first.",icon="error",con=TRUE)
+## }
+## else {
+## tryCatch(dispose(.rqda$.filememo),error=function(e) {})
+## ## Close the open file memo first, then open a new one
+## ## .filememo is the container of .fmemocontent,widget for the content of memo
+## assign(".filememo",gwindow(title=paste("File Memo",selectedFN,sep=":"),
+## parent=c(370,10),width=600,height=400),env=.rqda)
+## .filememo <- .rqda$.filememo
+## .filememo2 <- gpanedgroup(horizontal = FALSE, con=.filememo)
+## ## use .filememo2, so can add a save button to it.
+## gbutton("Save memo",con=.filememo2,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 source set memo='%s' where name='%s'",newcontent,selectedFN))
+## ## have to quote the character in the sql expression
+## }
+## )
+## assign(".fmemocontent",gtext(container=.filememo2,font.attr=c(sizes="large")),env=.rqda)
+## prvcontent <- dbGetQuery(.rqda$qdacon, sprintf("select memo from source where name='%s'",svalue(FileWidget)))[1,1]
+## ## [1,1]turn data.frame to 1-length character. Existing content of memo
+## if (is.na(prvcontent)) prvcontent <- ""
+## Encoding(prvcontent) <- "UTF-8" ## important
+## W <- .rqda$.fmemocontent
+## add(W,prvcontent,font.attr=c(sizes="large"),do.newline=FALSE)
+## ## push the previous content to the widget.
+## }
+## }
+## }
+## )
+## }
@@ -150,16 +168,20 @@
UpdateFileofCatWidget()
}
}
-
-FileNamesWidgetMenu$"Sorted by import time"$handler <- function(h, ...) {
+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
+}
+}
+FileNamesWidgetMenu$"Open Selected File"$handler <- function(h,...){
+ ViewFileFun(FileNameWidget=.rqda$.fnames_rqda)
+}
+FileNamesWidgetMenu$"Sort 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/FileCatButton.R
===================================================================
--- pkg/R/FileCatButton.R 2008-12-05 19:35:09 UTC (rev 35)
+++ pkg/R/FileCatButton.R 2008-12-06 10:03:43 UTC (rev 36)
@@ -172,3 +172,18 @@
## see CodeCatButton.R for definition of MemoWidget
}
}
+FileCatWidgetMenu$"Sort by created time"$handler <- function(h,...)
+{
+ if (is_projOpen(env=.rqda,conName="qdacon")) {
+ UpdateTableWidget(Widget=.rqda$.FileCatWidget,FromdbTable="filecat")
+ }
+}
+
+## popup menu for files of this category
+FileofCatWidgetMenu <- list()
+FileofCatWidgetMenu$"Sort by created time"$handler <- function(h,...)
+{
+ if (is_projOpen(env=.rqda,conName="qdacon")) {
+ UpdateFileofCatWidget()
+ }
+}
Modified: pkg/R/FilesFun.R
===================================================================
--- pkg/R/FilesFun.R 2008-12-05 19:35:09 UTC (rev 35)
+++ pkg/R/FilesFun.R 2008-12-06 10:03:43 UTC (rev 36)
@@ -70,18 +70,26 @@
})
SelectedFileName <- svalue(FileNameWidget)
assign(".root_edit", gwindow(title = SelectedFileName,
- parent = c(370, 10), width = 600, height = 600),
+ parent = c(395, 10), width = 600, height = 600),
env = .rqda)
.root_edit <- get(".root_edit", .rqda)
assign(".openfile_gui", gtext(container = .root_edit,
font.attr = c(sizes = "large")), env = .rqda)
Encoding(SelectedFileName) <- "unknown"
- content <- dbGetQuery(.rqda$qdacon, sprintf("select file from source where name='%s'",
- SelectedFileName))[1, 1]
+ IDandContent <- dbGetQuery(.rqda$qdacon, sprintf("select id, file from source where name='%s'",
+ SelectedFileName))
+ content <- IDandContent$file
Encoding(content) <- "UTF-8"
W <- get(".openfile_gui", .rqda)
add(W, content, font.attr = c(sizes = "large"))
slot(W, "widget")@widget$SetEditable(FALSE)
+ mark_index <-
+ dbGetQuery(.rqda$qdacon,sprintf("select selfirst,selend from coding where fid=%i and status=1",IDandContent$id))
+ if (nrow(mark_index)!=0){
+ ## make sense only when there is coding there
+ ClearMark(W ,0 , max(mark_index$selend))
+ HL(W,index=mark_index)
+ }
}
}
}
Modified: pkg/R/GUIHandler.R
===================================================================
--- pkg/R/GUIHandler.R 2008-12-05 19:35:09 UTC (rev 35)
+++ pkg/R/GUIHandler.R 2008-12-06 10:03:43 UTC (rev 36)
@@ -30,39 +30,40 @@
## )
-add3rdmousepopupmenu(.rqda$.fnames_rqda, FileNamesWidgetMenu)
-## right click to add file to a case category
+ add3rdmousepopupmenu(.rqda$.fnames_rqda, FileNamesWidgetMenu)
+ ## 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
+## {
+## if (is_projOpen(env=.rqda,conName="qdacon")) {
+## if (length(svalue(.rqda$.fnames_rqda))==0){gmessage("Select a file first.",icon="error",con=TRUE)}
+## else {
+## tryCatch(dispose(.rqda$.root_edit),error=function(e) {})
+## ## notice the error handler
+## SelectedFile <- svalue(.rqda$.fnames_rqda)
+## assign(".root_edit",gwindow(title=SelectedFile, parent=c(370,10),width=600,height=600),env=.rqda)
+## .root_edit <- get(".root_edit",.rqda)
+## assign(".openfile_gui",gtext(container=.root_edit,font.attr=c(sizes="large")),env=.rqda)
+## Encoding(SelectedFile) <- "unknown"
+## ## By default, SelectedFile is in UTF-8, if not set to unknown, under FreeBSD,
+## ## it will convert to the current encoding before the query
+## ## so it should be set to unknow in order to get the correct qunery result.
+## content <- dbGetQuery(.rqda$qdacon, sprintf("select file from source where name='%s'",SelectedFile))[1,1]
+## Encoding(content) <- "UTF-8" ## so it display correct in the gtext widget
+## ## turn data.frame to 1-length character.
+## W <- get(".openfile_gui",.rqda)
+## add(W,content,font.attr=c(sizes="large"))
+## slot(W,"widget")@widget$SetEditable(FALSE)
+## ## make sure it is read only file in the text window.
+## }
+## }
+## }##end of function copied from ViewFileButton handler
+## )
- addhandlerdoubleclick(.rqda$.fnames_rqda, handler <- function(h,...)
- ##function copied from ViewFileButton handler
- {
- if (is_projOpen(env=.rqda,conName="qdacon")) {
- if (length(svalue(.rqda$.fnames_rqda))==0){gmessage("Select a file first.",icon="error",con=TRUE)}
- else {
- tryCatch(dispose(.rqda$.root_edit),error=function(e) {})
- ## notice the error handler
- SelectedFile <- svalue(.rqda$.fnames_rqda)
- assign(".root_edit",gwindow(title=SelectedFile, parent=c(370,10),width=600,height=600),env=.rqda)
- .root_edit <- get(".root_edit",.rqda)
- assign(".openfile_gui",gtext(container=.root_edit,font.attr=c(sizes="large")),env=.rqda)
- Encoding(SelectedFile) <- "unknown"
- ## By default, SelectedFile is in UTF-8, if not set to unknown, under FreeBSD,
- ## it will convert to the current encoding before the query
- ## so it should be set to unknow in order to get the correct qunery result.
- content <- dbGetQuery(.rqda$qdacon, sprintf("select file from source where name='%s'",SelectedFile))[1,1]
- Encoding(content) <- "UTF-8" ## so it display correct in the gtext widget
- ## turn data.frame to 1-length character.
- W <- get(".openfile_gui",.rqda)
- add(W,content,font.attr=c(sizes="large"))
- slot(W,"widget")@widget$SetEditable(FALSE)
- ## make sure it is read only file in the text window.
- }
- }
- }##end of function copied from ViewFileButton handler
- )
-
## handler for .codes_rqda
## addHandlerMouseMotion(.rqda$.codes_rqda, handler <- function(h, ...) {
@@ -76,8 +77,8 @@
if (is_projOpen(env=.rqda,conName="qdacon")) retrieval()
}
)
+ add3rdmousepopupmenu(.rqda$.codes_rqda,CodesNamesWidgetMenu)
-
addHandlerClicked(.rqda$.codes_rqda,handler <- function(h,...){
if (is_projOpen(env=.rqda,conName="qdacon")){
## CodeNamesUpdate(CodeNamesWidget=.rqda$.codes_rqda)
@@ -118,7 +119,7 @@
addhandlerdoubleclick(.rqda$.CasesNamesWidget, handler=function(h,...) MemoWidget("Case",.rqda$.CasesNamesWidget,"cases"))
addHandlerClicked(.rqda$.CasesNamesWidget,handler <- function(h,...){
- CaseNamesUpdate(.rqda$.CasesNamesWidget)
+ ## CaseNamesUpdate(.rqda$.CasesNamesWidget)
con <- .rqda$qdacon
SelectedCase <- currentCase <- svalue(.rqda$.CasesNamesWidget)
if (length(SelectedCase)!=0) {
@@ -157,6 +158,8 @@
}
)
+ add3rdmousepopupmenu(.rqda$.CodeofCat,CodeofCatWidgetMenu)
+
addHandlerClicked(.rqda$.FileCatWidget,handler <- function(h,...){
UpdateFileofCatWidget(con=.rqda$qdacon,Widget=.rqda$.FileofCat)
})
@@ -168,6 +171,8 @@
addhandlerdoubleclick(.rqda$.FileofCat, handler <- function(h,...) ViewFileFun(FileNameWidget=.rqda$.FileofCat))
+add3rdmousepopupmenu(.rqda$.FileofCat,FileofCatWidgetMenu)
+
add3rdmousepopupmenu(.rqda$.CasesNamesWidget, CaseNamesWidgetMenu)
## popup menu by right-click on CaseNamesWidget
Modified: pkg/R/Setting.R
===================================================================
--- pkg/R/Setting.R 2008-12-05 19:35:09 UTC (rev 35)
+++ pkg/R/Setting.R 2008-12-06 10:03:43 UTC (rev 36)
@@ -19,6 +19,11 @@
type = "gedit",
text = .rqda$encoding
),
+ list(name = "BOM",
+ label = "BOM",
+ type = "gcombobox",
+ items = c(FALSE, TRUE)
+ ),
list(name = "fore.col",
label = "Color for Coding",
type = "gedit",
@@ -28,13 +33,7 @@
label = "Color for Case",
type = "gedit",
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/rqda -r 36
More information about the Rqda-commits
mailing list