[Rqda-commits] r7 - in pkg: . R inst man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Oct 31 11:02:47 CET 2008
Author: wincent
Date: 2008-10-31 11:02:47 +0100 (Fri, 31 Oct 2008)
New Revision: 7
Added:
pkg/R/helper_tools.R
pkg/inst/
pkg/inst/database_structure.txt
pkg/man/clear.rd
pkg/man/list.deleted.rd
Modified:
pkg/ChangeLog
pkg/DESCRIPTION
pkg/R/files.R
pkg/R/root_gui.R
pkg/R/sysdata.rda
pkg/TODO
pkg/man/RQDA-internal.rd
Log:
Modified: pkg/ChangeLog
===================================================================
--- pkg/ChangeLog 2008-05-17 08:59:19 UTC (rev 6)
+++ pkg/ChangeLog 2008-10-31 10:02:47 UTC (rev 7)
@@ -1,3 +1,11 @@
+2008-10-31
+ * Add functionality of delete selected code.
+ * Add helper functions to show the temp deleted file/code/coding
+ * Add helpter functions to delete file/code/coding for ever
+
+2008-10-29
+ * Add functionality of delete selected file.
+
2008-5-17
* Open coding text chunk is added.
* "Unmark" button works now.
@@ -4,7 +12,4 @@
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.
-
-
-
+ * Add RQDA-package.rd in /man.
\ No newline at end of file
Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION 2008-05-17 08:59:19 UTC (rev 6)
+++ pkg/DESCRIPTION 2008-10-31 10:02:47 UTC (rev 7)
@@ -1,7 +1,7 @@
Package: RQDA
Type: Package
Title: Qualitative data analysis
-Version: 0.1
+Version: 0.1.2
Date: 2008-05-11
Author: Huang Ronggui
Maintainer: Huang <ronggui.huang at gmail.com>
Modified: pkg/R/files.R
===================================================================
--- pkg/R/files.R 2008-05-17 08:59:19 UTC (rev 6)
+++ pkg/R/files.R 2008-10-31 10:02:47 UTC (rev 7)
@@ -1,18 +1,23 @@
-importfile <- function(path,pathEncoding="unknown",con="qdacon",assignenv=NULL,assigname="files_index", ...){
- ## import a file into a DBI connection _con_.
- readTXT <- function(path){
- ## read txt file into a one-length character vector.
- readChar(path,file.info(path)[,'size']+1000,TRUE)
- }
-
+importfile <- function(path,#pathEncoding="unknown",
+ encoding,con="qdacon",assignenv=NULL,assigname="files_index", ...){
+## import a file into a DBI connection _con_.
+# readTXT <- function(path){
+# ## read txt file into a one-length character vector.
+# if (.Platform$OS.type=="windows"){
+# readChar(path,file.info(path)[,'size']+1000,TRUE)
+# } else readChar(path,file.info(path)[,'size']+1000)
+# }
+#
enc <- function(x) gsub("'", "''", x)
## replace " with two '. to make insert smoothly.
- Encoding(path) <- pathEncoding
- Fname <- basename(path)
+ #Encoding(path) <- pathEncoding
+ Fname <- gsub("\\.[[:alpha:]]*$","",basename(path)) ## remove the suffix such as .txt
if ( Fname!="" ) {
- content <- readTXT(path)
+ content <- readLines(path,warn=FALSE,encoding=encoding)
+ content <- paste(content,collapse="\n")
+ #Encoding(content) <- contentEncoding
content <- enc(content)
maxid <- dbGetQuery(con,"select max(id) from source")[[1]]
nextid <- ifelse(is.na(maxid),0+1, maxid+1)
@@ -21,11 +26,13 @@
if (nextid==1) {
write <- TRUE
} else {
- ## browser()
allFnames <- RSQLite:::sqliteQuickColumn(con,"source","name")
if (!any(Fname==allFnames)) {
write <- TRUE
- }}
+ } else {
+ gmessage("A file withe the same name exists in the database!")
+ }
+ }
if (write ) {
dbGetQuery(con,sprintf("insert into source (name, file, id, status ) values ('%s', '%s',%i, %i)",
Fname,content, nextid, 1))
@@ -46,3 +53,9 @@
tryCatch(widget[] <- fnames[['name']],error=function(e){})
}
+setEncoding <- function(encoding="unknown"){
+# specify what encoding is used in the imported files.
+.rqda$encoding <- encoding
+}
+
+
Added: pkg/R/helper_tools.R
===================================================================
--- pkg/R/helper_tools.R (rev 0)
+++ pkg/R/helper_tools.R 2008-10-31 10:02:47 UTC (rev 7)
@@ -0,0 +1,34 @@
+list.deleted <- function(type=c("file","code","coding")){
+## list the deleted file/code/coding
+if (!isIdCurrent(.rqda$qdacon)) print("No project is open!") else {
+type <- match.arg(type)
+if (type=="file"){
+ans <- dbGetQuery(.rqda$qdacon, "select name from source where status=0")
+} else if (type=="code"){
+ans <- dbGetQuery(.rqda$qdacon, "select name from freecode where status=0")
+} else if (type=="coding") {
+ans <- dbGetQuery(.rqda$qdacon, "select seltext from coding where status=0")
+}
+}
+if (nrow(ans)==0) sprintf("No %s is deleted.",type) else ans
+}
+
+clear <- function(ask=FALSE,type=c("file","code","coding")){
+## delete all the "deleted" files/codes/codings (those with status==0)
+if (!isIdCurrent(.rqda$qdacon)) print("No project is open!") else {
+type <- match.arg(type)
+del <- list.deleted(type)
+ if (!is.data.frame(del)) print("Nothing to clear.") else {
+ if (ask) del <- select.list(del[,1],multiple=TRUE) else del <- del[,1]
+if (type=="file"){
+ans <- dbGetQuery(.rqda$qdacon, sprintf("delete from source where status=0 AND name in (%s)",
+ paste(paste("'",del,"'",sep=""),collapse=",")))
+} else if (type=="code"){
+ans <- dbGetQuery(.rqda$qdacon, sprintf("delete from freecode where status=0 AND name in (%s)",
+ paste(paste("'",del,"'",sep=""),collapse=",")))
+} else if (type=="coding") {
+ans <- dbGetQuery(.rqda$qdacon, sprintf("delete from coding where status=0 AND seltext in (%s)",
+ paste(paste("'",del,"'",sep=""),collapse=",")))
+}}
+}
+}
Modified: pkg/R/root_gui.R
===================================================================
--- pkg/R/root_gui.R 2008-05-17 08:59:19 UTC (rev 6)
+++ pkg/R/root_gui.R 2008-10-31 10:02:47 UTC (rev 7)
@@ -87,7 +87,8 @@
2. Update file list or Import files.\n
3. Update code list or Add codes.\n
4. Open a file and begin coding.\n
-Author: <ronggui.huang at gmail.com>\n",container=.proj_gui)
+Author: <ronggui.huang at gmail.com>\n
+This software is part of my PhD research.\n",container=.proj_gui)
@@ -102,7 +103,7 @@
path <- gfile(type="open",filter=list("text files" = list(mime.types = c("text/plain"))))
if (path!=""){
Encoding(path) <- "UTF-8"
- importfile(path,pathEncoding="UTF-8",con=h$action$env$qdacon,assignenv=h$action$env)
+ importfile(path,encoding=get("encoding",envir=h$action$env),con=h$action$env$qdacon,assignenv=h$action$env)
## updatefilelist()
## add codes here
}
@@ -149,9 +150,22 @@
)
-gbutton(" Delete ",contain=.files_button,handler=function(h,...){
-NI()
-}
+gbutton(" Delete ",contain=.files_button,handler=function(h,...)
+ {
+ if (is_projOpen(env=h$action$env,conName=h$action$conName) & length(svalue(.fnames_rqda))!=0) {
+ ## if the project open and a file is selected, then continue the action
+ del <- gconfirm("Really delete the file?",icon="question")
+ if (isTRUE(del)){
+ dbGetQuery(get(h$action$conName,h$action$env), sprintf("update source set status=0 where id=%s",h$action$env$currentFid))
+ ## set the status of the selected file to 0
+ assign("currentFid",integer(0),envir=h$action$env)
+ assign("currentFile",character(0),envir=h$action$env)
+ ## set "currentFid" and "currentFile" in .rqda to integer(0) and character(0)
+ fnamesupdate(assignenv=h$action$env)
+ ## reset files_index in .rqda by updatefilelist()
+ }
+ }
+ },action=list(env=.rqda,conName="qdacon")
)
@@ -190,6 +204,26 @@
}, action = list(env = .rqda, conName = "qdacon", assignfileName = "files_index",widget=.fnames_rqda))
+########################### GUI for FILES TREE
+###########################
+#".files_tree" <- gpanedgroup(container=.nb_rqdagui,horizontal=FALSE,label="Files Tree")
+#".files_tree_pg" <- gpanedgroup(cont=.files_tree,horizontal = FALSE)
+#ft_buttons <- glayout(con=.files_tree_pg)
+#ft_buttons[1,1] <- gbutton("ADD",handler=function(h,...){
+#item <- ginput("Enter Level 2 label! ", icon="info",parent=.files_tree)
+#Encoding(item) <- "UTF-8"
+#ft_gt1[] <- c(item,ft_gt1[][!is.na(ft_gt1[])])
+#})
+#ft_buttons[1,2] <- gbutton("Delete")
+#ft_buttons[1,3] <- gbutton("OK")
+#ft_buttons[1,4] <- gl <- glabel("")
+#ft_pg2 <- ggroup(cont=.files_tree_pg,horizontal = FALSE)
+#ft_gt1 <- gtable(data.frame("Level 2 Categories"="Categories",stringsAsFactors=FALSE),con=ft_pg2,multiple=FALSE,expand=TRUE)
+#ft_gt1[] <- NULL
+#ft_gt2 <- gtable(data.frame("Files in current Category"="Category",stringsAsFactors=FALSE),container=ft_pg2,expand=T)
+#ft_gt2[] <- NULL
+#ft_gt3 <- gtable(data.frame("Files List"="env$files_index$name",stringsAsFactors=FALSE),container=ft_pg2,multiple=TRUE,expand=T)
+#ft_gt3[] <- NULL
########################### GUI for CODES
###########################
@@ -205,22 +239,22 @@
.codes_button[1,1]<- gbutton("ADD",
handler=function(h,...) {
if (is_projOpen(env=h$action$env,conName=h$action$conName)) {
- add1<-gwindow("Add code",width=200,heigh=30,parent=c(270,10))
- add2<-ggroup(cont=add1)
- add3<-gedit(con=add2)
- add4<-gbutton("OK",con=add2,handler=function(h,...){
- codename <- svalue(add3)
- Encoding(codename) <- "UTF-8"
- ## browser()
- addcode(codename,conName=h$action$conName,assignenv=h$action$env,
+ ##add1<-gwindow("Add code",width=200,heigh=30,parent=c(270,10))
+ ##add2<-ggroup(cont=add1)
+ ##add3<-gedit(con=add2)
+ ##add4<-gbutton("OK",con=add2,handler=function(h,...){
+ ##codename <- svalue(add3)
+ codename <- ginput("Enter new code. ", icon="info")
+ codename <- iconv(codename,from="UTF-8")
+ addcode(codename,conName=h$action$conName,assignenv=h$action$env,
assigname=h$action$assignname)
codesupdate(conName = h$action$conName, assignenv = h$action$env,
assignfileName =h$action$assignfileName,
widget=get(h$action$widget)
)
- dispose(add2)
- },action=h$action # explicitly pass the action argument
- )## end of add4
+ ##dispose(add2)
+ ## },action=h$action # explicitly pass the action argument
+ ## )## end of add4
}},
action=list(env=.rqda,name="codename",conName="qdacon",assignname="codes_index",
assignfileName="codes_index",widget=".codes_rqda")
@@ -228,10 +262,25 @@
)
.codes_button[1,2]<- gbutton("Delete",
- handler=function(h,...) {
- NI()
- }
- )
+ handler=function(h,...)
+ {
+ if (is_projOpen(env=h$action$env,conName=h$action$conName) & length(svalue(.codes_rqda))!=0) {
+ ## if project is open and one code is selected,then continue
+ del <- gconfirm("Really delete the code?",icon="question")
+ if (isTRUE(del)){
+ dbGetQuery(get(h$action$conName,h$action$env), sprintf("update freecode set status=0 where id=%s",h$action$env$currentCid))
+ ## set status in table freecode to 0
+ dbGetQuery(get(h$action$conName,h$action$env), sprintf("update coding set status=0 where cid=%s",h$action$env$currentCid))
+ ## set status in table coding to 0, so when press "HL ALL", the text chunk associated with deleted code will be ignored.
+ assign("currentCid",integer(0),envir=h$action$env)
+ assign("currentCode",character(0),envir=h$action$env)
+ ## set "currentCid" and "currentCode" to integer(0) and character(0)
+ codesupdate(assignenv=h$action$env)
+ ## update "codes_index" in .rqda by codesupdate
+ }
+ }
+ },action=list(env=.rqda,conName="qdacon")
+ )
.codes_button[1,3]<- gbutton("HL ALL",
handler=function(h,...) {
@@ -260,7 +309,9 @@
if (is_projOpen(env=h$action$env,conName=h$action$conName)) {
con <- get(h$action$conName,h$action$env)
W <- get(h$action$widget,env=h$action$env) ## widget
- sel_index <- sindex(W)
+ sel_index <- tryCatch(sindex(W),error=function(e) {})
+ ## if the not file is open, unmark doesn't work.
+ if (!is.null(sel_index)) {
codings_index <- get(h$action$codings_index,h$action$env)
currentCid <- get("currentCid",h$action$env)
currentFid <- get("currentFid",h$action$env)
@@ -275,7 +326,7 @@
assign("codings_index",h$action$env)
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.
- }},
+ }}},
action=list(env=.rqda,conName="qdacon",widget=".openfile_gui",codings_index="codings_index")
)
@@ -381,7 +432,33 @@
)
)
+
+
+########################### GUI for CODES TREE
+###########################
+#".codes_tree" <- gpanedgroup(container=.nb_rqdagui,horizontal=FALSE,label="Codes Tree")
+#".codes_tree_pg" <- gpanedgroup(cont=.codes_tree,horizontal = FALSE)
+#ct_buttons <- glayout(con=.codes_tree_pg)
+#ct_buttons[1,1] <- gbutton("ADD",handler=function(h,...){
+#item <- ginput("Enter Level 2 label! ", icon="info",parent=.codes_tree)
+#Encoding(item) <- "UTF-8"
+#ct_gt1[] <- c(item,ct_gt1[][!is.na(ct_gt1[])])
+#})
+#ct_buttons[1,2] <- gbutton("Delete")
+#ct_buttons[1,3] <- gbutton("OK")
+#ct_buttons[1,4] <- gl <- glabel("")
+#ct_pg2 <- ggroup(cont=.codes_tree_pg,horizontal = FALSE)
+#ct_gt1 <- gtable(data.frame("Level 2 Categories"="Categories",stringsAsFactors=FALSE),con=ct_pg2,multiple=FALSE,expand=TRUE)
+#ct_gt1[] <- NULL
+#ct_gt2 <- gtable(data.frame("Codes in current Category"="Category",stringsAsFactors=FALSE),container=ct_pg2,expand=T)
+#ct_gt2[] <- NULL
+#ct_gt3 <- gtable(data.frame("Codes List"="env$files_index$name",stringsAsFactors=FALSE),container=ct_pg2,multiple=TRUE,expand=T)
+#ct_gt3[] <- NULL
+
+#########################
+#########################
visible(.root_rqdagui) <- TRUE
svalue(.nb_rqdagui) <- 1 ## make sure the project tab gain the focus.
### make it a function RQDA().
}
+
Modified: pkg/R/sysdata.rda
===================================================================
(Binary files differ)
Modified: pkg/TODO
===================================================================
--- pkg/TODO 2008-05-17 08:59:19 UTC (rev 6)
+++ pkg/TODO 2008-10-31 10:02:47 UTC (rev 7)
@@ -1,7 +1,11 @@
-#should add a warning when click "HL ALL" if no project is open.
+add functionality of memo.
+undo the temp deletion.
+
+summary functions for review of coding.
+
+should add document on the table structure.
+
tree-like structure of files/ codes.
-delete files/codes.
-
-summary functions for review of coding.
\ No newline at end of file
+Man file should be documented.
\ No newline at end of file
Added: pkg/inst/database_structure.txt
===================================================================
--- pkg/inst/database_structure.txt (rev 0)
+++ pkg/inst/database_structure.txt 2008-10-31 10:02:47 UTC (rev 7)
@@ -0,0 +1,4 @@
+table coding
+ linkage of code and text chuck.
+ When delete, set status=0
+
Modified: pkg/man/RQDA-internal.rd
===================================================================
--- pkg/man/RQDA-internal.rd 2008-05-17 08:59:19 UTC (rev 6)
+++ pkg/man/RQDA-internal.rd 2008-10-31 10:02:47 UTC (rev 7)
@@ -9,6 +9,7 @@
\alias{is_projOpen}
\alias{mark}
\alias{new_proj}
+\alias{setEncoding}
\alias{open_proj}
%%\alias{RQDA}
%% RQDA() appears in RQDA-package.rd
Added: pkg/man/clear.rd
===================================================================
--- pkg/man/clear.rd (rev 0)
+++ pkg/man/clear.rd 2008-10-31 10:02:47 UTC (rev 7)
@@ -0,0 +1,62 @@
+\name{clear}
+\alias{clear}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{ ~~function to do ... ~~ }
+\description{
+ ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+clear(ask = FALSE, type = c("file", "code", "coding"))
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{ask}{ ~~Describe \code{ask} here~~ }
+ \item{type}{ ~~Describe \code{type} here~~ }
+}
+\details{
+ ~~ If necessary, more details than the description above ~~
+}
+\value{
+ ~Describe the value returned
+ If it is a LIST, use
+ \item{comp1 }{Description of 'comp1'}
+ \item{comp2 }{Description of 'comp2'}
+ ...
+}
+\references{ ~put references to the literature/web site here ~ }
+\author{ ~~who you are~~ }
+\note{ ~~further notes~~
+
+ ~Make other sections like Warning with \section{Warning }{....} ~
+}
+\seealso{ ~~objects to See Also as \code{\link{help}}, ~~~ }
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function(ask=FALSE,type=c("file","code","coding")){
+## delete all the "deleted" files/codes/codings (those with status==0)
+if (!isIdCurrent(.rqda$qdacon)) print("No project is open!") else {
+type <- match.arg(type)
+del <- list.deleted(type)
+ if (!is.data.frame(del)) print("Nothing to clear.") else {
+ if (ask) del <- select.list(del[1,],multiple=TRUE) else del <- del[,1]
+if (type=="file"){
+ans <- dbGetQuery(.rqda$qdacon, sprintf("delete from source where status=0 AND name in (\%s)",
+ paste(paste("'",del,"'",sep=""),collapse=",")))
+ } else if (type=="code"){
+ans <- dbGetQuery(.rqda$qdacon, sprintf("delete from freecode where status=0 AND name in (\%s)",
+ paste(paste("'",del,"'",sep=""),collapse=",")))
+ } else if (type=="coding") {
+ans <- dbGetQuery(.rqda$qdacon, sprintf("delete from coding where status=0 AND seltext in (\%s)",
+ paste(paste("'",del,"'",sep=""),collapse=",")))
+ }}
+ }
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ utilities }
+
Added: pkg/man/list.deleted.rd
===================================================================
--- pkg/man/list.deleted.rd (rev 0)
+++ pkg/man/list.deleted.rd 2008-10-31 10:02:47 UTC (rev 7)
@@ -0,0 +1,56 @@
+\name{list.deleted}
+\alias{list.deleted}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{ ~~function to do ... ~~ }
+\description{
+ ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+list.deleted(type = c("file", "code", "coding"))
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{type}{ ~~Describe \code{type} here~~ }
+}
+\details{
+ ~~ If necessary, more details than the description above ~~
+}
+\value{
+ ~Describe the value returned
+ If it is a LIST, use
+ \item{comp1 }{Description of 'comp1'}
+ \item{comp2 }{Description of 'comp2'}
+ ...
+}
+\references{ ~put references to the literature/web site here ~ }
+\author{ ~~who you are~~ }
+\note{ ~~further notes~~
+
+ ~Make other sections like Warning with \section{Warning }{....} ~
+}
+\seealso{ ~~objects to See Also as \code{\link{help}}, ~~~ }
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function(type=c("file","code","coding")){
+## list the deleted file/code/coding
+if (!isIdCurrent(.rqda$qdacon)) print("No project is open!") else {
+type <- match.arg(type)
+if (type=="file"){
+ans <- dbGetQuery(.rqda$qdacon, "select name from source where status=0")
+ } else if (type=="code"){
+ans <- dbGetQuery(.rqda$qdacon, "select name from freecode where status=0")
+ } else if (type=="coding") {
+ans <- dbGetQuery(.rqda$qdacon, "select seltext from coding where status=0")
+ }
+ }
+if (nrow(ans)==0) sprintf("No \%s is deleted.",type) else ans
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ utilities }
+
More information about the Rqda-commits
mailing list