[Sciviews-commits] r318 - in pkg/svTools: . R data man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Sep 26 22:59:47 CEST 2010
Author: phgrosjean
Date: 2010-09-26 22:59:47 +0200 (Sun, 26 Sep 2010)
New Revision: 318
Added:
pkg/svTools/R/completeDescription.R
pkg/svTools/R/completeNamespace.R
pkg/svTools/R/completeRoxygen.R
pkg/svTools/R/lintDescription.R
pkg/svTools/R/lintNamespace.R
pkg/svTools/R/lintUsage.R
pkg/svTools/R/parseIndex.R
pkg/svTools/R/parseRd.R
pkg/svTools/R/searchEngines.R
pkg/svTools/R/svTools-internal.R
pkg/svTools/data/bibRNews.rda
pkg/svTools/man/bibRNews.Rd
pkg/svTools/man/completeNamespace.Rd
pkg/svTools/man/completeRoxygen.Rd
pkg/svTools/man/completion.Rd
pkg/svTools/man/lintDescription.Rd
pkg/svTools/man/lintNamespace.Rd
pkg/svTools/man/lintUsage.Rd
pkg/svTools/man/pkgDesc.Rd
pkg/svTools/man/searchEngines.Rd
pkg/svTools/man/svTools-package.Rd
Removed:
pkg/svTools/R/checkUsage.R
pkg/svTools/R/check_description.R
pkg/svTools/R/check_namespace.R
pkg/svTools/R/complete_description.R
pkg/svTools/R/complete_namespace.R
pkg/svTools/R/rdparse.R
pkg/svTools/R/read.INDEX.R
pkg/svTools/R/roxygen.R
pkg/svTools/R/search_engines.R
pkg/svTools/R/zzz.R
pkg/svTools/man/CompletePlusWrap.Rd
pkg/svTools/man/checkUsageFile.Rd
pkg/svTools/man/check_description.Rd
pkg/svTools/man/installedPackages.Rd
pkg/svTools/man/loadedPackages.Rd
pkg/svTools/man/namespaceParser.Rd
Modified:
pkg/svTools/DESCRIPTION
pkg/svTools/NAMESPACE
pkg/svTools/NEWS
pkg/svTools/R/completion.R
pkg/svTools/R/errorlist.R
pkg/svTools/R/packages.R
pkg/svTools/R/parseError.R
pkg/svTools/R/sidekick.R
pkg/svTools/R/tryParse.R
pkg/svTools/R/trySource.R
pkg/svTools/TODO
pkg/svTools/data/descriptionFields.rda
pkg/svTools/man/completeDescription.Rd
pkg/svTools/man/descriptionFields.Rd
pkg/svTools/man/generateRoxygenTemplate.Rd
pkg/svTools/man/sidekick.Rd
Log:
Complete refactoring of the svTools package
Modified: pkg/svTools/DESCRIPTION
===================================================================
--- pkg/svTools/DESCRIPTION 2010-09-25 09:44:18 UTC (rev 317)
+++ pkg/svTools/DESCRIPTION 2010-09-26 20:59:47 UTC (rev 318)
@@ -2,14 +2,14 @@
Type: Package
Title: SciViews GUI API - Tools (wrapper for packages tools and codetools)
Depends: R (>= 2.6.0)
-Imports: utils, tools, codetools, svMisc, operators
+Imports: utils, tools, codetools, svMisc
Description: Set of tools aimed at wrapping some of the functionalities
of the packages tools, utils and codetools into a nicer format so
that an IDE can use them
-Version: 0.0-12
-Date: 2009-10-17
+Version: 0.9-0
+Date: 2010-09-26
Author: Romain Francois
-Maintainer: Romain Francois <francoisromain at free.fr>
+Maintainer: Philippe Grosjean <phgrosjean at sciviews.org>
License: GPL-2
LazyLoad: yes
LazyData: yes
Modified: pkg/svTools/NAMESPACE
===================================================================
--- pkg/svTools/NAMESPACE 2010-09-25 09:44:18 UTC (rev 317)
+++ pkg/svTools/NAMESPACE 2010-09-26 20:59:47 UTC (rev 318)
@@ -1,58 +1,42 @@
-import(utils, tools, codetools, svMisc, operators )
+import(utils, tools, codetools, svMisc)
-export(generateRoxygenTemplate)
-export(checkUsageFile)
+export(browse,
+ completeCode,
+ completeCol,
+ completeDescription,
+ completeNamespace,
+ completeLty,
+ completePch,
+ completeRoxygen,
+ completeRoxygenParam,
+ generateRoxygenTemplate,
+ lintDescription,
+ lintNamespace,
+ lintUsage,
+ pkgDesc,
+ pkgInstalled,
+ pkgLoaded,
+ pkgWebDesc,
+ searchBiblio,
+ searchGraph,
+ searchMailing,
+ searchPackage,
+ searchWiki,
+ sidekick)
+# Currently hidden, but my be exported in the future
+# addError,
+# emptyError,
+# getErrors,
+# resetErrors,
+# tryParse,
+# trySource,
+# parseError,
+# parseIndex,
+# parseRd)
-# sidekick.R
-export(sidekick)
-S3method( sidekick, "function")
-S3method( sidekick, "default")
-S3method( sidekick, "character")
+S3method(sidekick, "default")
+S3method(sidekick, "character")
+S3method(sidekick, "function")
-# errorlist.R
-#export(getErrors)
-#export(addError)
-#export(resetErrors)
-#export(emptyError)
-
-# parseError.R
-#export(parseError)
-
-# tryParse.R
-#export(tryParse)
-
-# trySource.R
-#export(trySource)
-
-# check_description.R
-export(check_description)
-
-# complete_description.R
-export(completeDescription)
-
-# completion.R
-#export(ltyComplete)
-#export(colComplete)
-#export(pchComplete)
-export(CompletePlusWrap)
-
-# complete_namespace.R
-#export(namespaceComplete)
-
-# check_namespace.R
-export(namespaceParser)
-
-# packages.R
-#export(packwebdesc)
-#export(packdesc)
-export(installedPackages)
-export(loadedPackages)
-
-# rdparse.R
-#export(rdparse)
-
-# S3method(print, rsitesearch)
-# S3method(head, rsitesearch)
-# S3method(tail, rsitesearch)
-# S3method(summary, rsitesearch)
-# S3method("[", rsitesearch)
+S3method(print, "search")
+S3method(browse, "search")
Modified: pkg/svTools/NEWS
===================================================================
--- pkg/svTools/NEWS 2010-09-25 09:44:18 UTC (rev 317)
+++ pkg/svTools/NEWS 2010-09-26 20:59:47 UTC (rev 318)
@@ -1,21 +1,29 @@
= svTools News
+== Change in svTools 0.9-0
+
+* This is a major rewriting of the package. Dependency to operators was
+ eliminated, and most functions and arguments have changed!
+
+
== Changes in svTools 0.0-12
-* sidekick is now generic
+* sidekick is now generic.
+
== Changes in svTools 0.0-11
-* Further clean up of the NAMESPACE and DESCRIPTION files
+* Further clean up of the NAMESPACE and DESCRIPTION files.
+
== Changes in svTools 0.0-10
-* Cleaning for CRAN submission
+* Cleaning for CRAN submission.
== Changes in svTools 0.0-8
-* Handling the token better in CompletePlusWrap
+* Handling the token better in CompletePlusWrap().
== Version 0.0-5
Deleted: pkg/svTools/R/checkUsage.R
===================================================================
--- pkg/svTools/R/checkUsage.R 2010-09-25 09:44:18 UTC (rev 317)
+++ pkg/svTools/R/checkUsage.R 2010-09-26 20:59:47 UTC (rev 318)
@@ -1,155 +0,0 @@
-#' Wrapper for the checkUsage function in codetools
-#'
-#' Wrapper for the checkUsage function in codetools.
-#' This one parses a file, calls checkUsage on every function of the
-#' 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, encoding = "unknown" ){
-
- if( is.character(file) && file %~% '^rwd:' ){
- file <- sub( '^rwd:', getwd(), file )
- }
-
- if( encoding != "unknown" ){
- old.op <- options( encoding = encoding )
- on.exit( options( old.op ) )
- }
-
- ### first parse for errors
- p.out <- tryParse( file, action = addError, encoding = encoding )
- if( p.out %of% "data.frame" ){
- return( getErrors( file = file ) )
- }
- if( length( p.out ) == 0){
- return( emptyError() )
- }
- resetErrors( file = file )
-
- # silly hack to retrieve information from codetools
- here <- environment()
- findings <- NULL
- report <- function( x ){
- assign( "findings", c( findings, x ), envir = here )
- }
-
- ..addError <- function( line, msg ){
- addError( line = line, message = msg %-~% "(\\\n|^: )" , file = file, type = "warning" )
- }
-
-
- finding <- function( txt, p, i, rx, rx2 ){
- param <- sub( rx, "\\1", txt )
- param <- gsub( "\\.", "\\\\.", param )
- exprs <- p[[i]][[3]][[3]]
- srcref <- do.call( rbind, lapply( attr( exprs, "srcref" ), as.integer ) )
- for( j in 1:length( exprs ) ){
- src <- as_character_srcref( attr( exprs, "srcref" )[[j]], useSource = TRUE, encoding = encoding )
- matchingLines <- grep( sprintf(rx2, param), src )
- if( length( matchingLines ) ){
- return( matchingLines + as.integer( srcref[j,1] ) - 1 )
- }
- }
- }
-
- find.parameter_changed_by_assignment <- function( txt, p, i ){
- finding( txt, p, i,
- rx = "^.*: parameter .(.*). changed by assignment\\\n",
- rx2 = "[^.a-zA-Z0-9_]*%s[[:space:]]*(=|<-|<<-)" )
- }
-
- find.local_assigned_but_not_used <- function( txt, p, i ){
- finding( txt, p, i,
- rx = "^.*: local variable .(.*). assigned but may not be used\\\n",
- rx2 = "^[^.a-zA-Z0-9_(,]*%s[[:space:]]*(=|<-|<<-)" )
- }
-
- find.no_global_def <- function( txt, p, i ){
- finding( txt, p, i,
- rx = "^.*: no visible global function definition for .(.*).\\\n",
- rx2 = "[^.a-zA-Z0-9_]*%s[[:space:]]*\\(" )
- }
-
- find.no_local_def_as_function <- function( txt, p, i ){
- finding( txt, p, i,
- rx = "^.*: local variable .(.*). used as function with no apparent local function definition\\\n",
- rx2 = "[^.a-zA-Z0-9_]*%s[[:space:]]*\\(" )
- }
-
- find.multiple_local_def <- function( txt, p, i ){
- finding( txt, p, i,
- rx = "^.*: multiple local function definitions for .(.*). with different formal arguments\\\n",
- rx2 = "[^.a-zA-Z0-9_]*%s[[:space:]]*(=|<-|<<-)[[:space:]]*function" )
- }
-
-
- searchAndReport <- function( regex, fun ){
- if( length( test.match <- grep( regex, findings ) ) ){
- for( j in test.match ){
- out <- fun( findings[j], p.out, i)
- if( length( out) ){
- ..addError( out, findings[j] )
- }
- }
- }
- }
-
-
- for( i in 1:length(p.out) ){
- if( looksLikeAFunction( p.out[[i]] ) ){
- env <- new.env()
- eval( p.out[[i]], envir = env )
- fname <- ls( env )
- if( length(fname) == 1){
- findings <- NULL
- checkUsage( env[[fname]], all = TRUE, report = report, name = "" )
- if( length(findings) ){
-
- 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 )
-
- # TODO :this needs to be improved to deal with nested functions
- if( length( test.assign <- grep( " may not be used", findings ) ) ){
- for( j in test.assign ){
- ..addError( attr(p.out, "srcref")[[i]][1] , findings[j] )
- }
- }
-
- }
- }
- }
- }
- getErrors( file = file )
-}
-
-
-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)
-}
-
Deleted: pkg/svTools/R/check_description.R
===================================================================
--- pkg/svTools/R/check_description.R 2010-09-25 09:44:18 UTC (rev 317)
+++ pkg/svTools/R/check_description.R 2010-09-26 20:59:47 UTC (rev 318)
@@ -1,121 +0,0 @@
-
-check_description <- function( descfile, txt = readLines( descfile ) ){
-
- txt <- txt %/~% "\\\n"
- resetErrors( file = descfile )
- ..addError <- function( file = descfile, line, message, type = "error" ) {
- addError(file=file,line=line, message = message, type = type )
- }
-
- ### check mandatory fields
- for( mandatory in c("Package", "Version", "License", "Description", "Title", "Author", "Maintainer" )){
- if( !any( txt %~% sprintf("^%s", mandatory) ) ){
- ..addError( line = 1, message = sprintf("field `%s` is mandatory", mandatory ) )
- }
- }
-
- ### check the fields
- fields <- txt %~|% "^[^:]+:" %-~% "[[:space:]]*:.*$"
- if( ! all( test <- fields %in% descriptionFields[,1] ) ){
- wrongFields <- fields[!test]
- lapply( wrongFields, function(x){
- rx.out <- regexpr( sprintf("^%s *:", x), txt )
- line <- which( rx.out != -1 )
- ..addError( line = line, message = sprintf("Wrong field : `%s`", x ) )
- })
- }
-
- ### check the package name
- package <- grep("^Package[[:space:]]*:", txt )
- if( length(package )) {
- packageName <- txt[package] %-~% "(^[^:]*:| )"
- if( packageName %!~% "^[a-zA-Z][\\.0-9a-zA-Z]*$" ){
- ..addError( line = package, message = "wrong package name")
- }
- }
-
- ### check the version
- version <- grep("^Version:", txt )
- if( length(version) ){
- versionNumber <- txt[version] %-~% "(^[^:]*:| )"
- # TODO: handle translation packages
- if( versionNumber %~% "[^0-9\\.-]" ){
- ..addError( line = version, message = "Wrong format for the version number", type = "warning" )
- }
- nfields <- length(versionNumber %/~% "[-\\.]" )
- if( nfields < 2){
- ..addError( line = version, message = "Wrong version number, need at least two fields" , type = "warning")
- }
- if( nfields > 3 ){
- ..addError( line = version, message = "Wrong version number, too many fields", type = "warning" )
- }
- }
-
- ### check maintainer
- maintainer <- grep( "^Maintainer:", txt )
- if(length(maintainer)){
- maintainerLine <- txt[ maintainer ] %-~% "^[^:]: *"
- if( maintainerLine %~% "[\\.,]$" ){
- ..addError( line = maintainer, message = "the maintainer field should not end with a period or commas" )
- }
- if( length(maintainerLine %/~% "@") != 2 ){
- ..addError( line = maintainer,
- message = "only one email adress in Maintainer field" )
- }
- email <- maintainerLine %-~% "(^[^<]*<|>[^>]*$)"
- if( email %!~% "[^@]+@[^@]+" | email %~% "[[:space:]]" ){
- ..addError( line = maintainer,
- message = paste("wrong email adress: '", email, "'", sep = "" ) )
- }
- }
-
- ### check date
- date <- grep("^Date", txt )
- if(length(date)){
- dateLine <- txt[date] %-~% "(^[^:]*:| )"
- if( dateLine %!~% "^[0-9]{4}-[0-9]{1,2}-[0-9]{1,2}$" ){
- ..addError( line = date, message = "the date should be in format yyyy-mm-dd" )
- }
- }
-
- ### check the dependencies
- # FIXME : all the stuff below comes from tools, I need to figure out what to do with it
- db <- tools:::.read_description(descfile)
- depends <- tools:::.get_requires_from_package_db(db, "Depends")
- imports <- tools:::.get_requires_from_package_db(db, "Imports")
- suggests <- tools:::.get_requires_from_package_db(db, "Suggests")
- standard_package_names <- tools:::.get_standard_package_names()
- bad_depends <- list()
- reqs <- unique(c(depends, imports, if (!identical(as.logical(Sys.getenv("_R_CHECK_FORCE_SUGGESTS_")),
- FALSE)) suggests))
- installed <- character(0)
- for (lib in .libPaths()) {
- pkgs <- list.files(lib)
- pkgs <- pkgs[file.access(file.path(lib, pkgs, "DESCRIPTION"),
- 4) == 0]
- installed <- c(pkgs, installed)
- }
- installed <- sub("_.*", "", installed)
- reqs <- reqs %without% installed
- m <- reqs %in% standard_package_names$stubs
- if (length(reqs[!m]))
- bad_depends$required_but_not_installed <- reqs[!m]
- if (length(reqs[m]))
- bad_depends$required_but_stub <- reqs[m]
-
- if( length(bad <- bad_depends$required_but_not_installed) ) {
- ..addError( line = grep("^(Depends|Suggests|Enhances)", txt),
- message = paste("package `",bad,"` required but not installed", sep = "") )
- }
-
- if( length(bad <- bad_depends$required_but_stub) ) {
- ..addError( line = grep("^(Depends|Suggests|Enhances)", txt),
- message = paste("package `",bad,"` required but stub", sep = "") )
- }
-
- invisible( getErrors( file = descfile ) )
-
-}
-
-
-
Deleted: pkg/svTools/R/check_namespace.R
===================================================================
--- pkg/svTools/R/check_namespace.R 2010-09-25 09:44:18 UTC (rev 317)
+++ pkg/svTools/R/check_namespace.R 2010-09-26 20:59:47 UTC (rev 318)
@@ -1,162 +0,0 @@
-
-namespaceDirectives <- c("export",
- "exportPattern", "exportClass", "exportClasses",
- "exportMethods", "import", "importFrom",
- "importClassFrom", "importClassesFrom",
- "importMethodsFrom", "useDynLib", "S3method", "if" )
-
-namespaceParser <- function( NAMESPACE, checkPackages = TRUE ){
- resetErrors( file = NAMESPACE )
- if( checkPackages ) allpacks <- .packages( all.available = TRUE )
- ### look for the 'object is not subsettable' error
- test <- try( tools:::.check_namespace(
- dirname( tools:::file_path_as_absolute( NAMESPACE ) ) ),
- silent = TRUE )
- if( test %of% "try-error" ){
- if( test %~% "object is not subsettable" ){
- lengths <- sapply( p, length )
- if( any( lengths == 1 ) ){
- line <- attr( p, "srcref" )[[ which( lengths == 1 )[1] ]] [1]
- addError(file=NAMESPACE, line=line, message = "object is not subsettable" )
- }
- } else {
- addError( parseError( test ) )
- }
- }
-
- ### look for unexpected namespace directives
- p <- suppressWarnings( parse( NAMESPACE ) )
-
- directives <- sapply( p, function(x) as.character(x[[1]]) )
- if( any( test <- ! directives %in% namespaceDirectives ) ){
- problemLine <- sapply( attr( p, "srcref" )[ test ], function(x) as.integer(x[1] ) )
- addError(file=NAMESPACE, line=problemLine,
- message = paste( "`", directives[test] , "` : Wrong NAMESPACE directive", sep = ""),
- type = "warning" )
- }
-
-
- nS3 <- 0
- here <- environment()
-
- ### parse the directives and look for the unexpected
- parseDirective <- function(e, srcref, p, i) {
- asChar <- function(cc) {
- r <- as.character(cc)
- if (any(r == "")){
- addError( file = NAMESPACE, type = "error",
- message = gettextf("empty name in directive '%s' in NAMESPACE file", as.character(e[[1]]) ),
- line = srcref[1] )
- }
- r
- }
- switch(as.character(e[[1]]),
- "if" = if (eval(e[[2]], .GlobalEnv)) parseDirective(e[[3]], srcref) else if (length(e) == 4) parseDirective(e[[4]], srcref),
- "{" = for (ee in as.list(e[-1])) parseDirective(ee, srcref),
- "=", "<-" = {
- parseDirective(e[[3]], srcref)
- # if (as.character(e[[3]][[1]]) == "useDynLib")
- # names(dynlibs)[length(dynlibs)] <<- asChar(e[[2]])
- }, export = {
- exp <- e[-1]
- exp <- structure(asChar(exp), names = names(exp))
- if( !length( exp ) ){
- addError( file = NAMESPACE, line = srcref[1],
- message = "empty export", type = "warning" )
- }
- # TODO: check that the object exists
- }, exportPattern = {
- pat <- asChar(e[-1])
- if( !length( pat ) ){
- addError( file = NAMESPACE, line = srcref[1],
- message = "empty pattern", type = "warning" )
- }
- if( asChar( attr( p, "srcref") [[i]]) %~% "[^\\\\]\\\\[^\\\\]" ){
- addError( file= NAMESPACE, line = srcref[1],
- message = "wrong pattern, need to double escape",
- type = "warning" )
- }
- # TODO: try to match the regex against object names
- # and warn if there is no match
- }, exportClass = , exportClasses = {
- # TODO: check that the class is defined
- }, exportMethods = {
- # TODO: check that the methods are defined
- }, import = {
- packages <- asChar(e[-1])
- if( !length( packages) ){
- addError( file = NAMESPACE, line = srcref[1],
- message = "empty import directive", type = "warning" )
- }
- test <- packages %in% allpacks
- if( any(!test) ){
- addError( line = srcref[1], file = NAMESPACE, type = "error",
- message = sprintf( "package `%s` is set to be imported but is not available", packages[!test] ) )
- }
- },
- importFrom = {
- imp <- asChar( e[-1] )
- if( length( imp) < 2 ){
- addError( file = NAMESPACE, line = srcref[1],
- message = "Not enough information in importFrom directive",
- type = "error" )
- } else{
- if( ! require( imp[1], character.only = TRUE ) ){
- addError( line = srcref[1], file = NAMESPACE, type = "error",
- message = sprintf( "package `%s` is set to be imported but is not available", imp[1] ) )
- } else if( any( test <- !imp[-1] %in% ls( sprintf("package:%s", imp[1]) ) ) ){
- addError( line = srcref[1], file = NAMESPACE, type = "error",
- message = sprintf("object `%s` not exported from %s", imp[-1][test], imp[1]) )
- }
- # TODO: check if the variables are exported from the package
- }
-
- }, importClassFrom = , importClassesFrom = {
- imp <- asChar( e[-1] )
- if( length( imp) < 2 ){
- addError( file = NAMESPACE, line = srcref[1],
- message = "Not enough information in importFrom directive",
- type = "error" )
- } else{
- if( ! require( imp[1], character.only = TRUE ) ){
- addError( line = srcref[1], file = NAMESPACE, type = "error",
- message = sprintf( "package `%s` is set to be imported but is not available", imp[1] ) )
-
- }
- # TODO: check if the classes are exported from the package
- }
- }, importMethodsFrom = {
- imp <- asChar( e[-1] )
- if( length( imp) < 2 ){
- addError( file = NAMESPACE, line = srcref[1],
- message = "Not enough information in importFrom directive",
- type = "error" )
- } else{
- if( ! require( imp[1], character.only = TRUE ) ){
- addError( line = srcref[1], file = NAMESPACE, type = "error",
- message = sprintf( "package `%s` is set to be imported but is not available", imp[1] ) )
-
- }
- # TODO: check if the methods are exported from the package
- }
- }, useDynLib = {
- # TODO: do something about it
- }, S3method = {
- spec <- e[-1]
- if (length(spec) != 2 && length(spec) != 3)
- addError( message = gettextf("bad 'S3method' directive: %s", deparse(e)),
- file = NAMESPACE, line = srcref[1], type = "error" )
- assign( "nS3", get("nS3", envir = here) + 1, envir = here )
- if (nS3 > 500)
- addError( message= "too many 'S3method' directives",
- file = NAMESPACE, line = srcref[1], type = "error" )
- } )
- }
- for (i in 1:length(p) ) {
- srcref <- attr( p, "srcref" )
- parseDirective( p[[i]], as.integer( srcref[[i]] ), p, i )
- }
- invisible( getErrors( file = NAMESPACE ) )
-
-}
-
Added: pkg/svTools/R/completeDescription.R
===================================================================
--- pkg/svTools/R/completeDescription.R (rev 0)
+++ pkg/svTools/R/completeDescription.R 2010-09-26 20:59:47 UTC (rev 318)
@@ -0,0 +1,98 @@
+completeDescription <- function (file, row, column, text = readLines(file),
+author = getOption("svTools.description.author"))
+{
+ if (missing(text)) {
+ n <- if (missing(row)) -1 else row
+ rl <- readLines(file, n = n)
+ row <- length(rl)
+ if (missing(column)) column <- nchar(rl[row])
+ } else {
+ rl <- unlist(strsplit(text, "\\\n"))
+ row <- length(rl)
+ column <- nchar(rl[row])
+ }
+ rl[row] <- substring(rl[row], 1, column)
+ lastLine <- rl[row]
+
+ if (regexpr("^( +|[^:]+:)", lastLine) > 0) {
+ ## Extract the last field
+ lastField <- tail(which(regexpr("^[^:]+:", rl) > 0), 1)
+ field <- gsub("(:.*$|[[:space:]]+)", "", rl[lastField])
+
+ ## Complete package names
+ if (field %in% c("Depends", "Suggests", "Enhances", "Imports")) {
+ start <- gsub(".*[,[:space:]]", "", lastLine)
+ packages <- pkgInstalled(pattern = start)[,
+ c("Package", "Title"), drop = FALSE]
+ return(list(data = packages, token = start, ok = 1,
+ type = "package"))
+ }
+
+ ## Use the "svTools.description.author" option to complete
+ if (field %in% c("Author", "Maintainer")) {
+ if (!is.null(author)) {
+ return(list(ok = 1, data = cbind(author, ""),
+ token = gsub(".*: *", "", lastLine), type = "other"))
+ } else return(list(ok = 0))
+ }
+
+ ## Possible licenses
+### TODO: add 'see LICENSE' if the file exists (or make sure it exists?!)
+ if (field == "License") {
+ possibleLicenses <- rbind(
+ c("GPL-2", 'The "GNU General Public License" version 2'),
+ c("GPL-3", 'The "GNU General Public License" version 3'),
+ c("LGPL-2", 'The "GNU Library General Public License" version 2'),
+ c("LGPL-2.1", 'The "GNU Lesser General Public License" version 2.1'),
+ c("LGPL-3", 'The "GNU Lesser General Public License" version 3'),
+ c("AGPL-3", 'The "GNU Affero General Public License" version 3'),
+ c("Artistic-1.0", 'The "Artistic License" version 1.0'),
+ c("Artistic-2.0", 'The "Artistic License" version 2.0'))
+ return(list(ok = TRUE, data = possibleLicenses,
+ token = gsub(".*: *", "", lastLine), type = "other"))
+ }
+
+ ## Propose today's date
+ if (field == "Date") {
+ data <- cbind(format(Sys.time(), "%Y-%m-%d"), "Today")
+ return(list(ok = TRUE, data = data,
+ token = gsub(".*: *", "", lastLine), type = "other"))
+ }
+
+ ## Fields that are supposed to accept only yes/no values
+ if (field %in% c("LazyLoad", "LazyData", "ZipData")) {
+ data <- rbind(c("yes", ""), c("no", ""))
+ return(list(ok = TRUE, data = data,
+ token = gsub(".*: *", "", lastLine), type = "other"))
+ }
+
+ ## Encoding... only propose most current ones, or a more exhaustive list?
+ if (field == "Encoding") {
+ data <- rbind(c("latin1" , ""), c("latin2" , ""), c("UTF-8" , ""))
+ return(list(ok = TRUE, data = data,
+ token = gsub(".*: *", "", lastLine), type = "other"))
+ }
+
+ ## Package type
+ if (field == "Type") {
+ data <- rbind(c("Package", "Usual package"),
+ c("Translation", "Translation package"),
+ c("Frontend", "Frontend package"))
+ return(list(ok = TRUE, data = data,
+ token = gsub(".*: *", "", lastLine), type = "other"))
+ }
+
+ ## Give up
+ return(list(ok = FALSE))
+
+ } else if (regexpr("[^[:alpha:]]", lastLine) > 0) {
+ return(list(ok = FALSE))
+ } else {
+ keep <- (regexpr(lastLine, descriptionFields[, 1]) > 0 |
+ regexpr(lastLine, descriptionFields[, 3]) > 0)
+ data <- as.matrix(descriptionFields[keep, c(1, 3), drop = FALSE])
+ data[, 1] <- paste(data[, 1], ": ", sep = "")
+ return(list(data = data, ok = TRUE, token = lastLine, type = "fields"))
+ }
+}
+
Added: pkg/svTools/R/completeNamespace.R
===================================================================
--- pkg/svTools/R/completeNamespace.R (rev 0)
+++ pkg/svTools/R/completeNamespace.R 2010-09-26 20:59:47 UTC (rev 318)
@@ -0,0 +1,22 @@
+completeNamespace <- function (line)
+{
+ ## export
+ if (regexpr("^[[:space:]]*export[[:space:]]*\\(", line) > 0) {
+ ex <- gsub(".*[(,][[:space:]]*", "", line)
+### TODO: parse the source files for functions
+ }
+
+ ## import
+ if (regexpr("^[[:space:]]*import[[:space:]]*\\(", line) > 0) {
+ im <- gsub(".*[(,][[:space:]]*", "", line)
+ allpacks <- pkgInstalled(pattern = im)[, c("Package", "Title")]
+ return(list(data = allpacks, type = "package"))
+ }
+
+ ## importFrom
+ if (regexpr("^[[:space:]]*importFrom[[:space:]]*\\([^,]*$", line) > 0) {
+ im <- gsub(".*[(][[:space:]]*", "", line)
+ allpacks <- pkgInstalled(pattern = im)[, c("Package", "Title")]
+ return(list(data = allpacks, type = "package"))
+ }
+}
Added: pkg/svTools/R/completeRoxygen.R
===================================================================
--- pkg/svTools/R/completeRoxygen.R (rev 0)
+++ pkg/svTools/R/completeRoxygen.R 2010-09-26 20:59:47 UTC (rev 318)
@@ -0,0 +1,122 @@
+completeRoxygen <- function (line = "#'")
+{
+ roxygenTags <- rbind(
+ c("author", "\\author" , "Author of the function"),
+ c("aliases", "\\alias, ..." , ""),
+ c("concept", "\\concept" , ""),
+ c("examples", "\\examples" , ""),
+ c("keywords", "\\keyword, ..." , ""),
+ c("method", "\\method" , ""),
+ c("name", "\\name" , ""),
+ c("note", "\\note" , ""),
+ c("param", "\\arguments{\\item, ...}" , ""),
+ c("references", "\\references" , ""),
+ c("return", "\\value" , ""),
+ c("seealso", "\\seealso" , ""),
+ c("title", "\\title" , ""),
+ c("TODO", "" , ""),
+ c("usage", "\\usage" , ""),
+ c("callGraph", "" , "Create a call graph of the default depth, excluding primitive functions"),
+ c("callGraphPrimitives", "" , "Create a call graph of the default depth, including primitive functions"),
+ c("callGraphDepth", "" , "Change the depth of the callgraph from the default of 2"),
+ c("include", "" , "See ?make.collate.roclet"),
+ c("export", "export" , ""),
+ c("exportClass", "exportClass" , ""),
+ c("exportMethod", "exportMethod" , ""),
+ c("exportPattern", "exportPattern" , ""),
+ c("S3method", "S3method" , ""),
+ c("import", "import" , ""),
+ c("importFrom", "importFrom" , ""),
+ c("importClassesFrom", "importClassesFrom" , ""),
+ c("importMethodsFrom", "importMethodsFrom" , ""))
+
+ if (line == "#'") {
+ template <- " @%s "
+ completions <- roxygenTags
+ token <- ""
+ } else if (line == "#' ") {
+ template <- "@%s "
+ completions <- roxygenTags
+ token <- ""
+ } else {
+ template <- "%s "
+ tag <- gsub("^#' *@", "", line)
+ matchingKeywords <- unique(c(grep(tag, roxygenTags[, 1], ignore.case = TRUE),
+ grep(tag, roxygenTags[, 3], ignore.case = TRUE)))
+ completions <- if (!length(matchingKeywords)) roxygenTags else
+ roxygenTags[matchingKeywords, , drop = FALSE]
+ token <- tag
+ }
+ return(list(token = token, completions = sprintf(template, completions[, 1]),
+ tooltip = completions[, 3]))
+}
+
+completeRoxygenParam <- function (file, row, line = "#' @param ")
+{
+ potential <- paste(.argsFunAfter(file, row, all.args = FALSE),
+ " ", sep = "")
+ line <- gsub("^#' *@param", "", line)
+ if (regexpr("^ +$", line) > 0)
+ return(list(token = "", completions = potential))
+
+ start <- gsub("^[[:space:]]+", "", line)
+ if (regexpr("[[:space:]]+", start) > 0)
+ return(list(token = "", completions = character(0)))
+
+ completions <- grep(start, potential, value = TRUE)
+ if (length(completions)) {
+ return(list(token = start, completions = completions))
+ } else {
+ return(list(token = "", completions = character(0)))
+ }
+}
+
+generateRoxygenTemplate <- function (file, row, column,
+author = getOption("svTools.roxygen.author"),
+type = c("verbatim", "supperabbrev"))
+{
+ p.out <- parse(file)
+ where <- if (any(inside <- .isInside(p.out, row, column))) {
+ which(inside)
+ } else if (any(before <- .isBefore(p.out, row, column))) {
+ which(before)[1]
+ } else length(p.out)
+
+ isfun <- .isFunction(p.out[[where]])
+ if(!isfun) return(list(ok = 0))
+ funname <- attr(isfun, "fun")
+
+ startPos <- as.numeric(attr(p.out, "srcref")[[where]][1:2])
+ arguments <- .argsFunAfter(file = file, all.args = TRUE,
+ p.out = p.out, row = startPos[1], target = where)
+
+ template <- "#' ${1:Title (short) }\n#' \n#' ${2:Description (2-3 lines)}\n#' @export"
+ if (length(arguments)) {
+ template <- paste(template, paste("#' @param ", arguments, " ${",
+ 2 + 1:length(arguments), ": define `", arguments, "` }", sep = "",
+ collapse = "\n"), sep = "\n")
+ }
+ index <- length(arguments) + 3
+ template <- paste(template, paste("#' @return ${", index,
+ ": What does the function return}", sep = ""), sep = "\n")
+ index <- index + 1
+ if (!is.null(author)) {
+ author <- gsub("([^@])@([^@])", "\\1@@\\2", author)
+ template <- paste(template, paste("#' @author ${", index, ":", author,
+ "}", sep = ""), sep = "\n")
+ }
+ index <- index + 1
+ template <- paste(template, paste("#' @callGraph\n#' @examples\n#' ${",
+ index, ":# executable code for `", funname, "`}\n", sep = ""), sep = "\n")
+
+ type <- match.arg(type)
+
+ ## Remove the super abbrev. stuff
+ if (type == "verbatim") {
+ template <- gsub("(?s)\\$\\{[[:digit:]]+: *([^}]+)\\}", "\\1", template,
+ perl = TRUE)
+ template <- paste(template, "\n", sep = "")
+ }
+
+ return(list(template = template, row = attr(p.out, "srcref")[[where]][1], ok = 1))
+}
Deleted: pkg/svTools/R/complete_description.R
===================================================================
--- pkg/svTools/R/complete_description.R 2010-09-25 09:44:18 UTC (rev 317)
+++ pkg/svTools/R/complete_description.R 2010-09-26 20:59:47 UTC (rev 318)
@@ -1,94 +0,0 @@
-
-completeDescription <- function( file, row, col, text = readLines(file),
- author = getOption( "svTools.description.author" ) ){
-
- if( missing(text) ){
- n <- if( missing(row) ) -1 else row
- rl <- readLines( file, n = n )
- row <- length(rl)
- if(missing(col)) col <- nchar(rl[row])
- } else{
- rl <- text %/~% "\\\n"
- row <- length(rl )
- col <- nchar( rl[row] )
- }
- lastLine <- rl[ row ] <- substring( rl[row], 1, col )
-
- if( lastLine %~% "^( +|[^:]+:)" ){
- # extract the last field
- lastField <- tail( which( rl %~% "^[^:]+:" ), 1 )
- field <- rl[ lastField ] %-~% "(:.*$|[[:space:]]+)"
-
- ### complete package names
- if( field %in% c("Depends","Suggests", "Enhances", "Imports") ){
- start <- lastLine %-~% ".*[,[:space:]]"
- packages <- installedPackages( pattern = start )[, c("Package", "Title"), drop = FALSE ]
- return( list( data = packages, token = start, ok = 1, type = "package" ) )
- }
-
- ### use the "svTools.description.author" option to complete
- if( field %in% c("Author", "Maintainer" ) ){
- if( !is.null( author) ){
- return( list( ok = 1, data = cbind( author, "" ), token = lastLine %-~% ".*: *", type = "other" ) )
- } else return( list( ok = 0 ) )
- }
-
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/sciviews -r 318
More information about the Sciviews-commits
mailing list