[Rqda-commits] r37 - pkg pkg/R pkg/man www

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Sun Dec 7 03:15:55 CET 2008


Author: wincent
Date: 2008-12-07 03:15:54 +0100 (Sun, 07 Dec 2008)
New Revision: 37

Modified:
   pkg/ChangeLog
   pkg/DESCRIPTION
   pkg/R/CaseButton.R
   pkg/R/ProjectButton.R
   pkg/R/ProjectFun.R
   pkg/R/root_gui.R
   pkg/man/RQDA-internal.rd
   www/ChangeLog.txt
Log:


Modified: pkg/ChangeLog
===================================================================
--- pkg/ChangeLog	2008-12-06 10:03:43 UTC (rev 36)
+++ pkg/ChangeLog	2008-12-07 02:15:54 UTC (rev 37)
@@ -1,3 +1,8 @@
+2008-12-07
+	* Better handler the issue of write permission in new project and open project button
+	* new function/button to backup project
+	* fix bug in close project button
+	
 2008-12-06 (rc2 of v1.6)
 	* bugfix of Freecode rename button and others.
 	* Memo in Popup menu in Files Tab.

Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION	2008-12-06 10:03:43 UTC (rev 36)
+++ pkg/DESCRIPTION	2008-12-07 02:15:54 UTC (rev 37)
@@ -1,7 +1,7 @@
 Package: RQDA
 Type: Package
 Title: Qualitative Data Analysis
-Version: 0.1.5-36
+Version: 0.1.5-37
 Date: 2008-11-01
 Author: HUANG Ronggui
 Maintainer: HUANG Ronggui <ronggui.huang at gmail.com>

Modified: pkg/R/CaseButton.R
===================================================================
--- pkg/R/CaseButton.R	2008-12-06 10:03:43 UTC (rev 36)
+++ pkg/R/CaseButton.R	2008-12-07 02:15:54 UTC (rev 37)
@@ -250,13 +250,6 @@
 CaseNamesWidgetMenu$"Sort by created time"$handler <- function(h,...){
 CaseNamesUpdate(.rqda$.CasesNamesWidget)
 }
-CaseNamesWidgetMenu$"Web Search"$Baidu$handler <- function(h,...){
-  KeyWord <- svalue(.rqda$.CasesNamesWidget)
-  if (length(KeyWord)!=0){
-    KeyWord <- iconv(KeyWord, from="UTF-8")
-    browseURL(sprintf("http://www.baidu.com/s?wd=%s",paste("%",paste(charToRaw(KeyWord),sep="",collapse="%"),sep="",collapse="")))
-  }
-}
 CaseNamesWidgetMenu$"Web Search"$Google$handler <- function(h,...){
   KeyWord <- svalue(.rqda$.CasesNamesWidget)
   if (length(KeyWord)!=0){
@@ -272,6 +265,20 @@
                       ,KeyWord))
   }
 }
+CaseNamesWidgetMenu$"Web Search"$Baidu$handler <- function(h,...){
+  KeyWord <- svalue(.rqda$.CasesNamesWidget)
+  if (length(KeyWord)!=0){
+    KeyWord <- iconv(KeyWord, from="UTF-8")
+    browseURL(sprintf("http://www.baidu.com/s?wd=%s",paste("%",paste(charToRaw(KeyWord),sep="",collapse="%"),sep="",collapse="")))
+  }
+}
+CaseNamesWidgetMenu$"Web Search"$Sogou$handler <- function(h,...){
+  KeyWord <- svalue(.rqda$.CasesNamesWidget)
+  if (length(KeyWord)!=0){
+    KeyWord <- iconv(KeyWord, from="UTF-8")
+    browseURL(sprintf("http://www.sogou.com/sohu?query=%s",paste("%",paste(charToRaw(KeyWord),sep="",collapse="%"),sep="",collapse="")))
+  }
+}
 
 
 ## pop-up menu of .rqda$.FileofCase

Modified: pkg/R/ProjectButton.R
===================================================================
--- pkg/R/ProjectButton.R	2008-12-06 10:03:43 UTC (rev 36)
+++ pkg/R/ProjectButton.R	2008-12-07 02:15:54 UTC (rev 37)
@@ -35,10 +35,10 @@
       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){})
-      tryCatch(UpdateCodeofCatWidget(),error=function(e){})
-      tryCatch(UpdateTableWidget(Widget=.rqda$.FileCatWidget,FromdbTable="filecat"),error=function(e){})
-      tryCatch(UpdateFileofCatWidget(),error=function(e){})
+      tryCatch(.rqda$.CodeCatWidget[]<-NULL,error=function(e){})
+      tryCatch(.rqda$.CodeofCat[]<-NULL,error=function(e){})
+      tryCatch(.rqda$.FileCatWidget[]<-NULL,error=function(e){})
+      tryCatch(.rqda$.FileofCat[]<-NULL,error=function(e){})
       close_proj(assignenv=.rqda)
       }
                                )
@@ -58,7 +58,16 @@
                              )
 }
 
