[Zooimage-commits] r63 - pkg/zooimage/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Apr 15 11:29:06 CEST 2009
Author: romain
Date: 2009-04-15 11:29:05 +0200 (Wed, 15 Apr 2009)
New Revision: 63
Modified:
pkg/zooimage/R/catcher.R
pkg/zooimage/R/errorHandling.R
pkg/zooimage/R/gui.r
pkg/zooimage/R/utilities.r
pkg/zooimage/R/zim.r
Log:
adding list.zip
Modified: pkg/zooimage/R/catcher.R
===================================================================
--- pkg/zooimage/R/catcher.R 2009-04-14 13:56:17 UTC (rev 62)
+++ pkg/zooimage/R/catcher.R 2009-04-15 09:29:05 UTC (rev 63)
@@ -113,11 +113,13 @@
if( is.null( getCatcher() ) ){
# see if it has a catcher
catcher <- attr( fun, "catcher" )
+ if( is.null(catcher) ){
+ base::stop( sprintf( "'%s' does not have a catcher", as.character(call[[1]]) ) )
+ }
setCatcher( catcher )
+ recallWithCatcher( call )
}
- recallWithCatcher( call )
-
}
# }}}
Modified: pkg/zooimage/R/errorHandling.R
===================================================================
--- pkg/zooimage/R/errorHandling.R 2009-04-14 13:56:17 UTC (rev 62)
+++ pkg/zooimage/R/errorHandling.R 2009-04-15 09:29:05 UTC (rev 63)
@@ -92,25 +92,20 @@
#'
#' @param msg the error message
#' @param env the environment in which the problem occured
-zooImageError <- function( msg = "error", env = parent.frame(), errorClass = NULL, context = NULL ){
+zooImageError <- function( msg = "error", env = parent.frame(), errorClass = NULL, context = NULL, verbose = getOption("verbose") ){
err <- simpleError( message = msg )
err$env <- env
if( !is.null( context ) ){
if( context %in% ls( env ) ){
err$context <- env[[ context ]]
}
- err$message <- sprintf( "[%s] %s", err$context, msg )
+ err$message <- if( verbose ) sprintf( "<%s> [%s] %s", errorClass, err$context, msg ) else sprintf( "[%s] %s", err$context, msg )
}
class( err ) <- c(errorClass, "zooImageError", "error", "condition" )
err
}
# }}}
-print.zooImageError <- function( x, ...){
- print ( "hoop" )
-}
-
-
#{{{ zooImageErrorDrivers
#' if a zoo image function has a driver in this list
#' the stop function will signal a condition built with the driver
@@ -135,7 +130,9 @@
# --------------------------------------- zie.R
"make.zie" = "Filemap",
"BuildZim" = "Smp",
- "f" = ""
+ "checkFileExists" = "file",
+ "checkFirstLine" = "file",
+ "checkDirExists" = "dir"
)
# }}}
Modified: pkg/zooimage/R/gui.r
===================================================================
--- pkg/zooimage/R/gui.r 2009-04-14 13:56:17 UTC (rev 62)
+++ pkg/zooimage/R/gui.r 2009-04-15 09:29:05 UTC (rev 63)
@@ -349,8 +349,8 @@
# or you can access other processes that automatically build .zim files
# and/or import images/data, including custom processes defined in
# separate 'ZIEimport' objects (see FlowCAM import routine for an example)
-
# Get a list of 'ZIEimport' objects currently loaded in memory
+
### TODO... Rework everything. What follows is old code!
ImgFilters <- as.matrix(data.frame(title = c("Tiff image files (*.tif)",
"Jpeg image files (*.jpg)", "Zooimage import extensions (Import_*.zie)", "Table and ImportTemplate.zie (*.txt)"), #, "FlowCAM zipped files (*.zfc)"),
Modified: pkg/zooimage/R/utilities.r
===================================================================
--- pkg/zooimage/R/utilities.r 2009-04-14 13:56:17 UTC (rev 62)
+++ pkg/zooimage/R/utilities.r 2009-04-15 09:29:05 UTC (rev 63)
@@ -544,7 +544,7 @@
stop( sprintf( 'file "%s" is a directory', file ) )
}
if( !missing(extension) && !grepl( extensionPattern(extension), file ) ){
- message <- sprintf( "%s , or not a '%s' file", message, extension )
+ message <- sprintf( "'%s' is not a '%s' file", file, extension )
stop( message )
}
invisible( NULL )
Modified: pkg/zooimage/R/zim.r
===================================================================
--- pkg/zooimage/R/zim.r 2009-04-14 13:56:17 UTC (rev 62)
+++ pkg/zooimage/R/zim.r 2009-04-15 09:29:05 UTC (rev 63)
@@ -49,6 +49,7 @@
template <- NULL
for (z in 1:zmax) {
Progress(z, zmax)
+
#.zim file does not exists... create it
if (!file.exists(zims[z])) {
logProcess("Creating the file", zims[z])
@@ -59,7 +60,7 @@
}
# Verify that the zim is correct
res <- verify.zim(zims[z])
- if (!res == 0) ok <- FALSE
+ if (res != 0) ok <- FALSE
}
# }}}
@@ -108,7 +109,7 @@
# STOP: no measurements found in the file
"verify.zim" <- function(zimfile, check.ext = FALSE,
is.dat1 = hasExtension( zimfile, "_dat1.zim"), check.table = FALSE) {
-
+
# {{{ Required fields
# Here are predefined required fields before measurements
reqfields <- c("[Image]", "Author", "Hardware", "Software",
@@ -125,19 +126,18 @@
# {{{ Determine if there are custom verification rules defined and if they are active
newRules <- getOption("ZI.zim")
if (!is.null(newRules) && newRules$active == TRUE) {
- # {{{ Should we delegate the whole process to a custom verification function?
+ # Should we delegate the whole process to a custom verification function?
verify.all <- newRules$verify.all
if (!is.null(verify.all) && inherits(verify.all, "function"))
return(verify.all(zimfile = zimfile, check.ext = check.ext,
is.dat1 = is.dat1, chack.table = check.table))
- # }}}
-
- # {{{ Should we use additional verification code instead?
+
+ # Should we use additional verification code instead?
verify <- newRules$verify
reqfields <- c(reqfield, newRules$zim.required)
reqfields2 <- c(reqfields2, newRules$dat1.zim.required)
reqcols <- c(reqcol, newRules$dat1.data.required)
- # }}}
+ #
} else verify <- NULL
# }}}
@@ -166,8 +166,9 @@
flush = TRUE, quiet = TRUE, blank.lines.skip = FALSE,
comment.char = "=")
- if (length(Lines) < 1)
+ if (length(Lines) < 1){
stop("File is empty!")
+ }
# Trim leading and trailing white spaces
Lines <- trim(Lines)
@@ -231,15 +232,19 @@
# We don't read the table, use a different method to get the number of entries in it
# Read the last entry in Lines and convert it to a numeric value: should be the number of items measured
nItems <- Lines[length(Lines)]
- if (sub("^[0-9]+$", "", nItems) != "")
+ if (sub("^[0-9]+$", "", nItems) != ""){
stop("Impossible to determine the number of items measured!")
+ }
return(as.integer(nItems))
# }}}
}
# }}}
} else {
- if (is.dat1) stop("No measurements found in this file")
- else return(0)
+ if (is.dat1){
+ stop("No measurements found in this file")
+ } else {
+ return(0)
+ }
}
# }}}
}
@@ -252,6 +257,9 @@
"list.dat1.zim" <- function(zidir, ...) {
list.files.ext( zidir, extension = "_dat1.zim", ... )
}
+list.zip <- function( zidir, ... ){
+ list.files.ext( zidir, extension = "zip", ... )
+}
# }}}
# {{{ extract.zims
@@ -261,8 +269,7 @@
# STOP: One or several files not found!
# STOP: sprintf( "%s: is not a valid directory!", path)
# STOP: Done, no file to process!
-"extract.zims" <-
- function(zipdir = ".", zipfiles = list.files(zipdir, pattern = "\\.[zZ][iI][pP]$"),
+"extract.zims" <- function(zipdir = ".", zipfiles = list.zip(zipdir),
path = NULL, replace = FALSE, check.unzip = TRUE, show.log = TRUE, bell = FALSE) {
# {{{ This requires the 'unzip' program!, Make sure it is available
More information about the Zooimage-commits
mailing list