[Rqda-commits] r17 - pkg pkg/R pkg/man www
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sat Nov 22 06:13:45 CET 2008
Author: wincent
Date: 2008-11-22 06:13:45 +0100 (Sat, 22 Nov 2008)
New Revision: 17
Added:
pkg/R/CodeCatButton.R
www/Main2.png
Modified:
pkg/ChangeLog
pkg/R/CaseButton.R
pkg/R/CodesFun.R
pkg/R/Coding_Buttons.R
pkg/R/GUIHandler.R
pkg/R/ProjectButton.R
pkg/R/Rename.R
pkg/R/root_gui.R
pkg/TODO
pkg/man/RQDA-package.Rd
www/Main.png
www/index.html
Log:
Modified: pkg/ChangeLog
===================================================================
--- pkg/ChangeLog 2008-11-20 06:53:23 UTC (rev 16)
+++ pkg/ChangeLog 2008-11-22 05:13:45 UTC (rev 17)
@@ -1,3 +1,13 @@
+2008-11-22
+ * change "Add Code Category" Button to popup menu
+ * Open selected file by double click.
+ * Retrieve coding chuck by double click.
+ * Add/rename/delete Buttons for Code-Category.
+
+2008-11-21
+ * Add WebSearch Case button (for convienence)
+ * Add "Add Code Category" Button
+
2008-11-19 (as verion 0.1.4)
* Add project memo
* rename of file/free code names
Modified: pkg/R/CaseButton.R
===================================================================
--- pkg/R/CaseButton.R 2008-11-20 06:53:23 UTC (rev 16)
+++ pkg/R/CaseButton.R 2008-11-22 05:13:45 UTC (rev 17)
@@ -1,3 +1,15 @@
+CaseNamesUpdate <- function(CaseNamesWidget=.rqda$.CasesNamesWidget,...)
+{
+ if (isIdCurrent(.rqda$qdacon)){
+ CaseName <- dbGetQuery(.rqda$qdacon, "select name, id from cases where status=1")
+ if (nrow(CaseName)!=0) {
+ Encoding(CaseName[['name']]) <- "UTF-8"
+ tryCatch(CaseNamesWidget[] <- CaseName[['name']], error=function(e){})
+ }}
+}
+
+#################
+
AddCaseButton <- function(label="ADD"){
gbutton(label,handler=function(h,...) {
if (is_projOpen(env=.rqda,conName="qdacon")) {
@@ -72,17 +84,7 @@
}
}
-CaseNamesUpdate <- function(CaseNamesWidget=.rqda$.CasesNamesWidget,...)
-{
- CaseName <- dbGetQuery(.rqda$qdacon, "select name, id from cases where status=1")
- if (nrow(CaseName)!=0) {
- Encoding(CaseName[['name']]) <- "UTF-8"
- tryCatch(CaseNamesWidget[] <- CaseName[['name']], error=function(e){})
- }
-}
-
-
CaseMark_Button<-function(){
gbutton("Mark",
handler=function(h,...) {
@@ -149,4 +151,44 @@
)
}
+AddWebSearchButton <- function(label="WebSearch",CaseNamesWidget=.rqda$.CasesNamesWidget){
+ gbutton(label,handler=function(h,...) {
+ if (is_projOpen(env=.rqda,conName="qdacon")) {
+ KeyWord <- svalue(CaseNamesWidget)
+ engine <- select.list(c("Baidu","Google","Yahoo"))
+ if (engine=="Baidu") {
+ KeyWord <- iconv(KeyWord, from="UTF-8")
+ browseURL(sprintf("http://www.baidu.com/s?wd=%s",paste("%",paste(charToRaw(KeyWord),sep="",collapse="%"),sep="",collapse="")))
+ }
+ if (engine=="Yahoo") {
+ KeyWord <- iconv(KeyWord, from="UTF-8")
+ browseURL(sprintf("http://search.yahoo.com/search;_ylt=A0oGkmFV.CZJNssAOK.l87UF?p=%s&ei=UTF-8&iscqry=&fr=sfp&fr2=sfp"
+ ,KeyWord))
+ }
+ if (engine=="Google")browseURL(sprintf("http://www.google.com/search?q=%s",KeyWord))
+ }
+ }
+ )
+}
+CaseNamesWidgetMenu <- list()
+CaseNamesWidgetMenu$WebSearch$Baidu$handler <- function(h,...){
+ KeyWord <- svalue(.rqda$.CasesNamesWidget)
+ KeyWord <- iconv(KeyWord, from="UTF-8")
+ browseURL(sprintf("http://www.baidu.com/s?wd=%s",paste("%",paste(charToRaw(KeyWord),sep="",collapse="%"),sep="",collapse="")))
+}
+CaseNamesWidgetMenu$WebSearch$Google$handler <- function(h,...){
+ KeyWord <- svalue(.rqda$.CasesNamesWidget)
+ KeyWord <- iconv(KeyWord, from="UTF-8")
+ browseURL(sprintf("http://www.google.com/search?q=%s",KeyWord))
+}
+CaseNamesWidgetMenu$WebSearch$Yahoo$handler <- function(h,...){
+ KeyWord <- svalue(.rqda$.CasesNamesWidget)
+ KeyWord <- iconv(KeyWord, from="UTF-8")
+ browseURL(sprintf("http://search.yahoo.com/search;_ylt=A0oGkmFV.CZJNssAOK.l87UF?p=%s&ei=UTF-8&iscqry=&fr=sfp&fr2=sfp"
+ ,KeyWord))
+}
+
+
+
+
Added: pkg/R/CodeCatButton.R
===================================================================
--- pkg/R/CodeCatButton.R (rev 0)
+++ pkg/R/CodeCatButton.R 2008-11-22 05:13:45 UTC (rev 17)
@@ -0,0 +1,103 @@
+### UpdateTableWidget() and AddTodbTable() are generall version of the previous functions
+UpdateTableWidget <- function(Widget,FromdbTable,con=.rqda$qdacon,...)
+{
+ if (isIdCurrent(con)){
+ items <- dbGetQuery(con, sprintf("select name from %s where status=1",FromdbTable))
+ if (nrow(items)!=0) {
+ items <- items[['name']]
+ Encoding(items) <- "UTF-8"
+ } else items <- NULL
+ tryCatch(eval(substitute(W[] <- items,list(W=quote(Widget)))), error=function(e){})
+ }
+}
+
+
+AddTodbTable <- function(item,dbTable,Id="id",field="name",con=.rqda$qdacon,...) {
+ if (item != ""){
+ maxid <- dbGetQuery(con,sprintf("select max(%s) from %s",Id, dbTable))[[1]]
+ nextid <- ifelse(is.na(maxid),0+1, maxid+1)
+ write <- FALSE
+ if (nextid==1){
+ write <- TRUE
+ } else {
+ dup <- dbGetQuery(con,sprintf("select %s from %s where name=='%s'",field, dbTable, item))
+ if (nrow(dup)==0) write <- TRUE
+ }
+ if (write ) {
+ dbGetQuery(con,sprintf("insert into %s (%s, %s, status,date,owner)
+ values ('%s', %i, %i,%s, %s)",dbTable,field,Id,
+ item,nextid, 1, shQuote(date()),shQuote(.rqda$owner)))
+ }
+ }
+}
+
+
+#################
+AddCodeCatButton <- function(label="ADD"){
+ gbutton(label,handler=function(h,...) {
+ if (is_projOpen(env=.rqda,conName="qdacon")) {
+ item <- ginput("Enter new Code Category. ", icon="info")
+ Encoding(item) <- "UTF-8"
+ AddTodbTable(item,"codecat",Id="catid") ## CODE CATegory
+ UpdateTableWidget(Widget=.rqda$.CodeCatWidget,FromdbTable="codecat")
+ }
+ }
+ )
+}
+
+
+DeleteCodeCatButton <- function(label="Delete"){
+ gbutton(label,
+ handler=function(h,...)
+ {
+ if (is_projOpen(env=.rqda,conName="qdacon") &
+ length(svalue(.rqda$.CodeCatWidget))!=0) {
+ del <- gconfirm("Really delete the Code Category?",icon="question")
+ if (isTRUE(del)){
+ Selected <- svalue(.rqda$.CodeCatWidget)
+ Encoding(Selected) <- "UTF-8"
+ catid <- dbGetQuery(.rqda$qdacon,sprintf("select catid from codecat where status==1 and name=='%s'",Selected))[,1]
+ if (length(catid) ==1){
+ dbGetQuery(.rqda$qdacon,sprintf("update codecat set status=0 where name=='%s'",Selected))
+ ## set status in table freecode to 0
+ UpdateTableWidget(Widget=.rqda$.CodeCatWidget,FromdbTable="codecat")
+ tryCatch(dbGetQuery(.rqda$qdacon,sprintf("update treecode set status=0 where cid=='%s'",catid)),error=function(e){})
+ } else gmessage("The Category Name is not unique.",con=T)
+
+ }
+ }
+ }
+ )
+}
+
+
+CodeCat_RenameButton <- function(label="Rename",Widget=.rqda$.CodeCatWidget,...)
+{
+ ## rename of selected code cat.
+ gbutton(label,handler=function(h,...) {
+ if (is_projOpen(env=.rqda,"qdacon")) {
+ ## if project is open, then continue
+ OldName <- svalue(Widget)
+ if (length(OldName)==0){
+ gmessage("Select a Code Category first.",icon="error",con=TRUE)
+ }
+ else {
+ ## get the new file names
+ NewName <- ginput("Enter new Cateory name. ", icon="info")
+ Encoding(NewName) <- "UTF-8"
+ rename(OldName,NewName,"codecat")
+ UpdateTableWidget(Widget=.rqda$.CodeCatWidget,FromdbTable="codecat")
+ }
+ }
+ }
+ )
+}
+
+CodeCatAddToButton <- function(label="AddTo",Widget=.rqda$.CodeCatWidget,...)
+{
+ gbutton(label,handler=function(h,...) {
+ Selected <- select.list()
+}
+)
+}
+
Modified: pkg/R/CodesFun.R
===================================================================
--- pkg/R/CodesFun.R 2008-11-20 06:53:23 UTC (rev 16)
+++ pkg/R/CodesFun.R 2008-11-22 05:13:45 UTC (rev 17)
@@ -42,22 +42,24 @@
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
+ # buffer$createTag("blue.foreground",foreground = "blue")
+ # buffer$ApplyTagByName("blue.foreground",startI,endI)
+ buffer$createTag("red.background",list(foreground = "red")) ## better, it can mark space
+ buffer$ApplyTagByName("red.background",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)},
+# gtkTextBufferRemoveTagByName(buffer,"red.foreground",startI,endI)},
+ gtkTextBufferRemoveTagByName(buffer,"red.background",startI,endI)},
+
error=function(e){})
}
@@ -71,8 +73,10 @@
buffer <- slot(W,"widget")@widget$GetBuffer()
start <-gtkTextBufferGetIterAtOffset(buffer,x[1])$iter # translate number back to iter
end <-gtkTextBufferGetIterAtOffset(buffer,x[2])$iter
- buffer$createTag("red.foreground",foreground = "red")
- buffer$ApplyTagByName("red.foreground",start,end)}),
+# buffer$createTag("red.foreground",foreground = "red")
+# buffer$ApplyTagByName("red.foreground",start,end)}),
+ buffer$createTag("red.background",background = "red")
+ buffer$ApplyTagByName("red.background",start,end)}),
error=function(e){})
}
Modified: pkg/R/Coding_Buttons.R
===================================================================
--- pkg/R/Coding_Buttons.R 2008-11-20 06:53:23 UTC (rev 16)
+++ pkg/R/Coding_Buttons.R 2008-11-22 05:13:45 UTC (rev 17)
@@ -1,5 +1,5 @@
-AddCodeButton <- function(){
- gbutton(" ADD ",
+AddCodeButton <- function(label="Add"){
+ gbutton(label,
handler=function(h,...) {
if (is_projOpen(env=.rqda,conName="qdacon")) {
codename <- ginput("Enter new code. ", icon="info")
Modified: pkg/R/GUIHandler.R
===================================================================
--- pkg/R/GUIHandler.R 2008-11-20 06:53:23 UTC (rev 16)
+++ pkg/R/GUIHandler.R 2008-11-22 05:13:45 UTC (rev 17)
@@ -30,6 +30,30 @@
)
+ addhandlerdoubleclick(.rqda$.fnames_rqda, handler <- function(h,...)
+ ##function copied from ViewFileButton handler
+ {
+ if (is_projOpen(env=.rqda,conName="qdacon")) {
+ if (length(svalue(.rqda$.fnames_rqda))==0){gmessage("Select a file first.",icon="error",con=TRUE)}
+ else {
+ tryCatch(dispose(.rqda$.root_edit),error=function(e) {})
+ ## notice the error handler
+ assign(".root_edit",gwindow(title=svalue(.rqda$.fnames_rqda), parent=c(370,10),width=600,height=600),env=.rqda)
+ .root_edit <- get(".root_edit",.rqda)
+ assign(".openfile_gui",gtext(container=.root_edit,font.attr=c(sizes="large")),env=.rqda)
+ content <- dbGetQuery(.rqda$qdacon, sprintf("select file from source where name='%s'",svalue(.rqda$.fnames_rqda)))[1,1]
+ Encoding(content) <- "UTF-8" ## so it display correct in the gtext widget
+ ## turn data.frame to 1-length character.
+ W <- get(".openfile_gui",.rqda)
+ add(W,content,font.attr=c(sizes="large"))
+ slot(W,"widget")@widget$SetEditable(FALSE)
+ ## make sure it is read only file in the text window.
+ }
+ }
+ }##end of function copied from ViewFileButton handler
+ )
+
+
## handler for .codes_rqda
addHandlerMouseMotion(.rqda$.codes_rqda, handler <- function(h, ...) {
@@ -39,6 +63,10 @@
}
)
+ addhandlerdoubleclick(.rqda$.codes_rqda,handler=function(h,...) {
+ if (is_projOpen(env=.rqda,conName="qdacon")) retrieval()
+ }
+ )
addHandlerClicked(.rqda$.codes_rqda,handler <- function(h,...){
@@ -108,5 +136,7 @@
)
+add3rdmousepopupmenu(.rqda$.CasesNamesWidget, CaseNamesWidgetMenu)
+## popup menu by right-click on CaseNamesWidget
}
Modified: pkg/R/ProjectButton.R
===================================================================
--- pkg/R/ProjectButton.R 2008-11-20 06:53:23 UTC (rev 16)
+++ pkg/R/ProjectButton.R 2008-11-22 05:13:45 UTC (rev 17)
@@ -1,3 +1,57 @@
+NewProjectButton <- function(container=.proj_gui){
+gbutton("New Project",container=container,handler=function(h,...){
+ path=gfile(type="save")
+ if (path!=""){
+ ## if path="", then click "cancel".
+ Encoding(path) <- "UTF-8"
+ new_proj(path,assignenv=.rqda)}
+ }
+ )
+}
+
+OpenProjectButton <- function(container=.proj_gui){
+gbutton("Open Project",container=container,handler=function(h,...){
+ path <- gfile(type="open",filter=list("rqda"=list(patterns = c("*.rqda","*.*"))))
+ if (path!=""){
+ Encoding(path) <- "UTF-8"
+ open_proj(path,assignenv=.rqda)
+ tryCatch(CodeNamesUpdate(),error=function(e){})
+ tryCatch(FileNamesUpdate(),error=function(e){})
+ tryCatch(CaseNamesUpdate(),error=function(e){})
+ tryCatch(UpdateTableWidget(Widget=.rqda$.CodeCatWidget,FromdbTable="codecat"),error=function(e){})
+
+ }
+ }
+ )
+}
+
+
+CloseProjectButton <- function(container=.proj_gui){
+gbutton("Close Project",container=container,handler=function(h,...){
+ close_proj(assignenv=.rqda)
+ tryCatch(.rqda$.codes_rqda[]<-NULL,error=function(e){})
+ tryCatch(.rqda$.fnames_rqda[]<-NULL,error=function(e){})
+ tryCatch(.rqda$.CasesNamesWidget[]<-NULL,error=function(e){})
+ tryCatch(UpdateTableWidget(Widget=.rqda$.CodeCatWidget,FromdbTable="codecat"),error=function(e){})
+ }
+ )
+
+}
+
+ProjectInforButton <- function(container=.proj_gui){
+gbutton("Current Project",container=container,handler=function(h,...){
+ if (is_projOpen(env=.rqda,conName="qdacon")) {
+ con <- .rqda$qdacon
+ 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")
+ )
+}
+
+
Proj_MemoButton <- function(label="Porject Memo",container=.proj_gui,...){
#### Each button a separate function -> more easy to debug, and the main function root_gui is shorter.
### The memo in dataset is UTF-8
Modified: pkg/R/Rename.R
===================================================================
--- pkg/R/Rename.R 2008-11-20 06:53:23 UTC (rev 16)
+++ pkg/R/Rename.R 2008-11-22 05:13:45 UTC (rev 17)
@@ -1,4 +1,4 @@
-rename <- function(from,to,table=c("source","freecode","cases")){
+rename <- function(from,to,table=c("source","freecode","cases","codecat")){
## rename name field in table source and freecode (other tables can be added futher)
## source is the file name, freecode is the free code name
## should check it there is any dupliation in the table????????????????????????????????
Modified: pkg/R/root_gui.R
===================================================================
--- pkg/R/root_gui.R 2008-11-20 06:53:23 UTC (rev 16)
+++ pkg/R/root_gui.R 2008-11-22 05:13:45 UTC (rev 17)
@@ -24,60 +24,19 @@
########################### 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=.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=.rqda)
- tryCatch(CodeNamesUpdate(),error=function(e){})
- tryCatch(FileNamesUpdate(),error=function(e){})
- tryCatch(CaseNamesUpdate(),error=function(e){})
- }
- }
- )
-
+ ".newproj_gui" <- NewProjectButton(container=.proj_gui)
+ ".open.proj_gui" <- OpenProjectButton(container=.proj_gui)
".project_memo" <- Proj_MemoButton(label = "Porject Memo", container = .proj_gui)
## project memo button
-
- ".close.proj_gui" <- gbutton("Close Project",container=.proj_gui,handler=function(h,...){
- close_proj(assignenv=.rqda)
- tryCatch(.rqda$.codes_rqda[]<-NULL,error=function(e){})
- tryCatch(.rqda$.fnames_rqda[]<-NULL,error=function(e){})
- tryCatch(.rqda$.CasesNamesWidget[]<-NULL,error=function(e){})
- }
- )
+ ".close.proj_gui" <- CloseProjectButton(container=.proj_gui)
+ ".projinfo_gui" <- ProjectInforButton(container=.proj_gui)
-
- ".projinfo_gui" <- gbutton("Current Project",container=.proj_gui,handler=function(h,...){
- if (is_projOpen(env=.rqda,conName="qdacon")) {
- con <- .rqda$qdacon
- 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. Import files.\n
3. 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",
+Author: <ronggui.huang at gmail.com>\n",
container=.proj_gui)
@@ -88,6 +47,7 @@
".files_button" <- ggroup(container=.files_pan,horizontal=TRUE)
".fnames_rqda" <- gtable("Click Here to see the File list.",container=.files_pan)
.fnames_rqda[] <-NULL # get around of the text argument.
+ names(.fnames_rqda) <- "Files"
ImportFileButton("Import",con=.files_button)
DeleteFileButton("Delete",con=.files_button)
ViewFileButton("Open",con=.files_button)
@@ -102,7 +62,7 @@
".codes_pan" <- gpanedgroup(container=.nb_rqdagui,horizontal=FALSE,label="Codes")
".codes_button" <- glayout(container=.codes_pan)
".codes_rqda" <- gtable("Please click Update",container=.codes_pan)
- .codes_rqda[] <- NULL
+ .codes_rqda[] <- NULL ;names(.codes_rqda) <- "Codes List"
.codes_button[1,1]<- AddCodeButton()
.codes_button[1,2]<- DeleteCodeButton()
.codes_button[1,3] <- FreeCode_RenameButton(label="Rename",CodeNamesWidget=.codes_rqda)
@@ -113,8 +73,7 @@
.codes_button[2,3]<- RetrievalButton(label="Extend")
.codes_button[2,4]<- Unmark_Button()
.codes_button[2,5]<- Mark_Button()
-
-
+
######################### GUI for cases
#########################
".case_pan" <- gpanedgroup(container=.nb_rqdagui,horizontal=FALSE,label="Case")
@@ -126,15 +85,28 @@
.case_buttons[1,3] <- Case_RenameButton()
.case_buttons[1,4] <- CaseMark_Button()
.case_buttons[1,5] <- CaseMemoButton()
+ ##.case_buttons[2,3] <- AddWebSearchButton("WebSearch") # use popup menu instead
+
+######################### GUI for C-cat
+#########################
+ ".codecat_pan" <- gpanedgroup(container=.nb_rqdagui,horizontal=FALSE,label="C-Cat")
+ ".codecat_buttons" <- glayout(container=.codecat_pan)
+ ".Ccat_PW" <- ggroup(cont=.codecat_pan,horizontal = FALSE)## parent Widget of C-cat
+ ".CodeCatWidget" <- gtable("Please click Update",container=.Ccat_PW,expand=TRUE)
+ .CodeCatWidget[] <- NULL; names(.CodeCatWidget)<-"Code Category"
+ ".CodeofCat" <- gtable("Please click Update",container=.Ccat_PW,expand=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,4] <- gbutton("AddTo")
+ .codecat_buttons[1,5] <- gbutton("DropFrom")
+
######################### GUI for F-cat
#########################
".fcat_gui" <- ggroup(container=.nb_rqdagui,horizontal=FALSE,label="F-Cat")
-######################### GUI for C-cat
-#########################
- ".codecat_gui" <- ggroup(container=.nb_rqdagui,horizontal=FALSE,label="C-Cat")
-
######################### GUI for settings
#########################
".settings_gui" <- ggroup(container=.nb_rqdagui,horizontal=FALSE,label="Settings")
@@ -152,8 +124,15 @@
assign(".codes_rqda",.codes_rqda,env=.rqda)
assign(".fnames_rqda",.fnames_rqda,env=.rqda)
assign(".CasesNamesWidget",.CasesNamesWidget,env=.rqda)
-
+assign(".CodeCatWidget",.CodeCatWidget,env=.rqda)
+
##########################
+### set the positions
+svalue(.codes_pan) <- 0.1
+svalue(.codecat_pan)<-0.035
+svalue(.case_pan)<-0.035
+
+##########################
Handler()
}
## end of function RQDA
Modified: pkg/TODO
===================================================================
--- pkg/TODO 2008-11-20 06:53:23 UTC (rev 16)
+++ pkg/TODO 2008-11-22 05:13:45 UTC (rev 17)
@@ -4,8 +4,9 @@
summary functions for review of coding.
+better display coding chuck.
+Extended coding chuck.
+
### less important
should add document on the table structure.
-
-set info about owner and date (basically done)
\ No newline at end of file
Modified: pkg/man/RQDA-package.Rd
===================================================================
--- pkg/man/RQDA-package.Rd 2008-11-20 06:53:23 UTC (rev 16)
+++ pkg/man/RQDA-package.Rd 2008-11-22 05:13:45 UTC (rev 17)
@@ -15,7 +15,7 @@
Version: \tab 0.1\cr
Date: \tab 2008-05-11\cr
Depends: \tab DBI, RSQLite, RGtk2, gWidgets, gWidgetsRGtk2\cr
-License: \tab Non-commercial use only.\cr
+License: \tab FreeBSD\cr
LazyLoad: \tab yes\cr
}
%% description of the package
Modified: www/Main.png
===================================================================
(Binary files differ)
Added: www/Main2.png
===================================================================
(Binary files differ)
Property changes on: www/Main2.png
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Modified: www/index.html
===================================================================
--- www/index.html 2008-11-20 06:53:23 UTC (rev 16)
+++ www/index.html 2008-11-22 05:13:45 UTC (rev 17)
@@ -51,10 +51,12 @@
<li>Import documents from plain text
<li>Support non-English documents, Simplified Chinese Character is well-tested under Windows
<li>Character-level coding using codes
-<li>Memos of documents and codes
+<li>Memos of documents, codes, coding, project, files and more.
<li>Retrieval of coding
<li>Single-file (*.rqda) format, which is basically SQLite database
<li>Temporary deletion of files and codes
+<li>There is a case category, which is crucial feature to bridge qualitative and quantative research.
+<li>Facilitator helps to categorize codes,which is key to theory building. I deliberately avoid using tree-like categorization.
<BR><BR>By R functions, it can:
<li>Show the temporary deletion files and codes
@@ -80,16 +82,17 @@
<li>Install relevant packages by R command: <I><B>install.packages(c("DBI","RSQLite","RGtk2","gWidgets","gWidgetsRGtk2"))</B></I>
-<li>Install RQDA package: For Linux/BSD, use command:
+<li>Install RQDA package: use command:
<B><I>install.packages("RQDA",repos="http://R-Forge.R-project.org")</B></I>.
-For Windows, manually download the package of <A HREF="http://rqda.r-forge.r-project.org/RQDA_0.1.3.zip">RQDA(0.1.3)</A>,
-then install it by clicking the menu: “Packages”
-– “Install package(s) from local zip files... ”.
<li>Launch RQDA by command <I><B>library(RQDA)</B></I> from within R. Then you can see the RQDA GUI.
-<P ALIGN=LEFT STYLE="margin-bottom: 0cm"><IMG SRC="Main.png" NAME="Main GUI" ALIGN=LEFT WIDTH=680 HEIGHT=488 BORDER=0><BR CLEAR=LEFT><BR>
+<P ALIGN=LEFT STYLE="margin-bottom: 0cm"><IMG SRC="Main.png" NAME="Main GUI" ALIGN=LEFT BORDER=0><BR CLEAR=LEFT><BR>
</P>
+
+<P ALIGN=LEFT><FONT FACE="Times New Roman, serif"><SPAN LANG="en-US"><B>Reference</B></SPAN></FONT></P>
+<li> Kelle, U. (ed.).1995."Computer-aided qualitative data analysis : theory, methods and practice." Sage Publications.
+
<P ALIGN=LEFT><FONT FACE="Times New Roman, serif"><SPAN LANG="en-US"><B>More
information?</B></SPAN></FONT></P>
<P ALIGN=LEFT><FONT FACE="Times New Roman, serif"><SPAN LANG="en-US"><FONT FACE="Times New Roman, serif"><SPAN LANG="en-US">
More information about the Rqda-commits
mailing list