[Zooimage-commits] r183 - in pkg/zooimage: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Apr 8 17:30:14 CEST 2010
Author: phgrosjean
Date: 2010-04-08 17:30:14 +0200 (Thu, 08 Apr 2010)
New Revision: 183
Added:
pkg/zooimage/FunList.txt
Modified:
pkg/zooimage/NAMESPACE
pkg/zooimage/R/capabilities.R
pkg/zooimage/R/catcher.R
pkg/zooimage/R/errorHandling.R
pkg/zooimage/R/log.R
pkg/zooimage/R/programs.R
pkg/zooimage/R/zzz.R
pkg/zooimage/man/log.Rd
Log:
Further cleanup
Added: pkg/zooimage/FunList.txt
===================================================================
--- pkg/zooimage/FunList.txt (rev 0)
+++ pkg/zooimage/FunList.txt 2010-04-08 15:30:14 UTC (rev 183)
@@ -0,0 +1,60 @@
+= capabilities.R
+
+ZOOIMAGEENV = environment
+checkCapable(cap)
+capabilities = list
+checkZipAvailable()
+checkUnzipAvailable()
+checkZipnoteAvailable()
+checkIdentifyAvailable()
+checkConvertAvailable()
+checkPpmtopgmAvailable()
+checkDcRawAvailable()
+checkAvailable_pnm2biff()
+checkAvailable_divide()
+checkAvailable_statistics()
+checkAvailable_biff2tiff()
+checkAvailable_java()
+checkCapabilityAvailable(cap, cmd, msg)
+getZooImageCapability(cap = "zip")
+zooImageCapabilities(...)
+
+
+= catcher.R => Nothing exported
+
+catch.env = environment
+catch(call)
+recallWithCatcher(call, debug = FALSE)
+getCatcher()
+setCatcher(catcher)
+dummyCatcher(call)
+resetCatcher()
+
+
+= errorHandling.R => Nothing exported
+
+stop(..., call. = TRUE, domain = NULL)
+warning(..., call. = TRUE, immediate. = FALSE, domain = NULL)
+zooImageError(msg = "error", env = parent.frame(),
+ errorClass = NULL, context = NULL, verbose = getOption("verbose"))
+zooImageWarning(msg = "warning", env = parent.frame())
+zooImageErrorDrivers = list
+zooImageWarningDrivers = list
+zooImageErrorContext(fun, context)
+zooImageWarningContext(fun, context)
+getZooImageConditionFunction(calls, drivers, default, context.fun)
+getZooImageErrorFunction(calls)
+getZooImagheWarningFunction(calls)
+[[.zooImageError(x, ...)
+[[.zooImageWarning(x, ...)
+extractMessage(err)
+
+
+== log.R
+logProcess(message, topic = NULL, file = file.path(tempdir(), "ZooImage.log"),
+ logit = TRUE, stop = FALSE, show.log = stop)
+logClear(file = file.path(tempdir(), "ZooImage.log"))
+logView(file = file.path(tempdir(), "ZooImage.log"),
+ title = paste(getTemp("ZIname"), "log"), clear = TRUE, warn = FALSE)
+logError(e, msg = NULL, ...)
+logWarning(w, msg = NULL, ...)
\ No newline at end of file
Modified: pkg/zooimage/NAMESPACE
===================================================================
--- pkg/zooimage/NAMESPACE 2010-04-08 13:34:50 UTC (rev 182)
+++ pkg/zooimage/NAMESPACE 2010-04-08 15:30:14 UTC (rev 183)
@@ -144,10 +144,10 @@
export(zip.img.all)
export(zip.ZITrain)
-# The following functions are NOT exported
+# The following objects are NOT exported
# ZOOIMAGEENV (environment holding ZooImage data)
-# catch
-# catch.env
+ # catch
+ # catch.env
# checkAvailable_java
# checkAvailable_biff2tiff # Eliminate Xite programs
# checkAvailable_divide # Eliminate Xite programs
@@ -163,31 +163,30 @@
# checkUnzipAvailable
# checkZipAvailable
# checkZipnoteAvailable
-# dummyCatcher
+ # dummyCatcher
# extensionPattern
-# extractMessage
+ # extractMessage
# finish.loopfunction
-# getCatcher
+ # getCatcher
# getZooImageCapability
-# getZooImageConditionFunction
-# getZooImageErrorFunction
-# getZooImageWarningFunction
+ # getZooImageConditionFunction
+ # getZooImageErrorFunction
+ # getZooImageWarningFunction
# grepl
+ # recallWithCatcher
+ # resetCatcher
+ # setCatcher
+ # stop
# unzip
-# warning
+ # warning
# zip
# zipnote
# zooImageCapabilities
-# zooImageError
-# [[.zooImageError
-# zooImageErrorContext
-# zooImageErrorDrivers
-# zooImageWarning
-# [[.zooImageWarning
-# zooImageWarningContext
-# zooImageWarningDrivers
-
-# recallWithCatcher
-# resetCatcher
-# setCatcher
-# stop
+ # zooImageError
+ # [[.zooImageError
+ # zooImageErrorContext
+ # zooImageErrorDrivers
+ # zooImageWarning
+ # [[.zooImageWarning
+ # zooImageWarningContext
+ # zooImageWarningDrivers
Modified: pkg/zooimage/R/capabilities.R
===================================================================
--- pkg/zooimage/R/capabilities.R 2010-04-08 13:34:50 UTC (rev 182)
+++ pkg/zooimage/R/capabilities.R 2010-04-08 15:30:14 UTC (rev 183)
@@ -36,7 +36,6 @@
"java" = checkAvailable_java
)
-
# Various check*Capability functions
# Utility that checks if the zip program is available
checkZipAvailable <- function ()
Modified: pkg/zooimage/R/catcher.R
===================================================================
--- pkg/zooimage/R/catcher.R 2010-04-08 13:34:50 UTC (rev 182)
+++ pkg/zooimage/R/catcher.R 2010-04-08 15:30:14 UTC (rev 183)
@@ -1,6 +1,6 @@
# Copyright (c) 2009, Ph. Grosjean <phgrosjean at sciviews.org>
#
-# This file is part of ZooImage .
+# This file is part of ZooImage
#
# ZooImage is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
@@ -15,9 +15,6 @@
# You should have received a copy of the GNU General Public License
# along with ZooImage. If not, see <http://www.gnu.org/licenses/>.
-
-
-
# catchers : the idea here is to separate the main job of the
# function from the job of handling errors
# generated by other functions it is calling
@@ -30,9 +27,7 @@
# already is an active catcher, then the function simply continues
# to execute as normal
#
-# if( is.null( getCatcher() ) ){
-# return( catch(match.call()) )
-# }
+# if (is.null(getCatcher())) return(catch(match.call()))
#
# - the function must have a "catcher" attribute which is a catcher :
# a function taking a "call" argument, and which evaluates it with
@@ -40,87 +35,63 @@
# have a catcher attribute, then the dummyCatcher is used so that
# the call is evaluated verbatim
-# {{{ an environment where the current catcher is stored
+# An environment where the current catcher is stored
catch.env <- new.env()
-# }}}
-# {{{ recallWithCatcher
-#' Evaluates the call calling the catcher associated with the
-#' function calling
-#'
-#' @param call the call to surround with the catcher
-#' @param debug logical, if T prints debugging information
-recallWithCatcher <- function( call, debug = FALSE ){
+# Evaluates the call calling the catcher associated with the function calling
+#
+# call: the call to surround with the catcher
+# debug: logical, if TRUE prints debugging information
+recallWithCatcher <- function (call, debug = FALSE)
+{
+ catcher <- getCatcher()
+ on.exit(resetCatcher())
- catcher <- getCatcher( )
- on.exit( resetCatcher() )
-
- if( is.null( catcher ) ){
- warning( "no catcher available" )
+ if (is.null(catcher)) {
+ warning("no catcher available")
catcher <- dummyCatcher
}
- if( debug ){
- print( callStack() )
- }
+ if (debug) print(callStack())
logClear()
- res <- catcher( call )
- if( "show.log" %in% names(call) && call[["show.log"]] ){
+ res <- catcher(call)
+ if ("show.log" %in% names(call) && call[["show.log"]])
logView()
- }
- res
+ return(res)
}
-# }}}
-# {{{ getCatcher
-#' gets the current catcher
-getCatcher <- function( ){
+# Get the current catcher
+getCatcher <- function ()
catch.env[["catcher"]]
-}
-# }}}
-# {{{ setCatcher
-#' sets the current catcher
-setCatcher <- function( catcher ){
- if( !is.null(catcher) ) {
- catch.env[["catcher"]] <- catcher
- }
-}
-# }}}
+# Set the current catcher
+setCatcher <- function (catcher)
+ if (!is.null(catcher)) catch.env[["catcher"]] <- catcher
-# {{{ dummyCatcher
-#' a catcher that does nothing more than evaluating the call
-dummyCatcher <- function( call ){
- eval( call )
-}
-# }}}
+# A catcher that does nothing more than evaluating the call
+dummyCatcher <- function (call)
+ eval(call)
-# {{{ set the catcher to NULL
-resetCatcher <- function( ){
+# Set the catcher to NULL
+resetCatcher <- function ()
catch.env[["catcher"]] <- NULL
-}
-# }}}
-# {{{ catch
-#' finds the main catcher associated with the function
-#' making the call, and recall the call with the
-#' catcher
-catch <- function( call ){
- # find the name of the function which want to catch
- fun <- match.fun( as.character(call[[1]]) )
+# Finds the main catcher associated with the function making the call,
+# and recall the call with the catcher
+catch <- function (call)
+{
+ # Find the name of the function which want to catch
+ fun <- match.fun(as.character(call[[1]]))
- 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]]) ) )
+ 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 )
+ setCatcher(catcher)
+ recallWithCatcher(call)
}
-
}
-# }}}
-
-# :tabSize=4:indentSize=4:noTabs=false:folding=explicit:collapseFolds=1:
Modified: pkg/zooimage/R/errorHandling.R
===================================================================
--- pkg/zooimage/R/errorHandling.R 2010-04-08 13:34:50 UTC (rev 182)
+++ pkg/zooimage/R/errorHandling.R 2010-04-08 15:30:14 UTC (rev 183)
@@ -1,6 +1,6 @@
# Copyright (c) 2009, Ph. Grosjean <phgrosjean at sciviews.org>
#
-# This file is part of ZooImage .
+# This file is part of ZooImage
#
# ZooImage is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
@@ -15,102 +15,87 @@
# You should have received a copy of the GNU General Public License
# along with ZooImage. If not, see <http://www.gnu.org/licenses/>.
-#{{{ stop
-#' Masking stop in the NAMESPACE of ZooImage
-#'
-#' The base function "stop" is masked in the namespace
-#' of zooimage so that instead of throwing an error, the stop
-#' function throws a condition of class ZooImageError that wraps
-#' information about the environment in which the error is created
-#'
-#' @details When a function in zooimage calls stop, this function
-#' is used to dispatch the error either to the standard stop function
-#' or to the generation of a zooImageError condition when a batch function
-#' is in the call stack
-#'
-#' @param dots see ?Stop
-#' @param call. see ?stop
-#' @param domain see ?stop
-stop <- function( ..., call.= TRUE, domain = NULL ){
- calls <- callStack()
- calls <- head( calls, -2)
- if( ! tail(calls,1) %in% names( zooImageErrorDrivers) ){
- # the calling function does not have a driver, we use
- # the regular stop
- # TODO: maybe this should be a default ZooImageError instead
- base:::stop( ..., call.=call., domain = domain )
- } else{
- # the calling function has a driver, we throw the condition
- # using the appropriate driver
- message <- do.call( paste, list(...) )
- condfun <- getZooImageErrorFunction( calls )
- err <- condfun(message, env = parent.frame() )
- base:::stop( err )
- }
+# Masking stop in the NAMESPACE of ZooImage
+#
+# The base function "stop" is masked in the namespace
+# of zooimage so that instead of throwing an error, the stop
+# function throws a condition of class ZooImageError that wraps
+# information about the environment in which the error is created
+#
+# When a function in zooimage calls stop, this function is used to dispatch
+# the error either to the standard stop function or to the generation of a
+# zooImageError condition when a batch function is in the call stack
+"stop" <- function (..., call. = TRUE, domain = NULL)
+{
+ calls <- callStack()
+ calls <- head(calls, -2)
+ if (!tail(calls, 1) %in% names(zooImageErrorDrivers)) {
+ # The calling function does not have a driver, we use the regular stop
+ # TODO: maybe this should be a default ZooImageError instead
+ base:::stop(..., call. = call., domain = domain)
+ } else {
+ # The calling function has a driver, we throw the condition
+ # using the appropriate driver
+ message <- do.call(paste, list(...))
+ condfun <- getZooImageErrorFunction(calls)
+ err <- condfun(message, env = parent.frame())
+ base:::stop(err)
+ }
}
-# }}}
-#{{{ warning
-#' Masking warning in the NAMESPACE of ZooImage
-#'
-#' The base function "warning" is masked in the namespace
-#' of zooimage so that instead of throwing a warning, the warning
-#' function throws a condition of class ZooImageWarning that wraps
-#' information about the environment in which the warning is created
-#'
-#' @details When a function in zooimage calls warning, this function
-#' is used to dispatch the error either to the standard warning function
-#' or to the generation of a zooImageWarning condition when a batch function
-#' is in the call stack
-#'
-#' @param dots see ?Stop
-#' @param call. see ?stop
-#' @param immediate. See ?stop
-#' @param domain see ?stop
-warning <- function( ..., call.= TRUE, immediate.= FALSE, domain = NULL ){
- calls <- callStack()
- if( all( regexpr( "\\.all$", calls ) == -1 ) ){
- base:::warning( ..., call.=call., domain = domain )
- } else{
- message <- do.call( paste, list(...) )
- signalCondition( getZooImageWarningFunction( calls )(message, env = parent.frame() ) )
- }
+# Masking warning in the NAMESPACE of ZooImage
+#
+# The base function "warning" is masked in the namespace
+# of zooimage so that instead of throwing a warning, the warning
+# function throws a condition of class ZooImageWarning that wraps
+# information about the environment in which the warning is created
+#
+# When a function in zooimage calls warning, this function is used to dispatch
+# the error either to the standard warning function or to the generation of a
+# zooImageWarning condition when a batch function is in the call stack
+#
+warning <- function (..., call. = TRUE, immediate. = FALSE, domain = NULL)
+{
+ calls <- callStack()
+ if (all( regexpr("\\.all$", calls) == -1)) {
+ base:::warning(..., call. = call., domain = domain)
+ } else {
+ message <- do.call(paste, list(...))
+ signalCondition(getZooImageWarningFunction(calls)(message,
+ env = parent.frame()))
+ }
}
-# }}}
-#{{{ zooImageError
-#' Error condition used in ZooImage batch treatments
-#'
-#' This function creates a condition of class "zooImageError".
-#' These conditions are used in conjunction with the calling handler
-#' mechanism in zooImage batch calls to grab additional information
-#' about the context in which the stop function was called
-#'
-#' @details this function is called when a function that is
-#' directly or indirectly called by a batch treatment function
-#' calls the stop function
-#'
-#' @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, verbose = getOption("verbose") ){
- err <- simpleError( message = msg )
+# Error condition used in ZooImage batch treatments
+#
+# This function creates a condition of class "zooImageError".
+# These conditions are used in conjunction with the calling handler
+# mechanism in zooImage batch calls to grab additional information
+# about the context in which the stop function was called
+#
+# This function is called when a function that is directly or indirectly called
+# by a batch treatment function calls the stop function
+# msg: the error message
+# env: the environment in which the problem occured
+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 <- if( verbose ) sprintf( "<%s> [%s] %s", errorClass, err$context, msg ) else sprintf( "[%s] %s", err$context, msg )
+ if (!is.null(context)) {
+ if (context %in% ls(env)) err$context <- env[[context]]
+ 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
+ class(err) <- c(errorClass, "zooImageError", "error", "condition")
+ return(err)
}
-# }}}
-#{{{ zooImageErrorDrivers
-#' if a ZooImage function has a driver in this list
-#' the stop function will signal a condition built with the driver
-#' instead of doing the normal thing
-#' TODO: check that all function requiring a driver has one
+# If a ZooImage function has a driver in this list
+# the stop function will signal a condition built with the driver
+# instead of doing the normal thing
+# TODO: check that all function requiring a driver has one
zooImageErrorDrivers <- list(
# --------------------------------------- zid.R
"verify.zid" = "zidir",
@@ -120,7 +105,7 @@
"read.zid" = "zidfile",
# --------------------------------------- utilities.R
- "get.sampleinfo" = "filename",
+ "get.sampleinfo" = "filename",
# --------------------------------------- zim.R
"make.zim" = "images",
@@ -134,136 +119,119 @@
"make.zie" = "Filemap",
"BuildZim" = "Smp",
"checkFileExists" = "file",
- "checkFirstLine" = "file",
- "checkDirExists" = "dir",
- "get.ZITrain" = "dir",
+ "checkFirstLine" = "file",
+ "checkDirExists" = "dir",
+ "get.ZITrain" = "dir",
"force.dir.create" = "path",
"checkEmptyDir" = "dir",
"make.RData" = "zidir",
"process.sample" = "Sample",
"process.samples" = "Samples"
)
-# }}}
-#{{{ zooImageWarningDrivers
-#' list of warning drivers
+# List of warning drivers
zooImageWarningDrivers <- list(
"verify.zid" = "zidir"
)
-#}}}
-#{{{ zooImageErrorContext
-#' zoo image errors associated with a context
-zooImageErrorContext <- function( fun, context ) {
+# ZooImage errors associated with a context
+zooImageErrorContext <- function (fun, context)
+{
force(context)
- function( msg, env = parent.frame() ){
- zooImageError( msg, env, paste( "zooImageError", fun, sep = "_") , context = context )
+ function(msg, env = parent.frame()) {
+ zooImageError(msg, env, paste("zooImageError", fun, sep = "_"),
+ context = context)
}
}
-#}}}
-#{{{ zooImageWarningContext
-#' zoo image warnings associated with a context
-zooImageWarningContext <- function( fun, context ) {
- function( msg, env = parent.frame() ){
- zooImageWarning( msg, env, paste( "zooImageWarning", fun, sep = "_") , context = context )
+# ZooImage warnings associated with a context
+zooImageWarningContext <- function (fun, context)
+{
+ force(context)
+ function(msg, env = parent.frame()) {
+ zooImageWarning(msg, env, paste("zooImageWarning", fun, sep = "_"),
+ context = context)
}
}
-#}}}
-#{{{ getZooImageConditionFunction
-#' Get the appropriate condition generating function
-getZooImageConditionFunction <- function( calls, drivers, default, context.fun ){
+# Get the appropriate condition generating function
+getZooImageConditionFunction <- function (calls, drivers, default, context.fun)
+{
fun <- tail(calls, 1)
- driver <- drivers[[ fun ]]
- if( is.character( driver ) ){
- driver <- context.fun( fun, driver )
- } else if( is.null( fun ) ){
+ driver <- drivers[[fun]]
+ if (is.character(driver)) {
+ driver <- context.fun(fun, driver)
+ } else if (is.null(fun)) {
driver <- default
}
# TODO: maybe further checking on the arguments of the driver
- if( !inherits( driver, "function" ) ){
- stop( "wrong driver" )
- }
- driver
+ if (!inherits(driver, "function")) stop( "wrong driver" )
+ return(driver)
}
-#}}}
-#{{{ getZooImageErrorFunction
-#' get the appropriate error function
-getZooImageErrorFunction <- function( calls ){
- getZooImageConditionFunction( calls, zooImageErrorDrivers, zooImageError, zooImageErrorContext )
+# Get the appropriate error function
+getZooImageErrorFunction <- function (calls)
+{
+ getZooImageConditionFunction(calls, zooImageErrorDrivers, zooImageError,
+ zooImageErrorContext)
}
-#}}}
-#{{{ getZooImageWarningFunction
-#' get the appropriate warning function
-getZooImageWarningFunction <- function( calls ){
- getZooImageConditionFunction( calls, zooImageWarningDrivers, zooImageWarning, zooImageWarningContext )
+# Get the appropriate warning function
+getZooImageWarningFunction <- function (calls)
+{
+ getZooImageConditionFunction(calls, zooImageWarningDrivers, zooImageWarning,
+ zooImageWarningContext)
}
-# }}}
-#{{{ [[.zooImageError
-#' Extracts a object from the environment in which the error was generated
-#'
-#' When a ZooImageError is created, it contains the environment in which the
-#' error was created (the frame above the environment of the stop function)
-#' This utility function can be used to extract an object from
-#' this environment
-#'
-#' @param x the zooImageError
-#' @param dots what to extract from the environment
-`[[.zooImageError` <- function( x, ...){
- x$env[[ ... ]]
-}
-# }}}
+# Extract a object from the environment in which the error was generated
+#
+# When a ZooImageError is created, it contains the environment in which the
+# error was created (the frame above the environment of the stop function)
+# This utility function can be used to extract an object from
+# this environment
+#
+# x: the zooImageError
+# dots: what to extract from the environment
+`[[.zooImageError` <- function (x, ...)
+ x$env[[...]]
-#{{{ zooImageWarning
-#' Warning condition used in ZooImage batch treatments
-#'
-#' This function creates a condition of class "zooImageWarning".
-#' These conditions are used in conjunction with the calling handler
-#' mechanism in zooImage batch calls to grab additional information
-#' about the context in which the warning function was called
-#'
-#' @details this function is called when a function that is
-#' directly or indirectly called by a batch treatment function
-#' calls the warning function
-#'
-#' @param msg the error message
-#' @param env the environment in which the problem occured
-zooImageWarning <- function( msg = "warning", env = parent.frame() ){
- w <- simpleWarning( message = msg )
+# Warning condition used in ZooImage batch treatments
+#
+# This function creates a condition of class "zooImageWarning".
+# These conditions are used in conjunction with the calling handler
+# mechanism in zooImage batch calls to grab additional information
+# about the context in which the warning function was called
+#
+# This function is called when a function that is directly or indirectly called
+# by a batch treatment function calls the warning function
+#
+# msg: the error message
+# env: the environment in which the problem occured
+zooImageWarning <- function (msg = "warning", env = parent.frame())
+{
+ w <- simpleWarning(message = msg)
w$env <- env
- class( w ) <- c("zooImageWarning", "warning", "condition" )
- w
+ class(w) <- c("zooImageWarning", "warning", "condition")
+ return(w)
}
-# }}}
-#{{{ [[.zooImageWarning
-#' Extracts a object from the environment in which the warning was generated
-#'
-#' When a ZooImageWarning is created, it contains the environment in which the
-#' warning was created (the frame above the environment of the warning function)
-#' This utility function can be used to extract an object from
-#' this environment
-#'
-#' @param x the zooImageWarning
-#' @param dots what to extract from the environment
-`[[.zooImageWarning` <- function( x, ...){
- x$env[[ ... ]]
-}
-# }}}
+# Extract an object from the environment in which the warning was generated
+#
+# When a ZooImageWarning is created, it contains the environment in which the
+# warning was created (the frame above the environment of the warning function)
+# This utility function can be used to extract an object from this environment
+#
+# x: the zooImageWarning
+# dots: what to extract from the environment
+`[[.zooImageWarning` <- function (x, ...)
+ x$env[[...]]
-#{{{ extractMessage
-#' extracts only the message of the error
-#'
-#' @param err error (generated by stop)
-#' @return the message without the "Error in ... :" part
-extractMessage <- function( err ){
- err[1] <- sub( "^.*?:", "", err[1] )
- err
+# Extract only the message of the error
+#
+# err: error (generated by stop)
+# Returns the message without the "Error in ... :" part
+extractMessage <- function (err)
+{
+ err[1] <- sub("^.*?:", "", err[1])
+ return(err)
}
-# }}}
-
-# :tabSize=4:indentSize=4:noTabs=false:folding=explicit:collapseFolds=1:
Modified: pkg/zooimage/R/log.R
===================================================================
--- pkg/zooimage/R/log.R 2010-04-08 13:34:50 UTC (rev 182)
+++ pkg/zooimage/R/log.R 2010-04-08 15:30:14 UTC (rev 183)
@@ -1,6 +1,6 @@
# Copyright (c) 2004, Ph. Grosjean <phgrosjean at sciviews.org>
#
-# This file is part of ZooImage .
+# This file is part of ZooImage
#
# ZooImage is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
@@ -17,37 +17,38 @@
# Functions for manipulating a log file for ZooImage.
-"logProcess" <- function(message, topic = NULL, file = file.path(tempdir(), "ZooImage.log"),
- logit = TRUE, stop = FALSE, show.log = stop) {
- if (!logit) {
- if (stop) stop(message)
- warning(message)
+"logProcess" <- function (message, topic = NULL,
+file = file.path(tempdir(), "ZooImage.log"), logit = TRUE, stop = FALSE,
+show.log = stop)
+{
+ if (!isTRUE(logit)) {
+ if (stop) stop(message) else warning(message)
return()
}
if (!file.exists(file))
- cat("===", getTemp("ZIname"), "log started", format(Sys.time()), "===\n\n", file = file)
- if (!is.null(topic) && topic != "") message <- paste(topic, message, sep = " - ")
+ cat("===", getTemp("ZIname"), "log started", format(Sys.time()),
+ "===\n\n", file = file)
+ if (!is.null(topic) && topic != "")
+ message <- paste(topic, message, sep = " - ")
if (stop) message <- paste("*CRITICAL*:", message)
message <- paste(sub("\n$", "", message), "\n", sep = "")
cat(message, file = file, append = TRUE)
if (show.log) logView(file)
}
-"logClear" <- function(file = file.path(tempdir(), "ZooImage.log")) {
+"logClear" <- function (file = file.path(tempdir(), "ZooImage.log"))
unlink(file)
-}
-"logView" <- function(file = file.path(tempdir(), "ZooImage.log"), title = paste(getTemp("ZIname"), "log"), clear = TRUE, warn = FALSE) {
+"logView" <- function (file = file.path(tempdir(), "ZooImage.log"),
+title = paste(getTemp("ZIname"), "log"), clear = TRUE, warn = FALSE)
+{
if (file.exists(file)) {
file.show(file, title = title, delete.file = clear)
} else if (warn) warning("Log file '", file, "' is not found!")
}
-# TODO: improve these
-logError <- function( e, msg= NULL, ... ){
- logProcess( if( is.null(msg)) e$msg else msg, e$context, stop = FALSE, ... )
-}
+"logError" <- function (e, msg = NULL, ...)
+ logProcess(if (is.null(msg)) e$msg else msg, e$context, stop = FALSE, ...)
-logWarning <- function( w, msg= NULL,... ){
- logProcess( if( is.null(msg)) e$msg else msg, w$context, stop = FALSE, ... )
-}
+"logWarning" <- function(w, msg = NULL, ...)
+ logProcess(if (is.null(msg)) e$msg else msg, w$context, stop = FALSE, ...)
Modified: pkg/zooimage/R/programs.R
===================================================================
--- pkg/zooimage/R/programs.R 2010-04-08 13:34:50 UTC (rev 182)
+++ pkg/zooimage/R/programs.R 2010-04-08 15:30:14 UTC (rev 183)
@@ -1,6 +1,6 @@
# {{{ Copyright (c) 2009, Ph. Grosjean <phgrosjean at sciviews.org>
#
-# This file is part of ZooImage .
+# This file is part of ZooImage
#
# ZooImage is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
Modified: pkg/zooimage/R/zzz.R
===================================================================
--- pkg/zooimage/R/zzz.R 2010-04-08 13:34:50 UTC (rev 182)
+++ pkg/zooimage/R/zzz.R 2010-04-08 15:30:14 UTC (rev 183)
@@ -1,6 +1,6 @@
# Copyright (c) 2004-2007, Ph. Grosjean <phgrosjean at sciviews.org>
#
-# This file is part of ZooImage .
+# This file is part of ZooImage
#
# ZooImage is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
@@ -16,41 +16,20 @@
# along with ZooImage. If not, see <http://www.gnu.org/licenses/>.
# Loading and unloading ZooImage.
-
-# {{{ Loading ZooImage
-".onAttach" <- function(libname, pkgname) {
-
- # {{{ check package dependencies
- (require(utils) || stop("Package 'utils' is required!"))
- (require(svMisc) || stop("Package 'svMisc' from SciViews bundle is required!"))
- (require(svWidgets) || stop("Package 'svWidgets' is required!"))
- (require(svDialogs) || stop("Package 'svDialogs' from SciViews bundle is required!"))
- (require(tcltk2) || stop("Package 'tcltk2' is required!"))
- # }}}
-
- # {{{ check capabilities
- checkZipAvailable()
- checkUnzipAvailable()
- checkZipnoteAvailable()
-
- # {{{
+".onAttach" <- function (libname, pkgname)
+{
if (!interactive()) options(ZIAssistant = FALSE)
- # }}}
- # {{{ Use the SciViews style for dialog boxes
+ # Use the SciViews style for dialog boxes
options(guiStyle = "SciViews")
- # }}}
- # {{{ Did we redefined the ZooImage config?
+ # Did we redefined the ZooImage config?
redef <- getOption("ZIredefine")
- if (is.null(redef)) {
- redef <- FALSE
- }
+ if (is.null(redef)) redef <- FALSE
options(ZIredefine = NULL)
- # }}}
- # {{{ Create some strings in TempEnv
- ZIversion <- packageDescription( "zooimage", field = "Version" )
+ # Create some strings in TempEnv
+ ZIversion <- packageDescription("zooimage", field = "Version")
assignTemp("ZIversion", ZIversion)
ZIname <- getTemp("ZIname")
@@ -59,24 +38,22 @@
assignTemp("ZIverstring", paste(ZIname, "version", ZIversion))
ZIetc <- getTemp("ZIetc")
- if (!redef || is.null(ZIetc)) {
+ if (!redef || is.null(ZIetc))
ZIetc <- file.path(.path.package(package = "zooimage")[1], "etc")
- }
assignTemp("ZIetc", ZIetc)
ZIgui <- getTemp("ZIgui")
- if (!redef || is.null(ZIgui)) {
+ if (!redef || is.null(ZIgui))
ZIgui <- file.path(.path.package(package = "zooimage")[1], "gui")
- }
assignTemp("ZIgui", ZIgui)
- # }}}
- # {{{ windows specific things
+ # Windows specific things
if (isWin()) {
if (interactive()) {
ZIico <- getTemp("ZIico")
if (!redef || is.null(ZIgui))
- ZIico <- tk2ico.create(file.path(getTemp("ZIgui"), "ZooImage.ico"))
+ ZIico <- tk2ico.create(file.path(getTemp("ZIgui"),
+ "ZooImage.ico"))
assignTemp("ZIico", ZIico)
}
@@ -85,130 +62,97 @@
tk2reg.setkey(ZIkey)
assignTemp("ZIkey", ZIkey)
}
- # }}}
- # {{{ Load the various image resources
+ # Load the various image resources
if (!redef && interactive()) ImgReadPackage("zooimage")
- # }}}
- # {{{ Load the menus
+ # Load the menus
if (!redef && interactive()) MenuReadPackage("zooimage")
- # }}}
- # {{{ Possibly create the ZIguiPackage variable to indicate from where to load other GUI resources
+ # Possibly create the ZIguiPackage variable to indicate from where to load
+ # other GUI resources
ZIguiPackage <- getTemp("ZIguiPackage")
if (!redef || is.null(ZIguiPackage))
ZIguiPackage <- "zooimage"
assignTemp("ZIguiPackage", ZIguiPackage)
- # }}}
- # {{{ Determine where to find the metadata editor
- if( isWin() ){
- ZIEditorExe <- system.file( "MetaEditor", "Sc1.exe", package = "zooimage" )
- if (file.exists(ZIEditorExe)){
- options(ZIEditor = ZIEditorExe)
- }
+ # Determine where to find the metadata editor
+ if (isWin()) {
+ ZIEditorExe <- system.file( "MetaEditor", "Sc1.exe",
+ package = "zooimage")
+ if (file.exists(ZIEditorExe)) options(ZIEditor = ZIEditorExe)
}
- # }}}
- # {{{ the directory that contains binary executables
- bindir <- system.file( "bin", package = "zooimage" )
- # }}}
+ # The directory that contains binary executables
+ bindir <- system.file("bin", package = "zooimage")
- # {{{ Determine where to find ImageJ
- ## TODO... currently, it is in a fixed position
+ # Determine where to find ImageJ
+ # TODO... currently, it is in a fixed position
# TODO: no need to ship the exe file, we can just ship a simple
- # bat file with
- # java -jar ij.jar -ijpath=./plugins
- if( isWin() ){
+ # bat file with java -jar ij.jar -ijpath=./plugins
+ if (isWin()) {
ImageJExe <- file.path(bindir, "ImageJ", "ImageJ.exe")
- if (file.exists(ImageJExe)){
- options(ImageEditor = ImageJExe)
- }
+ if (file.exists(ImageJExe)) options(ImageEditor = ImageJExe)
}
- # }}}
- # {{{ Determine where to find XnView
+ # Determine where to find XnView
## TODO... currently, it is in a fixed position
XnViewExe <- file.path(bindir, "XnView", "XnView.exe")
- if( isWin() ){
- if (file.exists(XnViewExe)){
- options(ImageViewer = XnViewExe)
- }
+ if (isWin()) {
+ if (file.exists(XnViewExe)) options(ImageViewer = XnViewExe)
} else{
# TODO: deal with mac
# TODO: can we rely on nautilus ? it might not be installed on
# kde based distributions
-
}
- # }}}
- # {{{ Determine where to find the zip viewer (Filzip under Windows)
+ # Determine where to find the zip viewer (Filzip under Windows)
## TODO... currently, it is in a fixed position
if (isWin()) {
FilzipExe <- file.path(bindir, "Filzip", "Filzip.exe")
- if (file.exists(FilzipExe)){
- options(ZipViewer = FilzipExe)
- }
- } else{
-
+ if (file.exists(FilzipExe)) options(ZipViewer = FilzipExe)
+ } else {
+ # TODO: alternate program to inspect .zid files?
}
- # }}}
- # {{{ Determine where to find the DVD burner (DeepBurner under Windows)
+ # Determine where to find the DVD burner (DeepBurner under Windows)
## TODO... currently, it is in a fixed position
if (isWin()) {
DeepBurnerExe <- file.path(bindir, "DeepBurner", "DeepBurner.exe")
- if (file.exists(DeepBurnerExe)){
- options(DVDBurner = DeepBurnerExe)
- }
+ if (file.exists(DeepBurnerExe)) options(DVDBurner = DeepBurnerExe)
}
- # }}}
- # {{{ Determine where to find VueScan
+ # Determine where to find VueScan
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/zooimage -r 183
More information about the Zooimage-commits
mailing list