1pstamp <- if(.R.) function(txt, pwd=FALSE, time.=TRUE)
2{
3  stamp <- function(string = Sys.time(), print = TRUE, plot = TRUE)
4  {
5    opar <- par(yaxt='s',xaxt='s',xpd=NA)
6    on.exit(par(opar))
7    plt <- par('plt')
8    usr <- par('usr')
9
10    ## when a logrithmic scale is in use (i.e. par('xlog') is true),
11    ## then the x-limits would be 10^par('usr')[1:2].  Similarly for
12    ## the y axis
13    xcoord <- usr[2] + (usr[2] - usr[1])/(plt[2] - plt[1]) *
14      (1-plt[2]) - .6*strwidth('m')
15    ycoord <- usr[3] - diff(usr[3:4])/diff(plt[3:4])*(plt[3]) +
16      0.6*strheight('m')
17
18    if(par('xlog'))
19      xcoord <- 10^(xcoord)
20    if(par('ylog'))
21      ycoord <- 10^(ycoord)
22
23    ## Print the text on the current plot
24    text(xcoord, ycoord, string, adj=1)
25    invisible(string)
26  }
27
28  date.txt <- if(time.) format(Sys.time())
29              else format(Sys.time(), '%Y-%m-%d')
30
31  if(pwd)
32    date.txt <- paste(getwd(), date.txt)
33
34  oldpar <- par(mfrow=c(1,1), cex = 0.5)
35  on.exit(par(oldpar))
36  if(!missing(txt))
37    date.txt <- paste(txt,'   ',date.txt, sep='')
38
39  stamp(string=date.txt,print=FALSE,plot=TRUE)
40  invisible()
41
42} else function(txt, pwd=FALSE, time.=under.unix)
43{
44
45  date.txt <- if(time.) date() else {
46    if(.SV4.)
47      format(timeDate(date(), in.format='%w %m %d %H:%M:%S %Z %Y',
48                      format='%Y-%m-%d'))
49    else if(under.unix)
50      unix('date +%Y-%m-%d')
51    else
52      stop('time.=T not supported')
53  }
54
55  if(pwd)
56    date.txt <- paste(getwd(), date.txt)
57
58  oldpar <- par(mfrow = c(1,1), cex = 0.5)
59  on.exit(par(oldpar))
60  if(!missing(txt))
61    date.txt <- paste(txt,'   ',date.txt, sep='')
62
63  stamp(string=date.txt,print=FALSE,plot=TRUE)
64  par(old)
65  invisible()
66}
67