First cut outputting directly to R objects

- If the `raw` option is true then output is directed to the object
  specified by the `object` argument to tikz().
- The object is created temporarily in the .tikzInternal environment
  then is copied to the calling environment when dev.off() is called.
- When the object is copied it is created in the calling environment as
  an object of class 'tikz'
- There is a print.tikz() function that will by default direct output to
  the original `file` specified in tikz()
- Much more error checking is needed
- The method for storing output in the .tikzInternal environment should
  be refined, possibly to save multiple sets of output and recall them
  later
- Things feel a bit kludgy right now, lots of room for spiffing up

R/deviceUtils.R

@@ -167,3 +167,41 @@ getDeviceInfo <- function(dev_num = dev.cur()) {
 
 }
 
+
+writeRaw <- function(obj, lines, envir = .tikzInternal){
+  # write lines to the R object (character vector) named `obj'
+  # do the evaluation in the specified environment, if the 
+  # object does not exist, create it.
+
+  current_lines <- try( get(obj, envir=envir, inherits = FALSE), silent=TRUE )
+  lines <- 
+  if( class(current_lines) == 'try-error' ) 
+    lines 
+  else 
+    c(current_lines, lines)
+
+  assign(obj, lines, envir=envir)
+  return( all.equal( get(obj, envir=envir, inherits = FALSE ), lines ) )
+
+}
+
+
+finishRaw <- function( obj, filename ){
+
+    # Assign the raw object to the calling environment 
+    #
+    # Get the environment that tikz() was called from 
+    # one environment up will always be the tikzDevice namespace so 
+    # we need to go two environments up
+    # there is probably a better way to do this...
+  env <- parent.frame(2)
+
+    # create the plot object
+  raw_object <- list()
+  raw_object$lines <- get(obj, envir = .tikzInternal, inherits = FALSE)
+  class(raw_object) <- 'tikz'
+  raw_object$filename <- filename
+
+  assign(obj, raw_object, envir=env)
+
+}

R/print_tikz.R

@@ -0,0 +1,37 @@
+#' Print tikzDevice output to a file or the screen
+#' This function will print the TikZ code contained in an object of class 
+#' 'tikz' either to a file or to the screen. 
+#'
+#' This function should be used with the \code{raw} option to \code{tikz()}. The 
+#' default is to simply print the TikZ code to the file originally specified 
+#' in the call to \code{tikz()}, reproducing the default behavior.
+#'
+#' @param x An object of class 'tikz'
+#' @param filename The file to output TikZ code to
+#' @param raw If \code{TRUE}, print the raw TikZ code to the screen.
+#'
+#'
+#' @return Nothing is returned
+#'
+#' @author Cameron Bracken \email{cameron.bracken@@gmail.com}
+#'
+#' @seealso \code{\link{tikz}}
+#' @keywords character
+#'
+#' @examples
+#'  tikz(raw=TRUE,object='p')
+#'  plot(1)
+#'  dev.off()
+#'  print(p)
+#'
+#' @export
+print.tikz <- function(x, filename = x$filename, raw = FALSE){
+
+  if(raw){
+    cat(x)
+  }else{
+    cat('Writing TikZ output to:', filename, '\n')
+    cat(x$lines,file = filename)
+  }
+
+}

R/tikz.R

