[Rqda-commits] r23 - pkg pkg/R tags tags/0.1.3 tags/0.1.3/R tags/0.1.3/inst tags/0.1.3/man tags/0.1.5 tags/0.1.5/R tags/0.1.5/inst tags/0.1.5/man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sat Nov 29 12:25:50 CET 2008
Author: wincent
Date: 2008-11-29 12:25:50 +0100 (Sat, 29 Nov 2008)
New Revision: 23
Added:
tags/0.1.3/
tags/0.1.3/ChangeLog
tags/0.1.3/DESCRIPTION
tags/0.1.3/R/
tags/0.1.3/R/codes.R
tags/0.1.3/R/deletion.R
tags/0.1.3/R/files.R
tags/0.1.3/R/project.R
tags/0.1.3/R/root_gui.R
tags/0.1.3/R/sysdata.rda
tags/0.1.3/R/zzz.R
tags/0.1.3/TODO
tags/0.1.3/inst/
tags/0.1.3/inst/database_structure.txt
tags/0.1.3/man/
tags/0.1.3/man/RQDA-internal.rd
tags/0.1.3/man/RQDA-package.Rd
tags/0.1.3/man/list.deleted.rd
tags/0.1.5/
tags/0.1.5/ChangeLog
tags/0.1.5/DESCRIPTION
tags/0.1.5/R/
tags/0.1.5/R/CaseButton.R
tags/0.1.5/R/CodeCatButton.R
tags/0.1.5/R/CodesFun.R
tags/0.1.5/R/Coding_Buttons.R
tags/0.1.5/R/FileButton.R
tags/0.1.5/R/FilesFun.R
tags/0.1.5/R/GUIHandler.R
tags/0.1.5/R/ProjectButton.R
tags/0.1.5/R/ProjectFun.R
tags/0.1.5/R/Rename.R
tags/0.1.5/R/deletion.R
tags/0.1.5/R/root_gui.R
tags/0.1.5/R/sysdata.rda
tags/0.1.5/R/zzz.R
tags/0.1.5/TODO
tags/0.1.5/inst/
tags/0.1.5/inst/database_structure.txt
tags/0.1.5/man/
tags/0.1.5/man/RQDA-internal.rd
tags/0.1.5/man/RQDA-package.Rd
tags/0.1.5/man/list.deleted.rd
Modified:
pkg/ChangeLog
pkg/R/CodesFun.R
pkg/R/Coding_Buttons.R
pkg/R/root_gui.R
Log:
Modified: pkg/ChangeLog
===================================================================
--- pkg/ChangeLog 2008-11-29 08:45:56 UTC (rev 22)
+++ pkg/ChangeLog 2008-11-29 11:25:50 UTC (rev 23)
@@ -4,6 +4,7 @@
* Add F-Cat (file-category) to help organized the files.
* Add doubleclick handlers to CodeOfCat and FileOfCat to retrieve coding and open file.
* fix typo (Thanks Adrian Dusa)
+ * fix a minor bug of CodeNamesUpdate()
2008-11-25
*Take care of the warning from R CMD check
Modified: pkg/R/CodesFun.R
===================================================================
--- pkg/R/CodesFun.R 2008-11-29 08:45:56 UTC (rev 22)
+++ pkg/R/CodesFun.R 2008-11-29 11:25:50 UTC (rev 23)
@@ -27,9 +27,8 @@
if (nrow(codesName)!=0) {
Encoding(codesName[['name']]) <- "UTF-8"
tryCatch(CodeNamesWidget[] <- codesName[['name']], error=function(e){})
- } else gmessage("Cannot update Code List in the Widget. Project is closed already.\n",con=TRUE)
+ }} else gmessage("Cannot update Code List in the Widget. Project is closed already.\n",con=TRUE)
}
-}
mark <- function(widget){
Modified: pkg/R/Coding_Buttons.R
===================================================================
--- pkg/R/Coding_Buttons.R 2008-11-29 08:45:56 UTC (rev 22)
+++ pkg/R/Coding_Buttons.R 2008-11-29 11:25:50 UTC (rev 23)
@@ -12,8 +12,8 @@
}
-DeleteCodeButton <- function(){
- gbutton(" Delete ",
+DeleteCodeButton <- function(label="Delete"){
+ gbutton(label,
handler=function(h,...)
{
if (is_projOpen(env=.rqda,conName="qdacon") &
Modified: pkg/R/root_gui.R
===================================================================
--- pkg/R/root_gui.R 2008-11-29 08:45:56 UTC (rev 22)
+++ pkg/R/root_gui.R 2008-11-29 11:25:50 UTC (rev 23)
@@ -100,8 +100,8 @@
".CodeofCat" <- gtable("Please click Update",container=.Ccat_PW,expand=TRUE,multiple=TRUE)
.CodeofCat[] <- NULL;names(.CodeofCat)<-"Codes of This Category"
.codecat_buttons[1,1] <- AddCodeCatButton("Add")
- .codecat_buttons[1,2] <- CodeCat_RenameButton("Rename")
- .codecat_buttons[1,3] <- DeleteCodeCatButton("Delete") ## should take care of treecode table
+ .codecat_buttons[1,2] <- DeleteCodeCatButton("Delete") ## should take care of treecode table
+ .codecat_buttons[1,3] <- CodeCat_RenameButton("Rename")
.codecat_buttons[1,4] <- CodeCatAddToButton("AddTo")
.codecat_buttons[1,5] <- CodeCatDropFromButton("DropFrom")
@@ -115,8 +115,8 @@
".FileofCat" <- gtable("Please click Update",container=.Fcat_PW,expand=TRUE,multiple=TRUE)
.FileofCat[] <- NULL;names(.FileofCat)<-"Files of This Category"
.filecat_buttons[1,1] <- AddFileCatButton("Add")
- .filecat_buttons[1,2] <- FileCat_RenameButton("Rename")
- .filecat_buttons[1,3] <- DeleteFileCatButton("Delete") ## should take care of treecode table
+ .filecat_buttons[1,2] <- DeleteFileCatButton("Delete") ## should take care of treecode table
+ .filecat_buttons[1,3] <- FileCat_RenameButton("Rename")
.filecat_buttons[1,4] <- FileCatAddToButton("AddTo")
.filecat_buttons[1,5] <- FileCatDropFromButton("DropFrom")
Added: tags/0.1.3/ChangeLog
===================================================================
--- tags/0.1.3/ChangeLog (rev 0)
+++ tags/0.1.3/ChangeLog 2008-11-29 11:25:50 UTC (rev 23)
@@ -0,0 +1,22 @@
+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 helper functions to delete file/code/coding permanently.
+ * Add helper functions to undo the temporary deletion.
+ * Minor changes to the database structure, adding memo, owner and date.
+ * some minor bugs are fixed.
+ * Now, RQDA() will launch when the package is attached.
+
+2008-10-29
+ * Add functionality of delete selected file.
+
+2008-5-17
+ * Open coding text chunk is added.
+ * "Unmark" button works now.
+
+2008-5-14
+ * Use /R/sysdata.rda to store meta data such as .rqda environment, so no need to generate it in .GlobalEnv.
+ * Add RQDA-package.rd in /man.
Added: tags/0.1.3/DESCRIPTION
===================================================================
--- tags/0.1.3/DESCRIPTION (rev 0)
+++ tags/0.1.3/DESCRIPTION 2008-11-29 11:25:50 UTC (rev 23)
@@ -0,0 +1,11 @@
+Package: RQDA
+Type: Package
+Title: Qualitative data analysis
+Version: 0.1.3
+Date: 2008-11-01
+Author: Huang Ronggui
+Maintainer: Huang <ronggui.huang at gmail.com>
+Depends: DBI, RSQLite, RGtk2, gWidgets, gWidgetsRGtk2
+Description: Qualitative Data Analysis based on R language. Current version only supports plain text.
+License: Non-commercial use only.
+LazyLoad: yes
Added: tags/0.1.3/R/codes.R
===================================================================
--- tags/0.1.3/R/codes.R (rev 0)
+++ tags/0.1.3/R/codes.R 2008-11-29 11:25:50 UTC (rev 23)
@@ -0,0 +1,115 @@
+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)
+ write <- FALSE
+ if (nextid==1){
+ write <- TRUE
+ } else {
+ allnames <- RSQLite:::sqliteQuickColumn(con,"freecode","name")
+ if (!any(name==allnames)) {
+ 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)
+ }
+}
+
+
+
+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){})
+}
+
+
+
+mark <- function(widget){
+ index <- sindex(widget)
+ startI <- index$startI ## start and end iter
+ endI <- index$endI
+ selected <- index$seltext
+ 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.
+ 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){})
+}
+
+
+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){})
+}
+
+
+
+sindex <- function(widget){
+ buffer <- slot(widget,"widget")@widget$GetBuffer()
+ bounds = buffer$GetSelectionBounds()
+ startI = bounds$start ## start and end iter
+ endI = bounds$end
+ selected <- buffer$GetText(startI,endI)
+ startN <- gtkTextIterGetOffset(startI) # translate iter pointer to number
+ endN <- gtkTextIterGetOffset(endI)
+ return(list(startI=startI,endI=endI,
+ startN=startN,endN=endN,seltext=selected))
+}
+
+
+
+retrieval <- function(currentCid,conName,env,currentCode="currentCode",assignenv=.rqda){
+ currentCid <- get(currentCid,env)
+ currentCode <- get(currentCode,env)
+ con <- get(conName,env)
+ retrieval <- dbGetQuery(con,sprintf("select cid,fid, seltext from coding where status==1 and cid=%i",currentCid))
+ fid <- unique(retrieval$fid)
+ .gw <- gwindow(title=sprintf("Retrieved text: %s",currentCode),parent=c(270,10),width=600,height=600)
+ .retreivalgui <- gtext(con=.gw)
+ for (i in fid){
+ fname <- paste("Source: ", .rqda$files_index$name[.rqda$files_index$id==i], sep="")
+ seltext <- retrieval$seltext[retrieval$fid==i]
+ ##seltext <- gsub("\n","", seltext,fixed=TRUE)
+ seltext <- paste(seltext,collapse="\n\n")
+ Encoding(seltext) <- "UTF-8"
+ add(.retreivalgui,fname,font.attr=c(style="italic",size="x-large"))
+ add(.retreivalgui,"\n",font.attr=c(style="italic"))
+ add(.retreivalgui,seltext,font.attr=c(style="normal",size="large"))
+ add(.retreivalgui,"\n",font.attr=c(style="italic"))
+ }
+}
+
Added: tags/0.1.3/R/deletion.R
===================================================================
--- tags/0.1.3/R/deletion.R (rev 0)
+++ tags/0.1.3/R/deletion.R 2008-11-29 11:25:50 UTC (rev 23)
@@ -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
+ ##}
+ }
+ }
+ }
+}
+
+
+
Added: tags/0.1.3/R/files.R
===================================================================
--- tags/0.1.3/R/files.R (rev 0)
+++ tags/0.1.3/R/files.R 2008-11-29 11:25:50 UTC (rev 23)
@@ -0,0 +1,63 @@
+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")
+ content <- enc(content)
+ maxid <- dbGetQuery(con,"select max(id) from source")[[1]]
+ nextid <- ifelse(is.na(maxid),0+1, maxid+1)
+ write <- FALSE
+ ## 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!")
+ }
+ }
+ 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)
+ }
+ }
+}
+
+
+
+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.
+ 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
+}
+
+enc <- function(x) gsub("'", "''", x)
+## replace " with two '. to make insert smoothly.
Added: tags/0.1.3/R/project.R
===================================================================
--- tags/0.1.3/R/project.R (rev 0)
+++ tags/0.1.3/R/project.R 2008-11-29 11:25:50 UTC (rev 23)
@@ -0,0 +1,88 @@
+new_proj <- function(path, conName="qdacon",assignenv=.rqda,...){
+ sucess <- file.create(tmpNamme <- tempfile(pattern = "file", tmpdir = dirname(path)))
+ if (!sucess) {
+ gmessage("No write permission.",icon="error",container=TRUE)
+ }
+ else{
+ unlink(tmpNamme)
+ 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.
+ 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")
+ ## 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")
+ ## 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")
+ ## 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")
+ ## 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")
+ ## 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){})
+ ## Fist close the con if it exist, then open a new con.
+ assign(conName, dbConnect(drv=dbDriver("SQLite"),dbname=path),envi=assignenv)
+}
+
+
+
+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)
+ }
+ }
+ } ,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)
+ } ,error=function(e){})
+ if (!open & message) gmessage("No Project is Open.",icon="warning",con=TRUE)
+ return(open)
+}
Added: tags/0.1.3/R/root_gui.R
===================================================================
--- tags/0.1.3/R/root_gui.R (rev 0)
+++ tags/0.1.3/R/root_gui.R 2008-11-29 11:25:50 UTC (rev 23)
@@ -0,0 +1,554 @@
+RQDA <- function() {
+########################### aux functions
+###########################
+ 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)
+ )
+
+
+ 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)
+
+
+
+########################### 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)}
+ },
+ 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)
+ )
+
+
+ ".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)
+ }
+ },
+ action=list(env=.rqda,conName="qdacon")
+ )
+
+
+ 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)
+
+
+
+########################### GUI for FILES
+###########################
+ ".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"))
+
+
+
+ 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)
+ 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(" 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")
+ )
+
+
+ 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("File 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
+ )
+ )
+ }
+ )
+ 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)
+ )
+
+
+
+########################### GUI for CODES
+###########################
+ ".codes_pan" <- gpanedgroup(container=.nb_rqdagui,horizontal=FALSE,label="Codes")
+ ".codes_button" <- glayout(container=.codes_pan)
+
+
+ .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)
+ )
+ }
+ },
+ 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
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/rqda -r 23
More information about the Rqda-commits
mailing list