I think this is a good idea; I'll put it into r-devel and possibly r-alpha.

Duncan Murdoch

On 18/03/2011 1:54 PM, Dirk Eddelbuettel wrote:
The other day I was working on an example which used tempfile() to create
file for use by the graphics device. And while I love tempfile()---as it is
portable and clever and the files get cleaned by R and all that---I noticed
one missing feature I would like to see: beside a starting name pattern, and
an optional directory, an 'file extension' argument would be nice to have.
As e.g. in

       tmppdf<- tempfile(fileext=".pdf")
       tmppng<- tempfile(fileext=".png")
       tmpjpeg<- tempfile(fileext=".jpeg")

Below is a short and simple patch which extends tempfile() to three arguments
with the new one (fileext) defaulting to "".  If set, the extension is
appended to what we got from R_tmpnam().  I made this non-vectorised; this
could be changed. I left R_tmpnam() alone as its interface appears in a
header. I updated the manual page too.

I wrote this again current R-devel source from SVN, the patch reflects
that. The patch applies cleanly to R-alpha as well where 'make check' passes
(and I only tried this as make check had issues with R-devel but devel being
devel I am not sure that it was this patch).

Now, I understand that tempfile() is used in a large number of places so I
more or less expect to get stone silence or a resounding "don't even think
about it".  This end can always be achieved with a local function; but maybe
somebody else see merit in having this at the source.

Thanks for listening, and for considering this.

Regards, Dirk

Index: src/library/base/R/temp.R
===================================================================
--- src/library/base/R/temp.R   (revision 54862)
+++ src/library/base/R/temp.R   (working copy)
@@ -14,7 +14,7 @@
  #  A copy of the GNU General Public License is available at
  #  http://www.r-project.org/Licenses/

-tempfile<- function(pattern = "file", tmpdir = tempdir())
-    .Internal(tempfile(pattern, tmpdir))
+tempfile<- function(pattern = "file", tmpdir = tempdir(), fileext = "")
+    .Internal(tempfile(pattern, tmpdir, fileext))

  tempdir<- function() .Internal(tempdir())
Index: src/library/base/man/tempfile.Rd
===================================================================
--- src/library/base/man/tempfile.Rd    (revision 54862)
+++ src/library/base/man/tempfile.Rd    (working copy)
@@ -12,13 +12,14 @@
    names for temporary files.
  }
  \usage{
-tempfile(pattern = "file", tmpdir = tempdir())
+tempfile(pattern = "file", tmpdir = tempdir(), fileext = "")
  tempdir()
  }
  \arguments{
    \item{pattern}{a non-empty character vector giving the initial part
      of the name.}
    \item{tmpdir}{a non-empty character vector giving the directory name}
+  \item{fileext}{an optional character object giving a file extension}
  }
  \value{
    For \code{tempfile} a character vector giving the names of possible
@@ -55,6 +56,11 @@
    contains a space in any of the components, the path returned will use
    the shortnames version of the path.
  #endif
+
+  The optional argument \code{fileext} can be use to supply a file
+  extension. This can be useful if the temporary file is for example use
+  with a graphics device as the file type can be signalled via the
+  extension; an example would be \code{fileext=".png"}.
  }
  \references{
    Becker, R. A., Chambers, J. M. and Wilks, A. R. (1988)
Index: src/main/names.c
===================================================================
--- src/main/names.c    (revision 54862)
+++ src/main/names.c    (working copy)
@@ -786,7 +786,7 @@
  {"file.info",       do_fileinfo,    0,      11,     1,      {PP_FUNCALL, 
PREC_FN,   0}},
  {"file.access",     do_fileaccess,  0,      11,     2,      {PP_FUNCALL, 
PREC_FN,   0}},
  {"dir.create",      do_dircreate,   0,      11,     4,      {PP_FUNCALL, 
PREC_FN,   0}},
-{"tempfile", do_tempfile,    0,      11,     2,      {PP_FUNCALL, PREC_FN,   
0}},
+{"tempfile", do_tempfile,    0,      11,     3,      {PP_FUNCALL, PREC_FN,   
0}},
  {"tempdir", do_tempdir,     0,      11,     0,      {PP_FUNCALL, PREC_FN,   
0}},
  {"R.home",  do_Rhome,       0,      11,     0,      {PP_FUNCALL, PREC_FN,   
0}},
  {"date",    do_date,        0,      11,     0,      {PP_FUNCALL, PREC_FN,   
0}},
Index: src/main/sysutils.c
===================================================================
--- src/main/sysutils.c (revision 54862)
+++ src/main/sysutils.c (working copy)
@@ -233,30 +233,44 @@

  SEXP attribute_hidden do_tempfile(SEXP call, SEXP op, SEXP args, SEXP env)
  {
-    SEXP  ans, pattern, tempdir;
-    const char *tn, *td;
+    SEXP  ans, pattern, fileext, tempdir;
+    const char *tn, *td, *te;
      char *tm;
-    int i, n1, n2, slen;
+    int i, n1, n2, n3, slen;
+    char tmp1[PATH_MAX];

      checkArity(op, args);
-    pattern = CAR(args); n1 = length(pattern);
-    tempdir = CADR(args); n2 = length(tempdir);
+    pattern = CAR(args); n1 = length(pattern); args = CDR(args);
+    tempdir = CAR(args); n2 = length(tempdir); args = CDR(args);
+    fileext = CAR(args); n3 = length(fileext);
      if (!isString(pattern))
        error(_("invalid filename pattern"));
      if (!isString(tempdir))
        error(_("invalid '%s' value"), "tempdir");
+    if (!isString(fileext))
+       error(_("invalid pattern for end-of-filename"));
      if (n1<  1)
        error(_("no 'pattern'"));
      if (n2<  1)
        error(_("no 'tempdir'"));
+    /* fileext is optional and defaults to "" so no test for vector*/
+    if (n3 != 1)
+       error(_("only single argument for end-of-filename pattern supported"));
      slen = (n1>  n2) ? n1 : n2;
      PROTECT(ans = allocVector(STRSXP, slen));
      for(i = 0; i<  slen; i++) {
        tn = translateChar( STRING_ELT( pattern , i%n1 ) );
        td = translateChar( STRING_ELT( tempdir , i%n2 ) );
+       te = translateChar( STRING_ELT( fileext , 0 ) );
        /* try to get a new file name */
        tm = R_tmpnam(tn, td);
-       SET_STRING_ELT(ans, i, mkChar(tm));
+       if (0 != strlen(te)) {
+          /* append optional extension, or null string */
+          snprintf(tmp1, PATH_MAX, "%s%s", tm, te);
+          SET_STRING_ELT(ans, i, mkChar(tmp1));
+       } else {
+          SET_STRING_ELT(ans, i, mkChar(tm));
+       }
        if(tm) free(tm);
      }
      UNPROTECT(1);


______________________________________________
R-devel@r-project.org mailing list
https://stat.ethz.ch/mailman/listinfo/r-devel

Reply via email to