1##This has code from Bill Dunlap's "set.work" function 2if(.R.) { 3 store <- function(object, name=as.character(substitute(object)), 4 where=if(under.unix || .SV4.)".Data" 5 else "_Data") 6 stop('function not available for R') 7 8 stores <- function(...) stop('function not available for R') 9} else { 10 store <- function(object, name=as.character(substitute(object)), 11 where=if(under.unix || .SV4.)".Data" else "_Data") 12 { 13 if(missing(object)) { 14 ##if(.R.) attach(NULL, name='.GlobalTemp', pos=1) 15 temp <- if(under.unix) paste(".Data.temp", 16 unix("echo $$"), sep="") 17 else tempfile() 18 19 sys(paste("mkdir",temp), minimized=FALSE) 20 if(.SV4.) sys(paste('mkdir ',temp, 21 if(under.unix)'/' 22 else '\\', 23 '__Meta',sep='')) ## 20jun02 24 25 attach(temp, 1) 26 options(.store.temp=temp, TEMPORARY=FALSE) 27 l <- function() 28 { 29 detach(1, FALSE); 30 sys(paste(if(under.unix)"rm -r" else "deltree /Y",.Options$.store.temp), 31 minimized=TRUE) 32 } 33 34 assign(".Last", l, where=1) 35 return(invisible()) 36 } 37 38 assign(name,object,where=where,immediate=TRUE) 39 invisible() 40 } 41 42 stores <- function(...) 43 { 44 nams <- as.character(sys.call())[-1] 45 dotlist <- list(...) 46 for(i in 1:length(nams)) 47 assign(nams[i], dotlist[[i]], 48 where=if(under.unix || .SV4.)".Data" 49 else "_Data", 50 immediate=TRUE) 51 52 invisible() 53 } 54 55 NULL 56} 57 58 59storeTemp <- if(.R.) function(object, 60 name=deparse(substitute(object))) 61{ 62 pos <- match('.GlobalTemp', search()) 63 if(is.na(pos)) { 64 attach(NULL,name='.GlobalTemp') 65 pos <- match('.GlobalTemp', search()) 66 } 67 assign(name, object, pos) 68 invisible() 69} else function(object, name=deparse(substitute(object))) 70{ 71 assign(name, object, frame=0) 72 invisible() 73} 74