[Rqda-commits] r27 - pkg pkg/R pkg/man www
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Dec 3 17:59:15 CET 2008
Author: wincent
Date: 2008-12-03 17:59:15 +0100 (Wed, 03 Dec 2008)
New Revision: 27
Modified:
pkg/ChangeLog
pkg/DESCRIPTION
pkg/R/CaseButton.R
pkg/R/CaseFun.R
pkg/R/CodesFun.R
pkg/R/Coding_Buttons.R
pkg/R/root_gui.R
pkg/R/sysdata.rda
pkg/R/zzz.R
pkg/TODO
pkg/man/RQDA-internal.rd
pkg/man/write.FileList.RD
www/ChangeLog.txt
Log:
Modified: pkg/ChangeLog
===================================================================
--- pkg/ChangeLog 2008-12-02 17:50:22 UTC (rev 26)
+++ pkg/ChangeLog 2008-12-03 16:59:15 UTC (rev 27)
@@ -1,3 +1,6 @@
+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").
+
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.
@@ -2,2 +5,3 @@
* new function of write.FileList() to import a batch of files.
+
Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION 2008-12-02 17:50:22 UTC (rev 26)
+++ pkg/DESCRIPTION 2008-12-03 16:59:15 UTC (rev 27)
@@ -1,7 +1,7 @@
Package: RQDA
Type: Package
Title: Qualitative Data Analysis
-Version: 0.1.5-26
+Version: 0.1.5-27
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-02 17:50:22 UTC (rev 26)
+++ pkg/R/CaseButton.R 2008-12-03 16:59:15 UTC (rev 27)
@@ -90,6 +90,40 @@
)
}
+
+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")
+ )
+}
+
+
AddWebSearchButton <- function(label="WebSearch",CaseNamesWidget=.rqda$.CasesNamesWidget){
gbutton(label,handler=function(h,...) {
if (is_projOpen(env=.rqda,conName="qdacon")) {
Modified: pkg/R/CaseFun.R
===================================================================
--- pkg/R/CaseFun.R 2008-12-02 17:50:22 UTC (rev 26)
+++ pkg/R/CaseFun.R 2008-12-03 16:59:15 UTC (rev 27)
@@ -33,39 +33,6 @@
}
-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)) ## 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")
- )
-}
-
-
-
AddFileToCaselinkage <- function(){
## filenames -> fid -> selfirst=0; selend=nchar(filesource)
filename <- svalue(.rqda$.fnames_rqda)
@@ -126,7 +93,7 @@
dbGetQuery(con,sprintf("select selfirst,selend from caselinkage where fid=%i and status==1",currentFid))
if (nrow(mark_index)!=0){
ClearMark(W ,0 , max(mark_index$selend))
- HL(W,index=mark_index)
+ HL(W,index=mark_index,fore.col=NULL,back.col=.rqda$back.col)
}
}
}
Modified: pkg/R/CodesFun.R
===================================================================
--- pkg/R/CodesFun.R 2008-12-02 17:50:22 UTC (rev 26)
+++ pkg/R/CodesFun.R 2008-12-03 16:59:15 UTC (rev 27)
@@ -31,7 +31,9 @@
}
-mark <- function(widget){
+mark <- function(widget,fore.col=.rqda$fore.col,back.col=NULL){
+ ## modified so can change fore.col and back.col easily
+ ## when col is NULL, it is skipped
index <- sindex(widget)
startI <- index$startI ## start and end iter
endI <- index$endI
@@ -41,8 +43,21 @@
endN <- index$endN
if (startN != endN){
buffer <- slot(widget,"widget")@widget$GetBuffer()
- buffer$createTag("red.foreground",foreground = "red")
- buffer$ApplyTagByName("red.foreground",startI,endI)
+ TagTable <- buffer$GetTagTable()
+ if (!is.null(fore.col)){
+ if (is.null(TagTable$Lookup("MarkForeGround"))) {
+ TagTable$Add(buffer$createTag("MarkForeGround",foreground = fore.col))
+ }
+ buffer$ApplyTagByName("MarkForeGround",startI,endI)
+ }
+ if (!is.null(back.col)){
+ if (is.null(TagTable$Lookup("MarkBackGround"))) {
+ TagTable$Add(buffer$createTag("MarkBackGround",background = back.col))
+ }
+ buffer$ApplyTagByName("MarkBackGround",startI,endI)
+ }
+ ## buffer$createTag("red.foreground",foreground = "red")
+ ## buffer$ApplyTagByName("red.foreground",startI,endI)
## buffer$createTag("red.background",list(foreground = "red")) ## better, it can mark space
## buffer$ApplyTagByName("red.background",startI,endI); ## change colors
}
@@ -50,32 +65,49 @@
return(list(start=startN,end=endN,text=selected))
}
-ClearMark <- function(widget,min=0, max){
+
+ClearMark <- function(widget,min=0, max, clear.fore.col=TRUE,clear.back.col=FALSE){
## max position of marked text.
tryCatch({
buffer <- slot(widget,"widget")@widget$GetBuffer()
startI <-gtkTextBufferGetIterAtOffset(buffer,min)$iter # translate number back to iter
endI <-gtkTextBufferGetIterAtOffset(buffer,max)$iter
- gtkTextBufferRemoveTagByName(buffer,"red.foreground",startI,endI)},
-# gtkTextBufferRemoveTagByName(buffer,"red.background",startI,endI)},
-
+ TagTable <- buffer$GetTagTable()
+ if (clear.fore.col && !is.null(TagTable$Lookup("MarkForeGround"))) gtkTextBufferRemoveTagByName(buffer,"MarkForeGround",startI,endI)
+ if (clear.back.col && !is.null(TagTable$Lookup("MarkBackGround"))) gtkTextBufferRemoveTagByName(buffer,"MarkBackGround",startI,endI)
+ },
error=function(e){})
}
-HL <- function(W,index){
+HL <- function(W,index,fore.col=.rqda$fore.col,back.col=NULL){
## W is the gtext widget of the text.
## highlight text chuck according to index
## index is a data frame, each row == one text chuck.
+ buffer <- slot(W,"widget")@widget$GetBuffer()
+ TagTable <- buffer$GetTagTable()
+ if (!is.null(fore.col)){
+ if (is.null(TagTable$Lookup("MarkForeGround"))) {
+ TagTable$Add(buffer$createTag("MarkForeGround",foreground = fore.col))
+ }
+ }
+ if (!is.null(back.col)){
+ if (is.null(TagTable$Lookup("MarkBackGround"))) {
+ TagTable$Add(buffer$createTag("MarkBackGround",background = back.col))
+ }
+ }
tryCatch(
apply(index,1, function(x){
- buffer <- slot(W,"widget")@widget$GetBuffer()
start <-gtkTextBufferGetIterAtOffset(buffer,x[1])$iter # translate number back to iter
end <-gtkTextBufferGetIterAtOffset(buffer,x[2])$iter
- buffer$createTag("red.foreground",foreground = "red")
- buffer$ApplyTagByName("red.foreground",start,end)}),
-# buffer$createTag("red.background",background = "red")
-# buffer$ApplyTagByName("red.background",start,end)}),
+ if (!is.null(fore.col)){
+ buffer$ApplyTagByName("MarkForeGround",start,end)
+ }
+ if (!is.null(back.col)){
+ buffer$ApplyTagByName("MarkBackGround",start,end)
+ }
+ }
+ ),
error=function(e){})
}
Modified: pkg/R/Coding_Buttons.R
===================================================================
--- pkg/R/Coding_Buttons.R 2008-12-02 17:50:22 UTC (rev 26)
+++ pkg/R/Coding_Buttons.R 2008-12-03 16:59:15 UTC (rev 27)
@@ -71,10 +71,10 @@
## if W is null, then there is no valid widget. No need to HL.
## Though W may be expired, but ClearMark and HL will take care of the issue.
mark_index <-
- dbGetQuery(con,sprintf("select selfirst,selend,status from coding where fid=%i",currentFid))
+ dbGetQuery(con,sprintf("select selfirst,selend,status from coding where fid=%i and status=1",currentFid))
## only select thoses with the open_file and not deleted (status=1).
ClearMark(W ,0 , max(mark_index$selend))
- HL(W,index=mark_index[mark_index$status==1,1:2])
+ HL(W,index=mark_index)
}
}
},
Modified: pkg/R/root_gui.R
===================================================================
--- pkg/R/root_gui.R 2008-12-02 17:50:22 UTC (rev 26)
+++ pkg/R/root_gui.R 2008-12-03 16:59:15 UTC (rev 27)
@@ -35,7 +35,7 @@
glabel(
"Author: <ronggui.huang at gmail.com>\n
License: New style BSD License\n
-Version: 0.1.5 rev 26\n",
+Version: 0.1.5 rev 27\n",
container=.proj_gui)
Modified: pkg/R/sysdata.rda
===================================================================
(Binary files differ)
Modified: pkg/R/zzz.R
===================================================================
--- pkg/R/zzz.R 2008-12-02 17:50:22 UTC (rev 26)
+++ pkg/R/zzz.R 2008-12-03 16:59:15 UTC (rev 27)
@@ -1,8 +1,4 @@
.First.lib <- function(...) {
- .rqda <- new.env()
- .rqda$owner <- "default"
- .rqda$BOM <- FALSE
- .rqda$encoding <- "unknown"
cat("\nUse 'RQDA()' to start the programe.\n",fill=TRUE)
if (interactive()) RQDA()
}
Modified: pkg/TODO
===================================================================
--- pkg/TODO 2008-12-02 17:50:22 UTC (rev 26)
+++ pkg/TODO 2008-12-03 16:59:15 UTC (rev 27)
@@ -8,7 +8,5 @@
inter-coder reliability
-change Highlight behavior of Case.
-
### less important
should add document on the table structure.
Modified: pkg/man/RQDA-internal.rd
===================================================================
--- pkg/man/RQDA-internal.rd 2008-12-02 17:50:22 UTC (rev 26)
+++ pkg/man/RQDA-internal.rd 2008-12-03 16:59:15 UTC (rev 27)
@@ -67,6 +67,10 @@
\alias{DeleteFileCatButton}
\alias{UpdateFileofCatWidget}
\alias{ViewFileFun}
+\alias{AddFileToCaselinkage}
+\alias{AddFileToCaseMenu}
+\alias{HL_Case}
+\alias{UpdateFileofCaseWidget}
%% add related alias functions here.
\title{Internal Functions}
Modified: pkg/man/write.FileList.RD
===================================================================
--- pkg/man/write.FileList.RD 2008-12-02 17:50:22 UTC (rev 26)
+++ pkg/man/write.FileList.RD 2008-12-03 16:59:15 UTC (rev 27)
@@ -16,9 +16,7 @@
\item{con}{ Don't change this argument.}
\item{\dots}{ \code{\dots} is not used.}
}
-\details{
-}
\value{
This function is used for the side-effects. No value is return.
}
Modified: www/ChangeLog.txt
===================================================================
--- www/ChangeLog.txt 2008-12-02 17:50:22 UTC (rev 26)
+++ www/ChangeLog.txt 2008-12-03 16:59:15 UTC (rev 27)
@@ -1,3 +1,6 @@
+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").
+
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.
@@ -2,2 +5,3 @@
* new function of write.FileList() to import a batch of files.
+
More information about the Rqda-commits
mailing list