1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
|
setGeneric( "package.skeleton" )
setMethod( "package.skeleton", signature( name = "character", list = "CFuncList" ),
function (name = "anRpackage", list = new( "CFuncList" ), environment = .GlobalEnv,
path = ".", force = FALSE, namespace = FALSE, code_files = character()) {
env <- environment( list[[1]]@.Data )
clean.env <- new.env( parent = environment )
functions <- names( list )
for( i in seq_along(list) ){
f <- functions[i]
call <- body( list[[i]]@.Data )[[4]]
call[["PACKAGE"]] <- name
fun <- list[[i]]@.Data
body( fun ) <- call
environment(fun) <- clean.env
assign( f, fun, clean.env )
}
message( ">> standard package.skeleton from utils" )
package.skeleton( name, functions , clean.env, path, force, namespace = TRUE, code_files )
if( !file.exists( R <- file.path(name, "R") ) ){
dir.create( R )
con <- file( file.path( R, sprintf("%s.R", name) ), open = "w" )
for( i in seq_along(list) ){
fun <- functions[i]
writeLines( sprintf( ' %s <- %s\n' , fun, paste( deparse(clean.env[[ fun ]] ), collapse = "\n" ) ), con )
}
close( con )
message( ">> added R directory with function calling compiled code" )
}
Rdfiles <- file.path( name, "man", sprintf( "%s.Rd", functions ) )
sapply( Rdfiles, function( Rdfile) {
if( file.exists( Rdfile ) ){
content <- readLines( Rdfile )
content <- sub( "%% ~~function to do ... ~~", "insert here the title", content )
writeLines( content, Rdfile )
}
message( ">> workaround for empty title in Rd file" )
} )
package.doc <- file.path( name, "man", sprintf("%s-package.Rd", name) )
if( file.exists( package.doc) ){
lines <- readLines( package.doc )
lines <- sub( "~~ simple examples of", "%% ~~ simple examples of", lines )
writeLines( lines, package.doc )
}
dir.create( file.path( name, "src" ) )
message( ">> created src directory" )
NAMESPACE <- sprintf( '
useDynLib(%s)
%s
', name, paste( sprintf( 'export("%s")', functions ), collapse = "\n" ) )
writeLines( NAMESPACE, file.path( name, "NAMESPACE" ) )
language <- env$language
extension <- switch(language, "C++"=".cpp", C=".c", Fortran=".f", F95=".f95",
ObjectiveC=".m", "ObjectiveC++"=".mm")
cfile <- file.path( name, "src", sprintf( "%s%s", name, extension ) )
writeLines( list[[1]]@code, cfile )
message( ">> added compiled code in src directory" )
settings <- env$settings
if( !is.null( settings ) ){
DESCRIPTION_file <- file.path( name, "DESCRIPTION" )
DESCRIPTION <- read.dcf( DESCRIPTION_file )
depends <- settings$Depends
if( !is.null( depends ) ){
DESCRIPTION <- cbind( DESCRIPTION, "Depends" = depends )
}
linkingTo <- settings$LinkingTo
if( !is.null( linkingTo ) ){
DESCRIPTION <- cbind( DESCRIPTION, "LinkingTo" = linkingTo )
}
write.dcf( DESCRIPTION, DESCRIPTION_file )
message( ">> updated DESCRIPTION file" )
Makevars <- settings$Makevars
if( !is.null( Makevars ) ){
Makevars_file <- file.path( name, "src", "Makevars" )
writeLines( Makevars, Makevars_file )
message( ">> added Makevars ")
}
Makevars.win <- settings$Makevars.win
if( !is.null( Makevars.win ) ){
Makevars.win_file <- file.path( name, "src", "Makevars.win" )
writeLines( Makevars.win, Makevars.win_file )
message( ">> added Makevars.win" )
}
}
invisible(NULL)
} )
setMethod( "package.skeleton", signature( name = "character", list = "CFunc" ),
function (name = "anRpackage", list = new( "CFunc" ), environment = .GlobalEnv,
path = ".", force = FALSE, namespace = FALSE, code_files = character()) {
package.skeleton( name = name, list = new( "CfuncList", list),
environment = environment, path = path , force = force, namespace = namespace , code_files = code_files )
} )
|