@@ -179,7 +179,8 @@
 tikz <-
 function (file = "./Rplots.tex", width = 7, height = 7,
   bg="transparent", fg="black", pointsize = 10, standAlone = FALSE,
-  bareBones = FALSE, console = FALSE, sanitize = FALSE,
+  bareBones = FALSE, console = FALSE,sanitize = FALSE,
+  raw = FALSE, object = NULL,
   engine = getOption("tikzDefaultEngine"),
   documentDeclaration = getOption("tikzDocumentDeclaration"),
   packages,
@@ -244,7 +245,7 @@ function (file = "./Rplots.tex", width = 7, height = 7,
 
   .External('TikZ_StartDevice', file, width, height, bg, fg, baseSize,
     standAlone, bareBones, documentDeclaration, packages, footer, console,
-    sanitize, engine,
+    sanitize, engine, raw, object,
     PACKAGE='tikzDevice')
 
   invisible()

src/tikzDevice.c

@@ -79,10 +79,9 @@ SEXP TikZ_StartDevice ( SEXP args ){
   const char *bg, *fg;
   double width, height;
   Rboolean standAlone, bareBones;
-  const char *documentDeclaration, *packages, *footer;
+  const char *documentDeclaration, *packages, *footer, *object;
   double baseSize;
-  Rboolean console, sanitize;
-
+  Rboolean console, sanitize, raw;
   /* 
    * pGEDevDesc is a variable provided by the R Graphics Engine
    * that represents a graphics device to the rest of the R system.
@@ -147,11 +146,15 @@ SEXP TikZ_StartDevice ( SEXP args ){
    * escaping of TeX special characters such as %,_,\, etc?
   */ 
   sanitize = asLogical(CAR(args)); args = CDR(args);
-
+  
   /*
    * See the definition of tikz_engine in tikzDevice.h
    */
-  int engine = asInteger(CAR(args));
+  int engine = asInteger(CAR(args)); args = CDR(args);
+
+  raw = asLogical(CAR(args)); args = CDR(args);
+  object = CHAR(asChar(CAR(args))); 
+
 
   /* Ensure there is an empty slot avaliable for a new device. */
   R_CheckDeviceAvailable();
@@ -182,7 +185,7 @@ SEXP TikZ_StartDevice ( SEXP args ){
     */
     if( !TikZ_Setup( deviceInfo, fileName, width, height, bg, fg, baseSize,
         standAlone, bareBones, documentDeclaration, packages,
-        footer, console, sanitize, engine ) ){
+        footer, console, sanitize, engine, raw, object ) ){
       /* 
        * If setup was unsuccessful, destroy the device and return
        * an error message.
@@ -226,7 +229,8 @@ static Rboolean TikZ_Setup(
   Rboolean standAlone, Rboolean bareBones,
   const char *documentDeclaration,
   const char *packages, const char *footer, 
-  Rboolean console, Rboolean sanitize, int engine ){
+  Rboolean console, Rboolean sanitize, int engine, 
+  Rboolean raw,  const char *object){
 
   /* 
    * Create tikzInfo, this variable contains information which is
@@ -285,6 +289,9 @@ static Rboolean TikZ_Setup(
   tikzInfo->polyLine = FALSE;
   tikzInfo->console = console;
   tikzInfo->sanitize = sanitize;
+  tikzInfo->raw = raw;
+  tikzInfo->rawObj = object;
+
 
   /* Incorporate tikzInfo into deviceInfo. */
   deviceInfo->deviceSpecific = (void *) tikzInfo;
@@ -554,8 +561,43 @@ static void TikZ_Close( pDevDesc deviceInfo){
       tikzInfo->stringWidthCalls);
 
   /* Close the file and destroy the tikzInfo structure. */
-  if(tikzInfo->console == FALSE)
+  if(tikzInfo->console == FALSE && tikzInfo->raw == FALSE)
     fclose(tikzInfo->outputFile);
+
+  if(tikzInfo->raw == TRUE){
+    /*
+    * write the current lines to the object named 'obj' in the .tikzInternal
+    * environment, then expose the object when the device is closed
+    */
+    SEXP namespace;
+    PROTECT( namespace = TIKZ_NAMESPACE );
+
+    SEXP finish_raw = findFun(
+        install("finishRaw"), namespace);
+
+    SEXP RCallBack;
+    PROTECT( RCallBack = allocVector(LANGSXP,3) );
+
+    // Place the function into the first slot of the SEXP.
+    SETCAR( RCallBack, finish_raw );
+
+    // Place the string into the second slot of the SEXP.
+    SETCADR( RCallBack, mkString( tikzInfo->rawObj ) );
+    SET_TAG( CDR( RCallBack ), install("obj") );
+
+    // Place the string into the second slot of the SEXP.
+    SETCADDR( RCallBack, mkString( tikzInfo->outFileName ) );
+    SET_TAG( CDDR( RCallBack ), install("filename") );
+
+    /*
+     * Call the R function, capture the result.
+    */
+    SEXP result;
+    PROTECT( result = eval(RCallBack, namespace) );
+
+    UNPROTECT(3);
+
+  }
 
   /* Deallocate pointers */
   free(tikzInfo->outFileName);
@@ -1888,10 +1930,24 @@ static void printOutput(tikzDevDesc *tikzInfo, const char *format, ...){
   va_list(ap);
   va_start(ap, format);
 
-  if(tikzInfo->console == TRUE)
+  if(tikzInfo->console == TRUE){
+
     Rvprintf(format, ap);
-  else
+
+  }else if(tikzInfo->raw == TRUE){
+
+    char output_lines[1000];
+    char *poutput_lines = (char *) output_lines;
+    //Rprintf("Writing Raw to object %s\n", tikzInfo->rawObj);
+    vsprintf(poutput_lines, format, ap);
+    //Rprintf("Writing Raw %s", tikzInfo->output_lines);
+    write_raw(tikzInfo->rawObj, poutput_lines);
+
+  }else{
+
     vfprintf(tikzInfo->outputFile, format, ap);
+
+  }
 
   va_end(ap);
 
@@ -2027,7 +2083,6 @@ static Rboolean contains_multibyte_chars(const char *str){
   return(asLogical(result));
 }
 
-
 /*
  * This function is responsible for converting lengths given in page
  * dimensions (ie. inches, cm, etc.) to device dimensions (currenty
@@ -2039,3 +2094,41 @@ static double dim2dev( double length ){
   return length*72.27;
 }
 
+
+static Rboolean write_raw(const char *obj, const char *str){
+  /*
+  * write the current lines to the object named 'obj' in the .tikzInternal
+  * environment, then expose the object when the device is closed
+  */
+  SEXP namespace;
+  PROTECT( namespace = TIKZ_NAMESPACE );
+
+  SEXP write_raw = findFun(
+      install("writeRaw"), namespace);
+
+  SEXP RCallBack;
+  PROTECT( RCallBack = allocVector(LANGSXP,3) );
+
+  // Place the function into the first slot of the SEXP.
+  SETCAR( RCallBack, write_raw );
+
+  // Place the string into the second slot of the SEXP.
+  SETCADR( RCallBack, mkString( obj ) );
+  SET_TAG( CDR( RCallBack ), install("obj") );
+
+  // Place the string into the second slot of the SEXP.
+  SETCADDR( RCallBack, mkString( str ) );
+  SET_TAG( CDDR( RCallBack ), install("lines") );
+
+  /*
+   * Call the R function, capture the result.
+  */
+  SEXP result;
+  PROTECT( result = eval(RCallBack, namespace) );
+
+  UNPROTECT(3);
+
+  return(asLogical(result));
+}
+
+

src/tikzDevice.h

@@ -67,6 +67,8 @@ typedef struct {
 	Rboolean polyLine;
 	Rboolean console;
 	Rboolean sanitize;
+  Rboolean raw;
+  const char *rawObj;
 } tikzDevDesc;
 
 
@@ -86,7 +88,8 @@ static Rboolean TikZ_Setup(
 		Rboolean standAlone, Rboolean bareBones,
 		const char *documentDeclaration,
 		const char *packages, const char *footer,
-		Rboolean console, Rboolean sanitize, int engine );
+		Rboolean console, Rboolean sanitize, int engine,
+		Rboolean raw,  const char *object );
 
 
 /* Graphics Engine function hooks. Defined in GraphicsDevice.h . */
@@ -173,6 +176,7 @@ static void printOutput(tikzDevDesc *tikzInfo, const char *format, ...);
 static void Print_TikZ_Header( tikzDevDesc *tikzInfo );
 static char *Sanitize(const char *str);
 static Rboolean contains_multibyte_chars(const char *str);
+static Rboolean write_raw(const char *obj, const char *str);
 static double dim2dev( double length );
 
 #endif // End of Once Only header