+BackupProjectButton <- function(container){
+gbutton("Backup Project",container=container,handler=function(h,...){
+    if (is_projOpen(env=.rqda,conName="qdacon")) {
+      backup_proj(con=.rqda$qdacon)
+    }
+  }
+        )
+}
 
+
 Proj_MemoButton <- function(label="Porject Memo",container,...){
 #### 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/ProjectFun.R
===================================================================
--- pkg/R/ProjectFun.R	2008-12-06 10:03:43 UTC (rev 36)
+++ pkg/R/ProjectFun.R	2008-12-07 02:15:54 UTC (rev 37)
@@ -1,16 +1,25 @@
 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)))
+  sucess <- (file.access(names=dirname(path),mode=2)==0)
   if (!sucess) {
     gmessage("No write permission.",icon="error",container=TRUE) 
   }
   else{
-    unlink(tmpNamme)
+    ## 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 <- file.exists(path)) {
+      ## if there exists a file, should ask; and test if have write access to overwrite it.
+      override <- gconfirm("Over write existing project?",icon="warning")
+      if (file.access(path, 2) != 0 && override) {
+        override <- FALSE
+        gmessage("You have no write permission to overwrite it.",con=TRUE,icon="error")
+      }
+    }
     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)
       
@@ -73,8 +82,15 @@
            },
            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)
+  if (file.access(path, 2) == 0) {
+    assign(conName, dbConnect(drv=dbDriver("SQLite"),dbname=path),envi=assignenv)
+  } else if (file.access(path, 4) == 0){
+    assign(conName, dbConnect(drv=dbDriver("SQLite"),dbname=path),envi=assignenv)
+    gmessage("You don't have write access to the *.rqda file. You can only read the project.",con=TRUE,icon="warning")
+  } else {
+    gmessage("You don't have read access to the *.rqda file. Fail to open.",con=TRUE,icon="error")
 }
+}
 
 
 
@@ -101,3 +117,13 @@
   if (!open & message) gmessage("No Project is Open.",icon="warning",con=TRUE)
   return(open)
 }
+
+backup_proj <- function(con){
+## con=.rqda$qdacon
+dbname <- dbGetInfo(con)$dbname
+backupname <- sprintf("%s_%s",dbname,format(Sys.time(), "%H%M%S%d%m%Y"))
+success <- file.copy(from=dbname, to=backupname , overwrite = FALSE)
+if (!success) {
+gmessage("Fail to back up the project.",con=TRUE,icon="error")
+}
+}

Modified: pkg/R/root_gui.R
===================================================================
--- pkg/R/root_gui.R	2008-12-06 10:03:43 UTC (rev 36)
+++ pkg/R/root_gui.R	2008-12-07 02:15:54 UTC (rev 37)
@@ -30,7 +30,8 @@
   ## project memo button
   ".close.proj_gui" <- CloseProjectButton(container=.proj_gui)
   ".projinfo_gui" <- ProjectInforButton(container=.proj_gui)
-   gbutton("About",container=.proj_gui, handler=function(h,...) {browseURL("http://rqda.r-forge.r-project.org/")})
+  BackupProjectButton(container=.proj_gui)
+  gbutton("About",container=.proj_gui, handler=function(h,...) {browseURL("http://rqda.r-forge.r-project.org/")})
 
   glabel(
 "Author: <ronggui.huang at gmail.com>\n

Modified: pkg/man/RQDA-internal.rd
===================================================================
--- pkg/man/RQDA-internal.rd	2008-12-06 10:03:43 UTC (rev 36)
+++ pkg/man/RQDA-internal.rd	2008-12-07 02:15:54 UTC (rev 37)
@@ -84,6 +84,8 @@
 \alias{CodeofCatWidgetMenu}
 \alias{CodesNamesWidgetMenu}
 \alias{FileofCatWidgetMenu}
+\alias{backup_proj}
+\alias{BackupProjectButton}
 %% add related alias functions here.
 
 \title{Internal Functions}

Modified: www/ChangeLog.txt
===================================================================
--- www/ChangeLog.txt	2008-12-06 10:03:43 UTC (rev 36)
+++ www/ChangeLog.txt	2008-12-07 02:15:54 UTC (rev 37)
@@ -1,8 +1,16 @@
-2008-12-06
+2008-12-07
+	* Better handler the issue of write permission in new project and open project button
+	* new function/button to backup project
+	* fix bug in close project button
+	
+2008-12-06 (rc2 of v1.6)
 	* bugfix of Freecode rename button and others.
 	* Memo in Popup menu in Files Tab.
 	* Enhance Mark buttons, so it will not save duplicated information in database.
 	* New function relation() for caculating relation between two coding.
+	* Improve ViewFileFun() so the codings are highlighted when a file is opened.
+	* Add some popup menus.
+	* Improve pdelete(),list.deleted() and undelete(). New function of CleanProject().
 
 2008-12-05
 	* New functionality of add memo to File category and Code category.



More information about the Rqda-commits mailing list