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

[noreply at r-forge.r-project.org]

Author: romain
Date: 2009-04-27 10:18:23 +0200 (Mon, 27 Apr 2009)
New Revision: 112

Modified:
   pkg/zooimage/R/utilities.r
Log:
minor changes

Modified: pkg/zooimage/R/utilities.r
===================================================================
--- pkg/zooimage/R/utilities.r	2009-04-27 08:12:48 UTC (rev 111)
+++ pkg/zooimage/R/utilities.r	2009-04-27 08:18:23 UTC (rev 112)
@@ -522,6 +522,7 @@
 		tkconfigure(getTemp("statusText"), text = paste("Ready -", getwd()))
 		.Tcl("update idletasks")
 	}
+	
 	# Save the current default directory for future use
 	setKey("DefaultDirectory", getwd())
 }
@@ -555,10 +556,13 @@
 #' ZIpgmhelp("pgmhist", "netpbm")
 #' ZIpgmhelp("pnm2biff", "xite")
 "ZIpgmhelp" <- function(pgm, subdir = "misc") {
+	# TODO: would it not be better to use the same thing on all platforms
+	#       (the doc directory)
 	if (isWin()) {
 		helpfile <- file.path(system.file(subdir, "doc", package = "zooimage"), paste(pgm, "txt", sep = "."))
-		if (!file.exists(helpfile))
+		if (!file.exists(helpfile)){
 			stop("No help found for ", pgm)
+		}
 		file.show(helpfile, title = paste("Help for ", pgm, " [", subdir, "]", sep = ""))		
 	} else {
 		system(paste("man", pgm), wait = FALSE)
@@ -576,7 +580,7 @@
 }
 # }}}
 
-
+# {{{ callStack
 #' Get the current call stack
 callStack <- function( ){
 	calls <- sys.calls()
@@ -587,7 +591,11 @@
 	out <- unlist( out[ !sapply( out, is.null ) ] )
 	out
 }
+# }}}
 
+# {{{ masking a few R functions to change their behaviour slightly when 
+#     used by zooimage functions
+
 #' masking system so that the warnings related to using windows arguments
 system <- function (command, intern = FALSE, ignore.stderr = FALSE, wait = TRUE, 
     input = NULL, show.output.on.console = TRUE, minimized = FALSE, 
@@ -599,6 +607,39 @@
 	
 }
 
+# a version that stops
+require <- function( ... ){
+	withCallingHandlers( base:::require(...), 
+		warning = function( e ){
+			base:::stop( e )
+		} )
+}
+
+if( !isWin() ){
+	# choose.files is only available on windows, so we fall 
+	# back on tcl-tk equivalent function
+	choose.files <- function( default = "", caption = "Select files",
+	     multi = TRUE, filters = Filters,
+		 index = nrow(Filters) ){
+		
+		call <- match.call( )
+		call[[1]] <- as.name( "tk_choose.files")
+		eval( call, envir = parent.frame() )	
+	}
+}
+
+#' import grepl from the future 2.9.0 version
+grepl <- if( as.numeric( version$major ) >= 2 && as.numeric( version$minor >= 9) )
+	base:::grepl else function (pattern, x, ignore.case = FALSE, extended = TRUE, perl = FALSE,
+	    fixed = FALSE, useBytes = FALSE) {
+	    index <- grep( pattern, x, ignore.case = ignore.case, 
+			extended = extended, perl = perl, fixed = fixed, useBytes = useBytes )
+		if( length( index ) == 0 ) return( rep( FALSE, length( x ) ) )
+		replace( rep( FALSE, length(x) ), index, TRUE )
+	} 
+
+# }}}
+
 # {{{ File utilities
 #' checks if the file has the extension
 hasExtension <- function( file, extension = "zip", pattern = extensionPattern(extension ) ){
@@ -617,10 +658,10 @@
 }
 
 # {{{ list.zim, list.dat1.zim
-"list.zim" <- function(zidir, ...) {
+list.zim <- function(zidir, ...) {
 	list.files.ext( zidir, extension = "zim", ... )
 }
-"list.dat1.zim" <- function(zidir, ...) {
+list.dat1.zim <- function(zidir, ...) {
 	list.files.ext( zidir, extension = "_dat1.zim", ... )
 }
 list.zip <- function( zidir, ... ){
@@ -741,8 +782,6 @@
 	out <- list.files( dir )
 	out[ file.info( file.path( dir, basename(out) ) )$isdir ]
 }
-
-
 # }}}
 
 # {{{ binary operators
@@ -752,7 +791,7 @@
 }
 # }}}
 
-
+# {{{ must utilities
 mustbe <- function( x, class, msg ){
 	if( !any( sapply( class, function( cl ) inherits( x, cl) ) ) )
 	if( length(class) == 1){
@@ -809,30 +848,8 @@
 		stop( sprintf( "%s must be a character string of length %d", deparse( substitute(x)), length ) )
 	}
 }
+# }}}
 
-
-# a version that stops
-require <- function( ... ){
-	withCallingHandlers( base:::require(...), 
-		warning = function( e ){
-			base:::stop( e )
-		} )
-}
-
-if( !isWin() ){
-	# choose.files is only available on windows, so we fall 
-	# back on tcl-tk equivalent function
-	choose.files <- function( default = "", caption = "Select files",
-	     multi = TRUE, filters = Filters,
-		 index = nrow(Filters) ){
-		
-		call <- match.call( )
-		call[[1]] <- as.name( "tk_choose.files")
-		eval( call, envir = parent.frame() )	
-	}
-}
-
-
 #' get a template file from the "ZITemplate" option
 template <- function( file = "default.zim", dir = getOption("ZITemplates") ){
 	f <- file.path( dir, file )
@@ -840,9 +857,6 @@
 	f
 }
 
-
-
-
 # {{{ finish.loopfunction
 #' Called at the looping function (*.all)
 #' 
@@ -886,14 +900,4 @@
 }
 # }}}
 
-#' import grepl from the future 2.9.0 version
-grepl <- if( as.numeric( version$major ) >= 2 && as.numeric( version$minor >= 9) )
-	base:::grepl else function (pattern, x, ignore.case = FALSE, extended = TRUE, perl = FALSE,
-	    fixed = FALSE, useBytes = FALSE) {
-	    index <- grep( pattern, x, ignore.case = ignore.case, 
-			extended = extended, perl = perl, fixed = fixed, useBytes = useBytes )
-		if( length( index ) == 0 ) return( rep( FALSE, length( x ) ) )
-		replace( rep( FALSE, length(x) ), index, TRUE )
-	} 
-
 # :tabSize=4:indentSize=4:noTabs=false:folding=explicit:collapseFolds=1: