[Zooimage-commits] r201 - pkg/zooimage/R

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Thu Jun 14 10:11:27 CEST 2012


Author: kevin
Date: 2012-06-14 10:11:26 +0200 (Thu, 14 Jun 2012)
New Revision: 201

Modified:
   pkg/zooimage/R/misc.R
Log:
New method for zip function but problem: print all compression factor for vignettes. Bug with invisible() method.

Modified: pkg/zooimage/R/misc.R
===================================================================
--- pkg/zooimage/R/misc.R	2012-06-11 13:36:02 UTC (rev 200)
+++ pkg/zooimage/R/misc.R	2012-06-14 08:11:26 UTC (rev 201)
@@ -225,49 +225,61 @@
 
 ## Zip the content of the directory into the zipfile
 ## and delete the directory if needed
-zip <- function (zipfile , directory, delete.source = FALSE,
-comment.file = NULL, delete.zipfile.first = TRUE)
-{
-	## We need the system to be capable of zipping
-	checkZipAvailable()
-
-	## Delete old zip file, if it exists
-	if (delete.zipfile.first && file.exists(zipfile))
-		unlink(zipfile)
-
-	## Test if we need and can add the comment file
-	comment <- !is.null(comment.file) && file.exists(comment.file)
-
-	## Build the list of parameters for zip
-	zippar <- sprintf("-rq9%s%s", if (delete.source) "m" else "",
-		if (comment) "z" else "")
-
-	## Create the basic command
-	cmd <- sprintf('"%s" %s "%s" "%s"', ZIpgm("zip", "misc"), zippar,
-		zipfile, directory)
-
-	## Call the command
-	result <- if (isWin()) {
-		## modify the windows command so that the message is piped into the zip command
-		if (comment) {
-			cmd <- sprintf('%s /c type "%s" | %s', Sys.getenv("COMSPEC"),
-				comment.file, cmd)
-		}
-		system(cmd, show.output.on.console = TRUE, invisible = TRUE)
-	} else {
-		## Modify the command if we need and can add the comment file
-		if (comment)
-			cmd <- sprintf('%s < "%s"', cmd, comment.file)
-		## Send the error stream to the null device
-		cmd <- paste(cmd, ' 2> /dev/null')
-		## Call the command
-		system(cmd)
-	}
-
+# Modif Kev zip is now available in R
+### Problem: zip shows all compressed files on R consol --> need invisible method
+zip <- function (zipfile, directory, delete.source = FALSE) {
+	### Zip the zid file
+	utils:::zip(zipfile = zipfile, files = directory)
+	if (delete.source)
+		unlink(x = directory, recursive = TRUE)
 	checkFileExists(zipfile, message = "Error creating zip file '%s'")
-	return(invisible( result == 0))
 }
 
+#zip <- function (zipfile , directory, delete.source = FALSE,
+#comment.file = NULL, delete.zipfile.first = TRUE)
+#{
+#	## We need the system to be capable of zipping
+## bug to check if there is a zip program under windows
+##	checkZipAvailable()
+#
+#	## Delete old zip file, if it exists
+#	if (delete.zipfile.first && file.exists(zipfile))
+#		unlink(zipfile)
+#
+#	## Test if we need and can add the comment file
+#	comment <- !is.null(comment.file) && file.exists(comment.file)
+#
+#	## Build the list of parameters for zip
+#	zippar <- sprintf("-rq9%s%s", if (delete.source) "m" else "",
+#		if (comment) "z" else "")
+#
+#	## Create the basic command
+#	cmd <- sprintf('"%s" %s "%s" "%s"', ZIpgm("zip", "misc"), zippar,
+#		zipfile, directory)
+#
+#	## Call the command
+#	result <- if (isWin()) {
+#		## modify the windows command so that the message is piped into the zip command
+#		if (comment) {
+#			cmd <- sprintf('%s /c type "%s" | %s', Sys.getenv("COMSPEC"),
+#				comment.file, cmd)
+#		}
+#		system(cmd, show.output.on.console = TRUE, invisible = TRUE)
+#	} else {
+#		## Modify the command if we need and can add the comment file
+#		if (comment)
+#			cmd <- sprintf('%s < "%s"', cmd, comment.file)
+#		## Send the error stream to the null device
+#		cmd <- paste(cmd, ' 2> /dev/null')
+#		## Call the command
+#		system(cmd)
+#	}
+#
+#	checkFileExists(zipfile, message = "Error creating zip file '%s'")
+#	return(invisible( result == 0))
+#}
+#
+
 zipNoteAdd <- function (zip, comment.file,
 on.failure = stop(sprintf(on.failure.msg , comment.file, zip)),
 on.failure.msg = "problem adding comment from '%s' to file '%s' ", on.success)



More information about the Zooimage-commits mailing list