[Sciviews-commits] r81 - in pkg/svTools: . R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sat Dec 6 10:47:04 CET 2008
Author: romain
Date: 2008-12-06 10:47:04 +0100 (Sat, 06 Dec 2008)
New Revision: 81
Modified:
pkg/svTools/DESCRIPTION
pkg/svTools/R/checkUsage.R
pkg/svTools/R/sidekick.R
pkg/svTools/R/tryParse.R
Log:
making sidekick and checkUsageFile encoding aware
Modified: pkg/svTools/DESCRIPTION
===================================================================
--- pkg/svTools/DESCRIPTION 2008-12-03 13:46:58 UTC (rev 80)
+++ pkg/svTools/DESCRIPTION 2008-12-06 09:47:04 UTC (rev 81)
@@ -1,8 +1,8 @@
Package: svTools
Type: Package
Title: Set of tools (wrapper for packages tools and codetools)
-Version: 0.0-3
-Date: 2008-11-19
+Version: 0.0-4
+Date: 2008-12-06
Author: Romain Francois <francoisromain at free.fr>
Maintainer: Romain Francois <francoisromain at free.fr>
Description: Set of tools aimed at wrapping some of the functionalities
Modified: pkg/svTools/R/checkUsage.R
===================================================================
--- pkg/svTools/R/checkUsage.R 2008-12-03 13:46:58 UTC (rev 80)
+++ pkg/svTools/R/checkUsage.R 2008-12-06 09:47:04 UTC (rev 81)
@@ -5,12 +5,18 @@
#' file and identifies where are located each of the findings of checkUsage
#' @export
#' @param file file to analyse
+#' @param encoding Character encoding to use
#' @return A data frame containing information about errors
#' @author Romain Francois \email{francoisromain@@free.fr}
-checkUsageFile <- function( file ){
+checkUsageFile <- function( file, encoding = "unknown" ){
+ if( encoding != "unknown" ){
+ old.op <- options( encoding = encoding )
+ on.exit( options( old.op ) )
+ }
+
### first parse for errors
- p.out <- tryParse( file, action = addError )
+ p.out <- tryParse( file, action = addError, encoding = encoding )
if( p.out %of% "data.frame" ){
return( getErrors( file = file ) )
}
@@ -32,9 +38,9 @@
exprs <- p[[i]][[3]][[3]]
srcref <- do.call( rbind, lapply( attr( exprs, "srcref" ), as.integer ) )
for( j in 1:length( exprs ) ){
- src <- as.character( attr( exprs, "srcref" )[[j]] )
+ src <- as_character_srcref( attr( exprs, "srcref" )[[j]], useSource = TRUE, encoding = encoding )
matchingLines <- grep( sprintf(rx2, param), src )
- if( length( matchingLines ) ){
+ if( length( matchingLines ) ){
return( matchingLines + as.integer( srcref[j,1] ) - 1 )
}
}
@@ -93,9 +99,9 @@
codetools:::checkUsage( env[[fname]], all = TRUE, report = report, name = "" )
if( length(findings) ){
- searchAndReport( "changed by assignment" , find.local_assigned_but_not_used )
- searchAndReport( "assigned but may not be used" , find.no_global_def )
- searchAndReport( "no visible global function definition", find.no_local_def_as_function )
+ searchAndReport( "changed by assignment" , find.parameter_changed_by_assignment)
+ searchAndReport( "assigned but may not be used" , find.local_assigned_but_not_used)
+ searchAndReport( "no visible global function definition", find.no_global_def )
searchAndReport( "no apparent local function definition", find.no_local_def_as_function )
searchAndReport( "multiple local function definitions" , find.multiple_local_def )
@@ -114,3 +120,29 @@
}
+as_character_srcref <- function (x, useSource = TRUE, encoding = "unknown"){
+ srcfile <- attr(x, "srcfile")
+ if (useSource)
+ lines <- try(getSrcLines_(srcfile, x[1], x[3], encoding = encoding), TRUE)
+ if (!useSource || inherits(lines, "try-error"))
+ lines <- paste("<srcref: file \"", srcfile$filename,
+ "\" chars ", x[1], ":", x[2], " to ", x[3], ":",
+ x[4], ">", sep = "")
+ else {
+ if (length(lines) < x[3] - x[1] + 1)
+ x[4] <- .Machine$integer.max
+ lines[length(lines)] <- substring(lines[length(lines)], 1, x[4])
+ lines[1] <- substring(lines[1], x[2])
+ }
+ lines
+}
+
+getSrcLines_ <- function (srcfile, first, last, encoding = "unknown" ){
+ if (first > last)
+ return(character(0))
+ lines <- tail( readLines(srcfile, n = last, warn = FALSE, encoding = encoding), -(first-1) )
+ return(lines)
+}
+
+
+
Modified: pkg/svTools/R/sidekick.R
===================================================================
--- pkg/svTools/R/sidekick.R 2008-12-03 13:46:58 UTC (rev 80)
+++ pkg/svTools/R/sidekick.R 2008-12-06 09:47:04 UTC (rev 81)
@@ -4,6 +4,7 @@
#' the R parser (parse) into a rectangular representation
#' @export
#' @param file File to parse
+#' @param encoding the character encoding to use
#' @return A data frame with the following columns :
#' - id : Identifier of the current node
#' - srcref1, ..., srcref4 : identifies the position of the current node in the file
@@ -15,9 +16,18 @@
#' cat( "jitter <- " , deparse( jitter ), sep = "\n", file = tf )
#' sidekick( tf )
#' unlink( tf )
-sidekick <- function( file ){
+sidekick <- function( file, encoding = "unknown" ){
+
+ if( is.character(file) ){
+ filename <- file
+ file <- file( filename, encoding = encoding )
+ on.exit( close( file ) )
+ } else{
+ filename <- summary(f)$description
+ }
+
### try to parse and return an error if failed
- p <- try( parse( file ), silent = TRUE )
+ p <- try( parse( file, srcfile=filename ), silent = TRUE )
if( p %of% "try-error" ){
return( list( type = "error", data = parseError( p ) ) )
}
Modified: pkg/svTools/R/tryParse.R
===================================================================
--- pkg/svTools/R/tryParse.R 2008-12-03 13:46:58 UTC (rev 80)
+++ pkg/svTools/R/tryParse.R 2008-12-06 09:47:04 UTC (rev 81)
@@ -6,8 +6,17 @@
#' @return If the parsing is sucessful, the output of the standard parse function is returned
#' otherwise, the error that is generated by parse is structured by \code{\link{parseError}}
#' @author Romain Francois \email{francoisromain@@free.fr}
-tryParse <- function(file, action){
- out <- try( parse(file) , silent = TRUE)
+tryParse <- function(file, action, encoding = "unknown" ){
+
+ if( is.character(file) ){
+ filename <- file
+ file <- file( filename, encoding = encoding )
+ on.exit( close( file ) )
+ } else{
+ filename <- summary( file )$description
+ }
+
+ out <- try( parse(file, srcfile = filename) , silent = TRUE)
if( inherits(out, "try-error") ) {
err <- parseError( out )
if( !missing(action) ) action( err )
More information about the Sciviews-commits
mailing list