[Rqda-commits] r11 - pkg pkg/R pkg/man www
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sat Nov 1 11:08:37 CET 2008
Author: wincent
Date: 2008-11-01 11:08:36 +0100 (Sat, 01 Nov 2008)
New Revision: 11
Added:
pkg/R/deletion.R
Removed:
pkg/R/helper_tools.R
pkg/man/clear.rd
Modified:
pkg/ChangeLog
pkg/DESCRIPTION
pkg/R/codes.R
pkg/R/files.R
pkg/R/project.R
pkg/R/root_gui.R
pkg/R/zzz.R
pkg/TODO
pkg/man/RQDA-internal.rd
pkg/man/RQDA-package.Rd
pkg/man/list.deleted.rd
www/index.html
Log:
Modified: pkg/ChangeLog
===================================================================
--- pkg/ChangeLog 2008-11-01 08:26:04 UTC (rev 10)
+++ pkg/ChangeLog 2008-11-01 10:08:36 UTC (rev 11)
@@ -1,7 +1,14 @@
+2008-11-01
+ * 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 helpter functions to delete file/code/coding for ever
+ * 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.
@@ -12,4 +19,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.
\ No newline at end of file
+ * Add RQDA-package.rd in /man.
Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION 2008-11-01 08:26:04 UTC (rev 10)
+++ pkg/DESCRIPTION 2008-11-01 10:08:36 UTC (rev 11)
@@ -1,8 +1,8 @@
Package: RQDA
Type: Package
Title: Qualitative data analysis
-Version: 0.1.2
-Date: 2008-05-11
+Version: 0.1.3
+Date: 2008-11-01
Author: Huang Ronggui
Maintainer: Huang <ronggui.huang at gmail.com>
Depends: DBI, RSQLite, RGtk2, gWidgets, gWidgetsRGtk2
Modified: pkg/R/codes.R
===================================================================
--- pkg/R/codes.R 2008-11-01 08:26:04 UTC (rev 10)
+++ pkg/R/codes.R 2008-11-01 10:08:36 UTC (rev 11)
@@ -1,36 +1,38 @@
addcode <- function(name,conName="qdacon",assignenv=.rqda,assigname="codes_index",...) {
-if (name != ""){
- con <- get(conName,assignenv)
- maxid <- dbGetQuery(con,"select max(id) from freecode")[[1]]
- nextid <- ifelse(is.na(maxid),0+1, maxid+1)
+ if (name != ""){
+ con <- get(conName,assignenv)
+ maxid <- dbGetQuery(con,"select max(id) from freecode")[[1]]
+ nextid <- ifelse(is.na(maxid),0+1, maxid+1)
write <- FALSE
- if (nextid==1){
- write <- TRUE
- } else {
- allnames <- RSQLite:::sqliteQuickColumn(con,"freecode","name")
+ if (nextid==1){
+ write <- TRUE
+ } else {
+ allnames <- RSQLite:::sqliteQuickColumn(con,"freecode","name")
if (!any(name==allnames)) {
- write <- TRUE
+ write <- TRUE
+ }
}
+ if (write ) {
+ dbGetQuery(con,sprintf("insert into freecode (name, id, status) values ('%s', %i, %i)",name,nextid, 1))
+ }
+ assign(assigname, dbGetQuery(con,"select name,id from freecode"),env=assignenv)
}
-if (write ) {
- dbGetQuery(con,sprintf("insert into freecode (name, id, status) values ('%s', %i, %i)",name,nextid, 1))
}
- assign(assigname, dbGetQuery(con,"select name,id from freecode"),env=assignenv)
- }
-}
+
codesupdate <- function(conName="qdacon",assignenv=.rqda,
- assignfileName="codes_index",
- widget,...){
- ## the widget should be get(".codes_rqda",env=.rqda)
- con <- get(conName,assignenv)
- codesName <- dbGetQuery(con, "select name, id from freecode where status=1")
- assign(assignfileName, codesName ,env=assignenv)
- tryCatch(widget[] <- codesName[['name']],error=function(e){})
+ assignfileName="codes_index",
+ widget,...){
+ ## the widget should be get(".codes_rqda",env=.rqda)
+ con <- get(conName,assignenv)
+ codesName <- dbGetQuery(con, "select name, id from freecode where status=1")
+ assign(assignfileName, codesName ,env=assignenv)
+ tryCatch(widget[] <- codesName[['name']],error=function(e){})
}
+
mark <- function(widget){
index <- sindex(widget)
startI <- index$startI ## start and end iter
@@ -39,39 +41,43 @@
startN <- index$startN # translate iter pointer to number
endN <- index$endN
if (startN != endN){
- buffer <- slot(widget,"widget")@widget$GetBuffer()
- buffer$createTag("red.foreground",foreground = "red");
- buffer$ApplyTagByName("red.foreground",startI,endI); ## change colors
- } ##only when selected text chunk is not "", apply the color scheme.
+ buffer <- slot(widget,"widget")@widget$GetBuffer()
+ buffer$createTag("red.foreground",foreground = "red");
+ buffer$ApplyTagByName("red.foreground",startI,endI); ## change colors
+ }
+ ## only when selected text chunk is not "", apply the color scheme.
return(list(start=startN,end=endN,text=selected))
}
+
+
ClearMark <- function(widget,min=0, max){
-## 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)},
- error=function(e){})
+ ## 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)},
+ error=function(e){})
}
HL <- function(W,index){
-## W is the gtext widget of the text.
-## highlight text chuck according to index
-## index is a data frame, each row == one text chuck.
-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)}),
-error=function(e){})
+ ## W is the gtext widget of the text.
+ ## highlight text chuck according to index
+ ## index is a data frame, each row == one text chuck.
+ 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)}),
+ error=function(e){})
}
+
sindex <- function(widget){
buffer <- slot(widget,"widget")@widget$GetBuffer()
bounds = buffer$GetSelectionBounds()
@@ -81,9 +87,11 @@
startN <- gtkTextIterGetOffset(startI) # translate iter pointer to number
endN <- gtkTextIterGetOffset(endI)
return(list(startI=startI,endI=endI,
- startN=startN,endN=endN,seltext=selected))
+ startN=startN,endN=endN,seltext=selected))
}
+
+
retrieval <- function(currentCid,conName,env,currentCode="currentCode",assignenv=.rqda){
currentCid <- get(currentCid,env)
currentCode <- get(currentCode,env)
Added: pkg/R/deletion.R
===================================================================
--- pkg/R/deletion.R (rev 0)
+++ pkg/R/deletion.R 2008-11-01 10:08:36 UTC (rev 11)
@@ -0,0 +1,92 @@
+list.deleted <- function(type=c("file","code","coding")){
+ ## list the tmp 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
+}
+
+
+
+pdelete <- function(type=c("file","code","coding"),ask=FALSE){
+ ## permanantly 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=",")))
+ }
+ }
+ }
+}
+
+
+
+
+undelete <- function(type=c("file","code")){
+ ## undelete all the "deleted" files/codes (set the status back to 1)
+ 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 {
+ del <- select.list(del[,1],multiple=TRUE)
+ if (del != "") {
+ ## if del is "", then the user click cancel, no need to proceed.
+ if (type=="file"){
+ ans <- dbGetQuery(.rqda$qdacon, sprintf("update source set status=1 where status=0 AND name in (%s)",
+ paste(paste("'",del,"'",sep=""),collapse=",")))
+ assign("currentFid",integer(0),envir=.rqda)
+ assign("currentFile",character(0),envir=.rqda)
+ fnamesupdate(assignenv=.rqda)
+ ## update "currentFid" "currentFile" "files_index"
+ } else if (type=="code"){
+ ans <- dbGetQuery(.rqda$qdacon, sprintf("update freecode set status=1 where status=0 AND name in (%s)",
+ paste(paste("'",del,"'",sep=""),collapse=",")))
+ assign("currentCid",integer(0),envir=.rqda)
+ assign("currentCode",character(0),envir=.rqda)
+ codesupdate(assignenv=.rqda)
+ ## update "codes_index" "currentCid" "currentCode"
+ }
+ ## else if (type=="coding") {
+ ## ans <- dbGetQuery(.rqda$qdacon, sprintf("update coding set status=1 where status=0 AND seltext in (%s)",
+ ## paste(paste("'",del,"'",sep=""),collapse=",")))
+ ## should update some info?
+ ## may be should pay more attention to this function
+ ##}
+ }
+ }
+ }
+}
+
+
+
Modified: pkg/R/files.R
===================================================================
--- pkg/R/files.R 2008-11-01 08:26:04 UTC (rev 10)
+++ pkg/R/files.R 2008-11-01 10:08:36 UTC (rev 11)
@@ -1,42 +1,38 @@
-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 <- gsub("\\.[[:alpha:]]*$","",basename(path)) ## remove the suffix such as .txt
-
+importfile <- function(path,encoding=.rqda$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)
+ # }
+ #
+ Fname <- gsub("\\.[[:alpha:]]*$","",basename(path))
+ ## remove the suffix such as .txt
if ( Fname!="" ) {
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)
write <- FALSE
- ## if the content should be written into con.
+ ## check if the content should be written into con.
if (nextid==1) {
write <- TRUE
+ ## if this is the first file, no need to worry about the duplication issue.
} else {
allFnames <- RSQLite:::sqliteQuickColumn(con,"source","name")
if (!any(Fname==allFnames)) {
+ ## no duplication file exists, then write.
write <- TRUE
} else {
- gmessage("A file withe the same name exists in the database!")
- }
+ 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))
- }
+ }
+ if (write ) {
+ dbGetQuery(con,sprintf("insert into source (name, file, id, status ) values ('%s', '%s',%i, %i)",
+ Fname,content, nextid, 1))
+ }
if (!is.null(assignenv)) {
assign(assigname, dbGetQuery(con,"select name,id from source"), env=assignenv)
}
@@ -44,18 +40,24 @@
}
+
fnamesupdate <- function(conName="qdacon",assignenv=.rqda,assignfileName="files_index",widget=".fnames_rqda",...){
- ##update file names list.
- ## should have widget argument, or the ".fnames_rqda" cannot be found.
- con <- get(conName,assignenv)
- fnames <- dbGetQuery(con, "select name, id from source where status=1")
- assign(assignfileName, fnames ,env=assignenv)
- tryCatch(widget[] <- fnames[['name']],error=function(e){})
+ ##update file names list.
+ ## should have widget argument, or the ".fnames_rqda" cannot be found.
+ wopt <- options(warn=-2)
+ on.exit(options(wopt))
+ con <- get(conName,assignenv)
+ fnames <- dbGetQuery(con, "select name, id from source where status=1")
+ assign(assignfileName, fnames ,env=assignenv)
+ tryCatch(widget[] <- fnames[['name']],error=function(e){})
}
+
+
setEncoding <- function(encoding="unknown"){
-# specify what encoding is used in the imported files.
-.rqda$encoding <- encoding
+ ## specify what encoding is used in the imported files.
+ .rqda$encoding <- encoding
}
-
+enc <- function(x) gsub("'", "''", x)
+## replace " with two '. to make insert smoothly.
Deleted: pkg/R/helper_tools.R
===================================================================
--- pkg/R/helper_tools.R 2008-11-01 08:26:04 UTC (rev 10)
+++ pkg/R/helper_tools.R 2008-11-01 10:08:36 UTC (rev 11)
@@ -1,34 +0,0 @@
-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/project.R
===================================================================
--- pkg/R/project.R 2008-11-01 08:26:04 UTC (rev 10)
+++ pkg/R/project.R 2008-11-01 10:08:36 UTC (rev 11)
@@ -1,42 +1,62 @@
new_proj <- function(path, conName="qdacon",assignenv=.rqda,...){
- sucess <- file.create(tmpNamme <- tempfile(pattern = "file", tmpdir = dirname(path)))
+ sucess <- file.create(tmpNamme <- tempfile(pattern = "file", tmpdir = dirname(path)))
if (!sucess) {
- gmessage("No write permission.",icon="error",container=TRUE)
- }
- else{
+ gmessage("No write permission.",icon="error",container=TRUE)
+ }
+ else{
unlink(tmpNamme)
- path <- paste(gsub("\\.rqda$","",path),"rqda",sep=".") # deal with the ".rqda"
+ path <- paste(gsub("\\.rqda$","",path),"rqda",sep=".") ## deal with the ".rqda"
override <- FALSE
if (fexist <- file.exists(path)) override <- gconfirm("Over write existing project?",icon="warning")
if (!fexist | override ){
- ## close con in assignmenv first.
+ ## close con in assignmenv first.
tryCatch(close_proj(conName=conName,assignenv=assignenv),error=function(e){})
assign(conName,dbConnect(drv=dbDriver("SQLite"),dbname=path),envir=assignenv)
con <- get(conName,assignenv)
if (dbExistsTable(con,"source")) dbRemoveTable(con, "source")
- dbGetQuery(con,"create table source (name text, id integer, file text, memo text, status integer)")
+ ## interview record
+ dbGetQuery(con,"create table source (name text, id integer,
+ file text, memo text,
+ owner text, date text, status integer)")
if (dbExistsTable(con,"freecode")) dbRemoveTable(con, "freecode")
- dbGetQuery(con,"create table freecode (name text, memo text, id integer, status integer)")
+ ## list of codes
+ dbGetQuery(con,"create table freecode (name text, memo text,
+ owner text,date text,
+ id integer, status integer)")
if (dbExistsTable(con,"treecode")) dbRemoveTable(con, "treecode")
- dbGetQuery(con,"create table treecode (cid integer, catid integer)")
+ ## tree-like strcuture of code (relationship between code and code-category[codecat])
+ dbGetQuery(con,"create table treecode (cid integer, catid integer
+ owner text, date text,
+ memo text, status integer)")
if (dbExistsTable(con,"treefile")) dbRemoveTable(con, "treefile")
- dbGetQuery(con,"create table treefile (fid integer, catid integer)")
- if (dbExistsTable(con,"fcat")) dbRemoveTable(con, "fcat")
- dbGetQuery(con,"create table fcat (fid integer, catid integer)")
- if (dbExistsTable(con,"ccat")) dbRemoveTable(con, "ccat")
- dbGetQuery(con,"create table ccat (cid integer, catid integer)")
+ ## tree-like structure of interview record (relationship between file and file category [filecat])
+ dbGetQuery(con,"create table treefile (fid integer, catid integer
+ owner text, date text,
+ memo text, status integer)")
+ if (dbExistsTable(con,"filecat")) dbRemoveTable(con, "filecat")
+ ## file category
+ dbGetQuery(con,"create table filecat (fid integer, catid integer, owner text,
+ date text, memo text, status integer)")
+ if (dbExistsTable(con,"codecat")) dbRemoveTable(con, "codecat")
+ ## code category
+ dbGetQuery(con,"create table codecat (cid integer, catid integer, owner text, date text,
+ memo text, status integer)")
if (dbExistsTable(con,"coding")) dbRemoveTable(con, "coding")
- dbGetQuery(con,"create table coding (cid integer, fid integer,seltext text, selfirst real, selend real, status integer)")
+ ## coding: code and its coded text chunks
+ dbGetQuery(con,"create table coding (cid integer, fid integer,seltext text,
+ selfirst real, selend real, status integer,
+ owner text, date text, memo text)")
}
}
}
+
open_proj <- function(path,conName="qdacon",assignenv=.rqda,...){
tryCatch({ con <- get(conName,assignenv)
- if (isIdCurrent(con)) dbDisconnect(con)
- },
- error=function(e){})
+ if (isIdCurrent(con)) dbDisconnect(con)
+ },
+ error=function(e){})
## Fist close the con if it exist, then open a new con.
assign(conName, dbConnect(drv=dbDriver("SQLite"),dbname=path),envi=assignenv)
}
@@ -45,20 +65,24 @@
close_proj <- function(conName="qdacon",assignenv=.rqda,...){
tryCatch({
- con <- get(conName,assignenv)
- if (isIdCurrent(con)) {
- if (!dbDisconnect(con)) gmessage("Closing project failed.",icon="waring",con=TRUE)
- }
+ con <- get(conName,assignenv)
+ if (isIdCurrent(con)) {
+ if (!dbDisconnect(con)) {
+ gmessage("Closing project failed.",icon="waring",con=TRUE)
+ }
+ }
} ,error=function(e){})
}
+
+
is_projOpen <- function(env=.rqda,conName="qdacon",message=TRUE){
-## test if any project is open.
- open <- FALSE
- tryCatch({
- con <- get(conName,env)
- open <- open + isIdCurrent(con)
+ ## test if any project is open.
+ open <- FALSE
+ tryCatch({
+ con <- get(conName,env)
+ open <- open + isIdCurrent(con)
} ,error=function(e){})
-if (!open & message) gmessage("No Project is Open.",icon="warning",con=TRUE)
-return(open)
+ if (!open & message) gmessage("No Project is Open.",icon="warning",con=TRUE)
+ return(open)
}
Modified: pkg/R/root_gui.R
===================================================================
--- pkg/R/root_gui.R 2008-11-01 08:26:04 UTC (rev 10)
+++ pkg/R/root_gui.R 2008-11-01 10:08:36 UTC (rev 11)
@@ -1,464 +1,554 @@
RQDA <- function() {
########################### aux functions
###########################
-NI <- function(...){
-gmessage("Not Implemented Yet.",con=TRUE)
-}
+ NI <- function(...){
+ gmessage("Not Implemented Yet.",con=TRUE)
+ }
+
+
########################### GUI FOR ROOT
###########################
-".root_rqdagui" <- gwindow(title = "RQDA: Qualitative Data Analysis.",parent=c(10,10),
- width=250,height=600,visible=FALSE,handler=function(h,...){
- tryCatch(dispose(.rqda$.root_edit),error=function(e){})
- close_proj(assignenv=h$action$env)
-},
- action=list(env=.rqda)
- )
+ ".root_rqdagui" <- gwindow(title = "RQDA: Qualitative Data Analysis.",parent=c(10,10),
+ width=250,height=600,visible=FALSE,handler=function(h,...){
+ tryCatch(dispose(.rqda$.root_edit),error=function(e){})
+ close_proj(assignenv=h$action$env)
+ },
+ action=list(env=.rqda)
+ )
-addHandlerUnrealize(.root_rqdagui, handler = function(h,...) {
- ## make sure is the project should be closed by issuing a confirm window.
- val <- gconfirm("Really EXIST?\n\nYou can use RQDA() to start this program again.", parent=h$obj)
- if(as.logical(val))
- return(FALSE) # destroy
- else
+
+ addHandlerUnrealize(.root_rqdagui, handler = function(h,...) {
+ ## make sure is the project should be closed by issuing a confirm window.
+ val <- gconfirm("Really EXIST?\n\nYou can use RQDA() to start this program again.", parent=h$obj)
+ if(as.logical(val))
+ return(FALSE) # destroy
+ else
return(TRUE) # don't destroy
-}
- )
+ }
+ )
-".nb_rqdagui" <- gnotebook(3,container=.root_rqdagui,closebuttons=FALSE)
-
-##addhandlermousemotion(.root_rqdagui,handler=function(h,...){
-### no longer needed, generated the metadata and store it as sysdata.rda in R subdirectroy.
-## check if the meta data has been deleted.
-##if (!exists(".rqda",.GlobalEnv))
-##gmessage("Meta data has been deleted.\nRun rqdameta() manually in order to work properly.",icon="error",cont=)
-## if (gconfirm("Meta data has been deleted, generate it gain?",con=TRUE)) {
-## rqdameta()
-## dispose(.root_rqdagui)
-##RQDA()
-##}
-##})
-
+
+ ".nb_rqdagui" <- gnotebook(3,container=.root_rqdagui,closebuttons=FALSE)
+
+
+
########################### GUI FOR PROJECT
###########################
-".proj_gui" <- ggroup(container=.nb_rqdagui,horizontal=FALSE,label="Project")
-".newproj_gui" <- gbutton("New Project",container=.proj_gui,handler=function(h,...){
- path=gfile(type="save")
- if (path!=""){
- ## if path="", then click "cancel".
- Encoding(path) <- "UTF-8"
- new_proj(path,assignenv=h$action$env)}
+ ".proj_gui" <- ggroup(container=.nb_rqdagui,horizontal=FALSE,label="Project")
+ ".newproj_gui" <- gbutton("New Project",container=.proj_gui,handler=function(h,...){
+ path=gfile(type="save")
+ if (path!=""){
+ ## if path="", then click "cancel".
+ Encoding(path) <- "UTF-8"
+ new_proj(path,assignenv=h$action$env)}
},
- action=list(env=.rqda)
- )
-
-
-".open.proj_gui" <- gbutton("Open Project",container=.proj_gui,handler=function(h,...){
- path <- gfile(type="open",filter=list("rqda"=list(patterns = c("*.rqda"))))
- if (path!=""){
- Encoding(path) <- "UTF-8"
- open_proj(path,assignenv=h$action$env)
- }
-},
action=list(env=.rqda)
)
+
+
+ ".open.proj_gui" <- gbutton("Open Project",container=.proj_gui,handler=function(h,...){
+ path <- gfile(type="open",filter=list("rqda"=list(patterns = c("*.rqda"))))
+ if (path!=""){
+ Encoding(path) <- "UTF-8"
+ open_proj(path,assignenv=h$action$env)
+ }
+ },
+ action=list(env=.rqda)
+ )
+
+
+ ".close.proj_gui" <- gbutton("Close Project",container=.proj_gui,handler=function(h,...){
+ status <- close_proj(assignenv=h$action$env)
+ },
+ action=list(env=.rqda)
+ )
-
-".close.proj_gui" <- gbutton("Close Project",container=.proj_gui,handler=function(h,...){
- close_proj(assignenv=h$action$env)
-},
- action=list(env=.rqda)
- )
-
-".projinfo_gui" <- gbutton("Current Project",container=.proj_gui,handler=function(h,...){
+
+ ".projinfo_gui" <- gbutton("Current Project",container=.proj_gui,handler=function(h,...){
if (is_projOpen(env=h$action$env,conName=h$action$conName)) {
- con <- get(h$action$conName,h$action$env)
- dbname <- dbGetInfo(.rqda$qdacon)$dbname
- ##substr(dbname, nchar(dbname)-15,nchar(dbname))
- gmessage(dbname,title="Info about current project.",con=TRUE)
+ con <- get(h$action$conName,h$action$env)
+ dbname <- dbGetInfo(.rqda$qdacon)$dbname
+ ##substr(dbname, nchar(dbname)-15,nchar(dbname))
+ gmessage(dbname,title="Info about current project.",con=TRUE)
}
},
- action=list(env=.rqda,conName="qdacon")
- )
+ action=list(env=.rqda,conName="qdacon")
+ )
-glabel("Basic Usage of RQDA:\n
+ glabel("Basic Usage of RQDA:\n
1. New Project or Open project.\n
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
-This software is part of my PhD research.\n",container=.proj_gui)
+This software is part of my PhD research.\n",
+ container=.proj_gui)
########################### GUI for FILES
###########################
+ ".files_pan" <- gpanedgroup(container=.nb_rqdagui,horizontal=FALSE,label="Files")
+ ".files_button" <- ggroup(container=.files_pan,horizontal=TRUE)
-".files_pan" <- gpanedgroup(container=.nb_rqdagui,horizontal=FALSE,label="Files")
-".files_button" <- ggroup(container=.files_pan,horizontal=TRUE)
+
+ .importfilebutton <-gbutton("Import",container=.files_button,handler=function(h,...){
+ if (is_projOpen(env=h$action$env,conName=h$action$conName)) {
+ path <- gfile(type="open",filter=list("text files" = list(mime.types = c("text/plain"))))
+ if (path!=""){
+ Encoding(path) <- "UTF-8"
+ importfile(path,encoding=get("encoding",envir=h$action$env),con=h$action$env$qdacon,assignenv=h$action$env)
+ ## updatefilelist()
+ }
+ }
+ },
+ action=list(env=.rqda,conName="qdacon"))
-.importfilebutton <-gbutton("Import",container=.files_button,handler=function(h,...){
+
+
+ gbutton(" View ",contain=.files_button,handler=function(h,...){
if (is_projOpen(env=h$action$env,conName=h$action$conName)) {
- path <- gfile(type="open",filter=list("text files" = list(mime.types = c("text/plain"))))
- if (path!=""){
- Encoding(path) <- "UTF-8"
- importfile(path,encoding=get("encoding",envir=h$action$env),con=h$action$env$qdacon,assignenv=h$action$env)
- ## updatefilelist()
- ## add codes here
- }
- }
-},action=list(env=.rqda,conName="qdacon"))
+ if (length(svalue(.fnames_rqda))==0){gmessage("Select a file first.",icon="error",con=TRUE)}
+ else {
+ tryCatch(dispose(h$action$env$.root_edit),error=function(e) {})
+ ## notice the error handler
+ assign(".root_edit",gwindow(title=svalue(.fnames_rqda), parent=c(270,10),width=600,height=600),env=h$action$env)
+ .root_edit <- get(".root_edit",h$action$env)
+ assign(".openfile_gui",gtext(container=.root_edit,font.attr=c(sizes="large")),env=h$action$env)
+ con <- get(h$action$conName,h$action$env)
+ content <- dbGetQuery(con, sprintf("select file from source where name='%s'",svalue(.fnames_rqda)))[1,1]
+ ## turn data.frame to 1-length character.
+ W <- get(".openfile_gui",h$action$env)
+ 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.
+ codings_index <- dbGetQuery(con,"select rowid, cid, fid, selfirst, selend, status from coding where status=1")
+ assign("codings_index", codings_index, h$action$env)
+ }
+ }
+ },
+ action=list(env=.rqda,conName="qdacon")
+ )
-##gbutton("Update",contain=.files_button,handler=function(h,...){
-## if (is_projOpen(env=h$action$env,conName=h$action$conName)) {
-## fnamesupdate(h$action$conName,h$action$env)
-##}
-##},action=list(env=.rqda,conName="qdacon"))
-gbutton(" View ",contain=.files_button,handler=function(h,...){
- if (is_projOpen(env=h$action$env,conName=h$action$conName)) {
- if (length(svalue(.fnames_rqda))==0){gmessage("Select a file first.",icon="error",con=TRUE)}
- else{
- tryCatch(dispose(h$action$env$.root_edit),error=function(e) {})## notice the error handler
- assign(".root_edit",gwindow(title=svalue(.fnames_rqda), parent=c(270,10),width=600,height=600),env=h$action$env)
- .root_edit <- get(".root_edit",h$action$env)
- ## addHandlerUnrealize(.root_edit, handler = function(h,...) {
- ## make sure is the project should be closed by issuing a confirm window.
- ## val <- gconfirm("Really close window", parent=h$obj)
- ##if(as.logical(val))
- ## return(FALSE) # destroy
- ##else
- ## return(TRUE) # don't destroy
- ##}
- ## )
- assign(".openfile_gui",gtext(container=.root_edit,font.attr=c(sizes="large")),env=h$action$env)
- con <- get(h$action$conName,h$action$env)
- content <- dbGetQuery(con, sprintf("select file from source where name='%s'",svalue(.fnames_rqda)))[1,1]
- ## turn data.frame to 1-length character.
- W <- get(".openfile_gui",h$action$env)
- 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.
+ 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)) {
+ con <- get(h$action$conName,h$action$env)
+ dbGetQuery(con, 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")
+ )
-codings_index <- dbGetQuery(con,"select rowid, cid, fid, selfirst, selend, status from coding where status=1")
-assign("codings_index", codings_index, h$action$env)
-}}
-},
- action=list(env=.rqda,conName="qdacon")
- )
-
-
-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()
+ gbutton(" Memo ", contain=.files_button, handler=function(h,...) {
+ if (is_projOpen(env=h$action$env,"qdacon")) {
+ ## if project is open, then continue
+ selectedFN <- svalue(.fnames_rqda)
+ if (length(selectedFN)==0){
+ ## if no file is selected, then no need to memo.
+ ## svalue(.fnames_rqda) is the name of selected file.
+ gmessage("Select a file first.",icon="error",con=TRUE)
+ }
+ else {
+ tryCatch(dispose(h$action$env$.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("Memo",selectedFN,sep=":"), parent=c(270,10),width=400,height=400),env=h$action$env)
+ .filememo <- get(".filememo",h$action$env)
+ .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); newcontent <- iconv(newcontent, from="UTF-8")
+ newcontent <- enc(newcontent) ## take care of double quote.
+ dbGetQuery(con,sprintf("update source set memo=%s where name=%s",
+ paste("'",newcontent,"'",sep=""),
+ paste("'",selectedFN,"'",sep="")
+ ## have to quote the character in the sql expression
+ )
+ )
}
- }
- },action=list(env=.rqda,conName="qdacon")
- )
+ )
+ assign(".fmemocontent",gtext(container=.filememo2,font.attr=c(sizes="large")),env=h$action$env)
+ con <- get("qdacon",h$action$env)
+ prvcontent <- dbGetQuery(con, sprintf("select memo from source where name='%s'",svalue(.fnames_rqda)))[1,1]
+ ## [1,1]turn data.frame to 1-length character. Existing content of memo
+ if (is.na(prvcontent)) prvcontent <- ""
+ W <- get(".fmemocontent",h$action$env)
+ add(W,prvcontent,font.attr=c(sizes="large"))
+ ## push the previous content to the widget.
+ }
+ }
+ },
+ action=list(env=.rqda)
+ )
+
+ ".fnames_rqda" <- gtable("Click Here to see the File list.",container=.files_pan)
+ .fnames_rqda[] <-NULL # get around of the text argument.
+
+
+ addHandlerMouseMotion(.fnames_rqda, handler <- function(h,
+ ## updating the file name list.
+ ...) {
+ if (is_projOpen(env = h$action$env, conName = h$action$conName,
+ message = FALSE)) {
+ ## cat("Mouse Motion updated.", fill = TRUE)
+ fnamesupdate(assignenv = h$action$env, conName = h$action$conName,
+ assignfileName = h$action$assignfileName,widget=h$action$widget)
+ }
+ },
+ action = list(env = .rqda, conName = "qdacon", assignfileName = "files_index",widget=.fnames_rqda))
+
+
+ addHandlerClicked(.fnames_rqda, handler <- function(h, ...) {
+ ## updating the file name list, and update the status of curent selected file.
+ if (is_projOpen(env = h$action$env, conName = h$action$conName, message = FALSE)) {
+ fnamesupdate(assignenv = h$action$env, conName = h$action$conName,
+ assignfileName = h$action$assignfileName,h$action$widget)
+ files_index <- get(h$action$assignfileName, h$action$env)
+ assign("currentFile", svalue(.fnames_rqda), env = h$action$env)
+ currentFile <- get("currentFile", h$action$env)
+ currentFid <- files_index[files_index[["name"]] ==
+ currentFile, "id", drop = TRUE]
+ if (is.null(currentFid))
+ currentFid <- integer(0)
+ assign("currentFid", currentFid, env = h$action$env)
+ }
+ },action = list(env = .rqda, conName = "qdacon", assignfileName = "files_index",widget=.fnames_rqda)
+ )
-".fnames_rqda" <- gtable("Click Here to see the File list.",container=.files_pan)
-.fnames_rqda[] <-NULL # get around of the text argument.
-
-
-addHandlerMouseMotion(.fnames_rqda, handler <- function(h,
- ## updating the file name list.
- ...) {
- if (is_projOpen(env = h$action$env, conName = h$action$conName,
- message = FALSE)) {
- ## cat("Mouse Motion updated.", fill = TRUE)
- fnamesupdate(assignenv = h$action$env, conName = h$action$conName,
- assignfileName = h$action$assignfileName,widget=h$action$widget)
- }
-}, action = list(env = .rqda, conName = "qdacon", assignfileName = "files_index",widget=.fnames_rqda))
-
-
-addHandlerClicked(.fnames_rqda, handler <- function(h, ...) {
- ## updating the file name list, and update the status of curent selected file.
- if (is_projOpen(env = h$action$env, conName = h$action$conName,
- message = FALSE)) {
- fnamesupdate(assignenv = h$action$env, conName = h$action$conName,
- assignfileName = h$action$assignfileName,h$action$widget)
- ## cat("clicked.", fill = TRUE)
- files_index <- get(h$action$assignfileName, h$action$env)
- assign("currentFile", svalue(.fnames_rqda), env = h$action$env)
- currentFile <- get("currentFile", h$action$env)
- currentFid <- files_index[files_index[["name"]] ==
- currentFile, "id", drop = TRUE]
- if (is.null(currentFid))
- currentFid <- integer(0)
- assign("currentFid", currentFid, env = h$action$env)
- }
-}, 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
###########################
+ ".codes_pan" <- gpanedgroup(container=.nb_rqdagui,horizontal=FALSE,label="Codes")
+ ".codes_button" <- glayout(container=.codes_pan)
-".codes_pan" <- gpanedgroup(container=.nb_rqdagui,horizontal=FALSE,label="Codes")
-".codes_button" <- glayout(container=.codes_pan)
-
- #.codes_button[1,1]<- gbutton("Update",handler=function(h,...){
-###
-###
- #} )
-
-.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)
- codename <- ginput("Enter new code. ", icon="info")
- codename <- iconv(codename,from="UTF-8")
- addcode(codename,conName=h$action$conName,assignenv=h$action$env,
+
+ .codes_button[1,1]<- gbutton(" ADD ",
+ handler=function(h,...) {
+ if (is_projOpen(env=h$action$env,conName=h$action$conName)) {
+ 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
- }},
- action=list(env=.rqda,name="codename",conName="qdacon",assignname="codes_index",
- assignfileName="codes_index",widget=".codes_rqda")
- ## widget should be character, and in the codesupdate() call, use get() to access the widget.
- )
+ }
+ },
+ action=list(env=.rqda,name="codename",conName="qdacon",assignname="codes_index",
+ assignfileName="codes_index",widget=".codes_rqda")
+ ##widget should be character, and in the codesupdate() call, use get() to access the widget.
+ )
+
+ .codes_button[1,2]<- gbutton(" Delete ",
+ 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,2]<- gbutton("Delete",
- 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
+
+ .codes_button[1,3] <- gbutton("CodeMemo", handler=function(h,...) {
+ ## code memo: such as meaning of code etc.
+ if (is_projOpen(env=.rqda,"qdacon")) {
+ if (length(.rqda$currentCode)==0){
+ gmessage("Select a code first.",icon="error",con=TRUE)
+ }
+ else {
+ tryCatch(dispose(h$action$env$.codememo),error=function(e) {})
+ assign(".codememo",gwindow(title=paste("Code Memo",.rqda$currentCode,sep=":"),
+ parent=c(270,10),width=400,height=400),env=.rqda)
+ .codememo <- get(".codememo",env=h$action$env)
+ .codememo2 <- gpanedgroup(horizontal = FALSE, con=.codememo)
+ gbutton("Save Code Memo",con=.codememo2,handler=function(h,...){
+ newcontent <- svalue(W); newcontent <- iconv(newcontent, from="UTF-8")
+ newcontent <- enc(newcontent) ## take care of double quote.
+ dbGetQuery(con,sprintf("update freecode set memo=%s where name=%s",
+ paste("'",newcontent,"'",sep=""),
+ paste("'",.rqda$currentCode,"'",sep="")
+ )
+ )
}
- }
- },action=list(env=.rqda,conName="qdacon")
- )
+ )
+ assign(".cmemocontent",gtext(container=.codememo2,font.attr=c(sizes="large")),env=h$action$env)
+ con <- get("qdacon",h$action$env)
+ prvcontent <- dbGetQuery(con, sprintf("select memo from freecode where name='%s'",.rqda$currentCode))[1,1]
+ if (is.na(prvcontent)) prvcontent <- ""
+ W <- get(".cmemocontent",h$action$env)
+ add(W,prvcontent,font.attr=c(sizes="large"))
+ }
+ }
+ },
+ action=list(env=.rqda)
+ )
-.codes_button[1,3]<- gbutton("HL ALL",
- handler=function(h,...) {
- if (is_projOpen(env=h$action$env,conName=h$action$conName)) {
- con <- get(h$action$conName,h$action$env)
- fid <- get(h$action$currentFid,h$action$env)
- mark_index <- dbGetQuery(con, sprintf("select selfirst, selend,status from coding where fid=%i",fid))
- ## only select thoses with the open_file and not deleted (status=1).
- ClearMark(get(h$action$widget,h$action$env),0,max(mark_index$selend))
- HL(get(h$action$widget,h$action$env),index=mark_index[mark_index$status==1,1:2])
- }
- },
- action=list(env=.rqda,conName="qdacon",widget=".openfile_gui",currentFid="currentFid")
- )
+
+ .codes_button[1,4]<- gbutton("HL ALL",
+ handler=function(h,...) {
+ if (is_projOpen(env=h$action$env,conName=h$action$conName)) {
+ con <- get(h$action$conName,h$action$env)
+ fid <- get(h$action$currentFid,h$action$env)
+ W <- tryCatch( get(h$action$widget,h$action$env),
+ error=function(e) {}
+ )
+ if (length(fid)!=0 & !is.null(W)) {
+ ## if fid is integer(0), then there is no file selected and open
+ ## 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",fid))
+ ## 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])
+ }
+ }
+ },
+ action=list(env=.rqda,conName="qdacon",widget=".openfile_gui",currentFid="currentFid")
+ )
-.codes_button[2,1]<- gbutton("Open",
- handler=function(h,...) {
- if (is_projOpen(env=h$action$env,conName=h$action$conName)) {
- retrieval(h$action$cid,h$action$conName,h$action$env,h$action$Code)
- }},
- action=list(cid="currentCid",conName="qdacon",env=.rqda,Code="currentCode")
- )
+
+ .codes_button[2,1]<- gbutton("Mark",
+ handler=function(h,...) {
+ if (is_projOpen(env=h$action$env,conName=h$action$conName)) {
+ tryCatch({
+ ans <- mark(get(h$action$widget,env=h$action$env))
+ if (ans$start != ans$end){
+ ## when selected no text, makes on sense to do anything.
+ currentCid <- get("currentCid",h$action$env)
+ currentFid <- get("currentFid",h$action$env)
+ DAT <- data.frame(cid=currentCid,fid=currentFid,seltext=ans$text,
+ selfirst=ans$start,selend=ans$end,status=1,
+ owner=.rqda$owner,date=date(),memo="")
+ con <- get(h$action$conName,h$action$env)
+ success <- dbWriteTable(con,"coding",DAT,row.name=FALSE,append=TRUE)
+ if (!success) gmessage("Fail to write to database.")
+ ## further testing: update codings_index in .rqda env.
+ codings_index <- dbGetQuery(con,"select rowid, cid, fid, selfirst, selend, status from coding where status=1")
+ assign("codings_index", codings_index, h$action$env)
+ ## end furthing testing
+ }
+ },error=function(e){}
+ )
+ }
+ },
+ action=list(env=.rqda,conName="qdacon",widget=".openfile_gui")
+ )
+
+
+ .codes_button[2,2]<- gbutton("Unmark",
+ handler=function(h,...) {
+ if (is_projOpen(env=h$action$env,conName=h$action$conName)) {
+ con <- get(h$action$conName,h$action$env)
+ W <- tryCatch( get(h$action$widget,env=h$action$env),
+ 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)) {
+ codings_index <- get(h$action$codings_index,h$action$env)
+ currentCid <- get("currentCid",h$action$env)
+ currentFid <- get("currentFid",h$action$env)
+ codings_index_current <- codings_index[(codings_index$cid==currentCid & codings_index$fid==currentFid),]
+ ## should only work with those related to current code and current file.
+ rowid <- codings_index_current$rowid[(codings_index_current$selfirst >= sel_index$startN) & (codings_index_current$selend <= sel_index$endN)]
+ if (is.numeric(rowid)) for (j in rowid) {
+ dbGetQuery(con,sprintf("update coding set status=0 where rowid=%i", j)) }
+ ## better to get around the loop by sqlite condition expression.
+ codings_index$status[codings_index$rowid==rowid] <- 0
+ 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")
+ )
-.codes_button[2,2]<- gbutton("Unmark",
- handler=function(h,...) {
- 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 <- 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)
- codings_index_current <- codings_index[(codings_index$cid==currentCid & codings_index$fid==currentFid),]
- ## should only work with those related to current code and current file.
- rowid <- codings_index_current$rowid[(codings_index_current$selfirst >= sel_index$startN) &
- (codings_index_current$selend <= sel_index$endN)]
- if (is.numeric(rowid)) for (j in rowid){
- dbGetQuery(con,sprintf("update coding set status=0 where rowid=%i", j)) }
- ## better to get around the loop by sqlite condition expression.
- codings_index$status[codings_index$rowid==rowid] <- 0
- 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")
- )
-
-.codes_button[2,3]<- gbutton("Mark",
- handler=function(h,...) {
- if (is_projOpen(env=h$action$env,conName=h$action$conName)) {
- tryCatch({
- ## browser()
- ans <- mark(get(h$action$widget,env=h$action$env))
- if (ans$start != ans$end){
- ## when selected no text, makes on sense to do anything.
- currentCid <- get("currentCid",h$action$env)
- currentFid <- get("currentFid",h$action$env)
- DAT <- data.frame(cid=currentCid,fid=currentFid,seltext=ans$text,
- selfirst=ans$start,selend=ans$end,status=1)
- con <- get(h$action$conName,h$action$env)
- success <- dbWriteTable(con,"coding",DAT,row.name=FALSE,append=TRUE)
- if (!success) gmessage("Fail to write to database.")
- ## further testing: update codings_index in .rqda env.
- codings_index <- dbGetQuery(con,"select rowid, cid, fid, selfirst, selend, status from coding where status=1")
- assign("codings_index", codings_index, h$action$env)
- ## end furthing testing
- }
- },error=function(e){})
- }},
- action=list(env=.rqda,conName="qdacon",widget=".openfile_gui")
- )
-
-##.codes_button[2,4]<- gbutton("HL SEL",
-## handler=function(h,...) {
-## sel_index <- dbGetQuery(qdacon, "select selfirst, selend, cid from coding")
-## ClearMark(.marktxt_rqda,max(sel_index[,2]))
-## sel_index <- subset(sel_index,cid==currentCid,selection=c("selfirst","selend"))
-## HL(.marktxt_rqda,index=sel_index)
-## })
-
-".codes_rqda" <- gtable("Please click Update",container=.codes_pan)
-.codes_rqda[] <- NULL
-
-
-addHandlerClicked(.codes_rqda,handler <- function(h,...){
- ## without it, button mark doesn't work due to lack of currentCid.
- ## BUG: only clear the mark but not highlight the selected text chunk.
- codes_index <- get(h$action$fileName, h$action$env)
- assign("currentCode",svalue(.codes_rqda),env=h$action$env) ## current code
- currentCode <- get("currentCode", h$action$env)
- currentCid <- codes_index[codes_index[["name"]] == currentCode, "id", drop = TRUE]
- if (is.null(currentCid)) currentCid <- integer(0)
- assign("currentCid", currentCid, env = h$action$env)
- ## above code: update the meta data -- CurrentCode and Current code id.
- ## following code: Only mark the text chuck according to the current code.
- currentFid <- get("currentFid", h$action$env)
- tryCatch({
- widget <- get(h$action$marktxtwidget,h$action$env)
- ## if widget is not open, then error;which means no need to highlight anything.
- con <- get(h$action$conName,h$action$env)
- sel_index <- dbGetQuery(con, sprintf("select selfirst, selend, cid, status from coding where fid=%i",currentFid))
- Maxindex <- max(sel_index["selend"],na.rm=TRUE)
- sel_index <- sel_index[(sel_index$cid==currentCid & sel_index$status==1),c("selfirst","selend")]
- ClearMark(widget,min=0,max=Maxindex)
- if (nrow(sel_index)>0){
- HL(widget,index=sel_index)
- }
- },error=function(e){})
-},action=list(env=.rqda,fileName="codes_index",conName="qdacon",marktxtwidget=".openfile_gui"
- )
+ .codes_button[2,3]<- gbutton("CodingMemo", handler= function(h,...){
+ if (is_projOpen(env=.rqda,conName="qdacon")) {
+ con <- get("qdacon",env=.rqda)
+ W <- tryCatch( get(".openfile_gui",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, it doesn't work.
+ if (is.null(sel_index)) {gmessage("Open a file first!",con=TRUE)}
+ else {
+ codings_index <- get("codings_index",env=.rqda)
+ currentCid <- get("currentCid",env=.rqda)
+ if (length(currentCid)==0) gmessage("Select a code first!") else {
+ currentFid <- get("currentFid",env=.rqda)
+ codings_index_current <- codings_index[(codings_index$cid==currentCid & codings_index$fid==currentFid),]
+ ## should only work with those related to current code and current file.
+ rowid <- codings_index_current$rowid[(codings_index_current$selfirst >= sel_index$startN) &
+ (codings_index_current$selfirst <= sel_index$startN + 4) &
+ (codings_index_current$selend <= sel_index$endN)&
+ (codings_index_current$selend >= sel_index$endN - 4)
+ ] ## determine which one is the current text chunk?
+ if (length(rowid)!= 1) {gmessage("Select the exact coding first!", con=TRUE) } else {
+ ## open a widget for memo, and take care of the save memo function
+ tryCatch(dispose(h$action$env$.codingmemo),error=function(e) {})
+ ## Close the coding memo first, then open a new one
+ assign(".codingmemo",gwindow(title=paste("Coding Memo for",.rqda$currentCode,sep=":"),
+ parent=c(270,10),width=400,height=400
+ ), env=.rqda
+ )
+ .codingmemo <- get(".codingmemo",env=.rqda)
+ .codingmemo2 <- gpanedgroup(horizontal = FALSE, con=.codingmemo)
+ gbutton("Save Coding Memo",con=.codingmemo2,handler=function(h,...){
+ newcontent <- svalue(W); newcontent <- iconv(newcontent, from="UTF-8")
+ newcontent <- enc(newcontent) ## take care of double quote.
+ dbGetQuery(con,sprintf("update coding set memo=%s where rowid=%i",
+ paste("'",newcontent,"'",sep=""),
+ rowid
+ )
+ )
+ }
)
-
-
-addHandlerMouseMotion(.codes_rqda, handler <- function(h,
- ## updating the codes name list.
- ...) {
- if (is_projOpen(env = h$action$env, conName = h$action$conName,message = FALSE)) {
- ## cat("Mouse Motion updated.", fill = TRUE)
- codesupdate(conName = h$action$conName, assignenv = h$action$env,
- assignfileName = h$action$assignfileName,widget=h$action$widget)
+ assign(".cdmemocontent",gtext(container=.codingmemo2,font.attr=c(sizes="large")),env=.rqda)
+ con <- get("qdacon",env=.rqda)
+ prvcontent <- dbGetQuery(con, sprintf("select memo from coding where rowid=%i",rowid))[1,1]
+ if (is.na(prvcontent)) prvcontent <- ""
+ W <- get(".cdmemocontent",env=.rqda)
+ add(W,prvcontent,font.attr=c(sizes="large"))
+ }
+ }
+ }
+ }
}
-}, action = list(env = .rqda, conName = "qdacon", assignfileName = "codes_index",widget=.codes_rqda))
+ )
+
+ .codes_button[2,4]<- gbutton("Retrieval",
+ handler=function(h,...) {
+ if (is_projOpen(env=h$action$env,conName=h$action$conName)) {
+ retrieval(h$action$cid,h$action$conName,h$action$env,h$action$Code)
+ }
+ },
+ action=list(cid="currentCid",conName="qdacon",env=.rqda,Code="currentCode")
+ )
-addhandlerdoubleclick(.codes_rqda,handler <- function(h,...){
- codes_index <- get(h$action$fileName, h$action$env)
- assign("currentCode",svalue(.codes_rqda),env=h$action$env) ## current code
- currentCode <- get("currentCode", h$action$env)
- currentFid <- get("currentFid", h$action$env)
- currentCid <- codes_index[codes_index[["name"]] == currentCode, "id", drop = TRUE]
- if (is.null(currentCid)) currentCid <- integer(0)
- assign("currentCid", currentCid, env = h$action$env)
- ## above code: update the meta data -- CurrentCode and Current code id.
- ## following code: Only mark the text chuck according to the current code.
- tryCatch({
- widget <- get(h$action$marktxtwidget,h$action$env)
- ## if widget is not open, then error;which means no need to highlight anything.
- con <- get(h$action$conName,h$action$env)
- sel_index <- dbGetQuery(con, sprintf("select selfirst, selend, cid, status from coding where fid=%i",currentFid))
- Maxindex <- max(sel_index["selend"],na.rm=TRUE)
- sel_index <- sel_index[(sel_index$cid==currentCid & sel_index$status==1),c("selfirst","selend")]
- ClearMark(widget,min=0,max=Maxindex)
-if (nrow(sel_index)>0){
- HL(widget,index=sel_index)}
- },error=function(e){})
-},action=list(env=.rqda,fileName="codes_index",conName="qdacon",marktxtwidget=".openfile_gui"
- )
- )
-
-
-
-########################### 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
-
+
+ ".codes_rqda" <- gtable("Please click Update",container=.codes_pan)
+ .codes_rqda[] <- NULL
+
+
+ addHandlerClicked(.codes_rqda,handler <- function(h,...){
+ ## without it, button mark doesn't work due to lack of currentCid.
+ ## BUG: only clear the mark but not highlight the selected text chunk.
+ codes_index <- get(h$action$fileName, h$action$env)
+ assign("currentCode",svalue(.codes_rqda),env=h$action$env) ## current code
+ currentCode <- get("currentCode", h$action$env)
+ currentCid <- codes_index[codes_index[["name"]] == currentCode, "id", drop = TRUE]
+ if (is.null(currentCid)) currentCid <- integer(0)
+ assign("currentCid", currentCid, env = h$action$env)
+ ## above code: update the meta data -- CurrentCode and Current code id.
+ ## following code: Only mark the text chuck according to the current code.
+ currentFid <- get("currentFid", h$action$env)
+ tryCatch({
+ widget <- get(h$action$marktxtwidget,h$action$env)
+ ## if widget is not open, then error;which means no need to highlight anything.
+ con <- get(h$action$conName,h$action$env)
+ sel_index <- dbGetQuery(con, sprintf("select selfirst, selend, cid, status from coding where fid=%i",currentFid))
+ Maxindex <- max(sel_index["selend"],na.rm=TRUE)
+ sel_index <- sel_index[(sel_index$cid==currentCid & sel_index$status==1),c("selfirst","selend")]
+ ClearMark(widget,min=0,max=Maxindex)
+ if (nrow(sel_index)>0){
+ HL(widget,index=sel_index)
+ }
+ },error=function(e){}
+ )
+ },
+ action=list(env=.rqda,fileName="codes_index",conName="qdacon",marktxtwidget=".openfile_gui"
+ )
+ )
+
+
+ addHandlerMouseMotion(.codes_rqda, handler <- function(h,
+ ## updating the codes name list.
+ ...) {
+ if (is_projOpen(env = h$action$env, conName = h$action$conName,message = FALSE)) {
+ codesupdate(conName = h$action$conName, assignenv = h$action$env,
+ assignfileName = h$action$assignfileName,widget=h$action$widget)
+ }
+ },
+ action = list(env = .rqda, conName = "qdacon", assignfileName = "codes_index",widget=.codes_rqda)
+ )
+
+
+ addhandlerdoubleclick(.codes_rqda,handler <- function(h,...){
+ codes_index <- get(h$action$fileName, h$action$env)
+ assign("currentCode",svalue(.codes_rqda),env=h$action$env) ## current code
+ currentCode <- get("currentCode", h$action$env)
+ currentFid <- get("currentFid", h$action$env)
+ currentCid <- codes_index[codes_index[["name"]] == currentCode, "id", drop = TRUE]
+ if (is.null(currentCid)) currentCid <- integer(0)
+ assign("currentCid", currentCid, env = h$action$env)
+ ## above code: update the meta data -- CurrentCode and Current code id.
+ ## following code: Only mark the text chuck according to the current code.
+ tryCatch({
+ widget <- get(h$action$marktxtwidget,h$action$env)
+ ## if widget is not open, then error;which means no need to highlight anything.
+ con <- get(h$action$conName,h$action$env)
+ sel_index <- dbGetQuery(con, sprintf("select selfirst, selend, cid, status from coding where fid=%i",currentFid))
+ Maxindex <- max(sel_index["selend"],na.rm=TRUE)
+ sel_index <- sel_index[(sel_index$cid==currentCid & sel_index$status==1),c("selfirst","selend")]
+ ClearMark(widget,min=0,max=Maxindex)
+ if (nrow(sel_index)>0){
+ HL(widget,index=sel_index)}
+ },error=function(e){})
+ },action=list(env=.rqda,fileName="codes_index",conName="qdacon",marktxtwidget=".openfile_gui"
+ )
+ )
+
+
+
+######################### Put them together
#########################
-#########################
-visible(.root_rqdagui) <- TRUE
-svalue(.nb_rqdagui) <- 1 ## make sure the project tab gain the focus.
-### make it a function RQDA().
+ visible(.root_rqdagui) <- TRUE
+ svalue(.nb_rqdagui) <- 1
+ ## make sure the project tab gain the focus.
+ ## make it a function RQDA().
}
+## end of function RQDA
Modified: pkg/R/zzz.R
===================================================================
--- pkg/R/zzz.R 2008-11-01 08:26:04 UTC (rev 10)
+++ pkg/R/zzz.R 2008-11-01 10:08:36 UTC (rev 11)
@@ -1,15 +1,5 @@
-##rqdameta <-function(){
-##assign(".rqda",new.env(),.GlobalEnv)
-##.rqda$codes_index <- data.frame(name=character(0),id=integer(0))
-##.rqda$files_index <- data.frame(name=character(0),id=integer(0))
-##}
-
.First.lib <- function(...) {
-## .rqda environment MUST be created.
-##library(gWidgetsRGtk2)
-##library(RSQLite)
-##rqdameta()
-cat("\nUse RQDA() to start the programe.\n",fill=TRUE)
-##cat("Do NOT remove the .rdqa environment in .GlobalEnv.",fill=TRUE)
-##cat("If you haved deleted it, You can run rdqameta() manually,\nand then start RQDA() again.",fill=TRUE)
+ .rqda$owner <- "default"
+ cat("\nUse RQDA() to start the programe.\n",fill=TRUE)
+ RQDA()
}
Modified: pkg/TODO
===================================================================
--- pkg/TODO 2008-11-01 08:26:04 UTC (rev 10)
+++ pkg/TODO 2008-11-01 10:08:36 UTC (rev 11)
@@ -1,11 +1,7 @@
-add functionality of memo.
+set info about owner and date
-undo the temp deletion.
-
summary functions for review of coding.
should add document on the table structure.
-tree-like structure of files/ codes.
-
-Man file should be documented.
\ No newline at end of file
+tree-like structure of files/ codes.
\ No newline at end of file
Modified: pkg/man/RQDA-internal.rd
===================================================================
--- pkg/man/RQDA-internal.rd 2008-11-01 08:26:04 UTC (rev 10)
+++ pkg/man/RQDA-internal.rd 2008-11-01 10:08:36 UTC (rev 11)
@@ -9,10 +9,8 @@
\alias{is_projOpen}
\alias{mark}
\alias{new_proj}
-\alias{setEncoding}
+\alias{setEncoding} %% to be documented independently.
\alias{open_proj}
-%%\alias{RQDA}
-%% RQDA() appears in RQDA-package.rd
\alias{rqdameta}
\alias{retrieval}
\alias{sindex}
Modified: pkg/man/RQDA-package.Rd
===================================================================
--- pkg/man/RQDA-package.Rd 2008-11-01 08:26:04 UTC (rev 10)
+++ pkg/man/RQDA-package.Rd 2008-11-01 10:08:36 UTC (rev 11)
@@ -6,7 +6,7 @@
Qualitative data analysis
}
\description{
-Qualitative Data Analysis based on R language. Current version only supports plain text.
+ Qualitative Data Analysis based on R language. Current version only supports plain text.
}
\details{
\tabular{ll}{
@@ -20,24 +20,25 @@
}
%% description of the package
%% main functions.
-The only function for end-user is the RQDA(), you can use RQDA() to
+The workhorse function for end-user is the RQDA(), you can use RQDA() to
start the GUI after library(QRDA).
}
\author{
-Huang Ronggui
+ Huang Ronggui
+
+ Maintainer: Huang <ronggui.huang at gmail.com>
+}
-Maintainer: Huang <ronggui.huang at gmail.com>
-}
-\references{
+%%\references{
%% reference here
-}
+%%}
%%~~ Optionally other standard keywords, one per line, from file KEYWORDS ~~
%%~~ in the R documentation directory ~~
\keyword{ package }
-\seealso{
+%%\seealso{
%~~ Optional links to other man pages, e.g. ~~
%~~ \code{\link[<pkg>:<pkg>-package]{<pkg>}} ~~
-}
+%%}
\examples{
\dontrun{library(RQDA)
RQDA()
Deleted: pkg/man/clear.rd
===================================================================
--- pkg/man/clear.rd 2008-11-01 08:26:04 UTC (rev 10)
+++ pkg/man/clear.rd 2008-11-01 10:08:36 UTC (rev 11)
@@ -1,62 +0,0 @@
-\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 }
-
Modified: pkg/man/list.deleted.rd
===================================================================
--- pkg/man/list.deleted.rd 2008-11-01 08:26:04 UTC (rev 10)
+++ pkg/man/list.deleted.rd 2008-11-01 10:08:36 UTC (rev 11)
@@ -1,56 +1,48 @@
-\name{list.deleted}
+\name{File/code/coding deletion}
\alias{list.deleted}
-%- Also NEED an '\alias' for EACH other topic documented here.
-\title{ ~~function to do ... ~~ }
+\alias{pdelete}
+\alias{undelete}
+\title{ Show, permanently delete or un-delete(reuse) the unused file, code, and coding.}
\description{
- ~~ A concise (1-5 lines) description of what the function does. ~~
+ \code{list.deleted} shows the file, code and coding tagged with deletion
+ mark.
+ \code{pdelete} _p_ermanently delete them.
+ \code{undelete} let you reuse the temporary tagged as deleted file and code.
}
\usage{
list.deleted(type = c("file", "code", "coding"))
+pdelete(type = c("file", "code", "coding"),ask = FALSE)
+undelete(type=c("file","code"))
}
-%- maybe also 'usage' for other objects documented here.
+
\arguments{
- \item{type}{ ~~Describe \code{type} here~~ }
+ \item{type}{ What kind of info would you like to show or clear.}
+ \item{ask} {You can choose which ones to be deleted when is
+ TRUE. Otherwise, it will delete all with temporary tagged with
+ deletion mark, that is status=0.}
}
+
\details{
- ~~ If necessary, more details than the description above ~~
+ By GUI, you can delete file and code (together with the related
+ coding), which just sets the status from 1 to 0. In this sense,
+ deletion from GUI is temporary.After that, you can use
+ \code{list.deleted} to show which ones are tagged as deleted.
+ By \code{pdelete}, you can permenantly delete those tagged with mark
+ of status=0, all of them by setting ask=FALSE, or you can choose which
+ ones to be deleted permenantly.By \code{undelete}, you can undo the
+ temporary deleted files and codes. It offers a GUI so you can choose
+ in the list. For the time being, it is not the true reserve process of
+ GUI deletion, as the deletion-tagged _coding_ will not set to the
+ original status.
}
+
\value{
- ~Describe the value returned
- If it is a LIST, use
- \item{comp1 }{Description of 'comp1'}
- \item{comp2 }{Description of 'comp2'}
- ...
+For \code{list.deleted}, a data frame if there are some item tagged with
+status=0.
+For \code{pdelete} and \code{undelete}, no value is return. This
+function is for is side-effect.
}
-\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.
+\author{Ronggui HUANG}
\keyword{ utilities }
Modified: www/index.html
===================================================================
--- www/index.html 2008-11-01 08:26:04 UTC (rev 10)
+++ www/index.html 2008-11-01 10:08:36 UTC (rev 11)
@@ -7,12 +7,11 @@
<META NAME="AUTHOR" CONTENT="wincent">
<META NAME="CREATED" CONTENT="20081101;12455800">
<META NAME="CHANGEDBY" CONTENT="wincent">
- <META NAME="CHANGED" CONTENT="20081101;16251000">
+ <META NAME="CHANGED" CONTENT="20081101;16300600">
<META NAME="Info 1" CONTENT="">
<META NAME="Info 2" CONTENT="">
<META NAME="Info 3" CONTENT="">
<META NAME="Info 4" CONTENT="">
- <META NAME="CHANGEDBY" CONTENT="wincent">
</HEAD>
<BODY LANG="zh-CN" DIR="LTR">
<P ALIGN=CENTER><FONT COLOR="#008000"><FONT FACE="Times New Roman, serif"><FONT SIZE=4 STYLE="font-size: 15pt"><SPAN LANG="en-US">Welcome
@@ -37,8 +36,9 @@
Analysis features. Besides, it seamlessly integrated with R, which
means that a) statistical analysis on the coding is possible, and b)
functions about data manipulation and analysis can be easily extended
-by writing R functions. </SPAN></FONT></SPAN></FONT>
-</P>
+by writing R functions. To some extent, </SPAN></FONT><FONT FACE="Times New Roman, serif"><SPAN LANG="en-US"><B>RQDA
+and R makes an integrated platform for both quantitative and
+qualitative data analysis.</B></SPAN></FONT></SPAN></FONT></P>
<P ALIGN=LEFT><FONT FACE="Times New Roman, serif"><SPAN LANG="en-US">By
the GUI, it can:<BR>** Import documents from plain text<BR>** Support
non-English documents, Simplified Chinese Character is well-tested
More information about the Rqda-commits
mailing list