[rkward-cvs] SF.net SVN: rkward-code:[4685] branches/development_branches/ rkward_graphpics_device/rkward/rbackend/rpackages/rkward/R

[tfry at users.sf.net]

Revision: 4685
          http://sourceforge.net/p/rkward/code/4685
Author:   tfry
Date:     2013-04-11 11:37:08 +0000 (Thu, 11 Apr 2013)
Log Message:
-----------
Enable plot history for RK() device. simplify onAddDevice()-signature

Modified Paths:
--------------
    branches/development_branches/rkward_graphpics_device/rkward/rbackend/rpackages/rkward/R/internal_graphics.R
    branches/development_branches/rkward_graphpics_device/rkward/rbackend/rpackages/rkward/R/public_graphics.R

Modified: branches/development_branches/rkward_graphpics_device/rkward/rbackend/rpackages/rkward/R/internal_graphics.R
===================================================================
--- branches/development_branches/rkward_graphpics_device/rkward/rbackend/rpackages/rkward/R/internal_graphics.R	2013-04-11 10:38:08 UTC (rev 4684)
+++ branches/development_branches/rkward_graphpics_device/rkward/rbackend/rpackages/rkward/R/internal_graphics.R	2013-04-11 11:37:08 UTC (rev 4685)
@@ -3,11 +3,9 @@
 
 # overriding x11 to get informed, when a new x11 window is opened
 #' @export
-"rk.screen.device" <- function (..., is.being.duplicated = FALSE, is.preview.device = FALSE) {
+"rk.screen.device" <- function (...) {
 	.rk.do.call ("startOpenX11", as.character (dev.cur ()));
 
-	old_dev <- dev.cur ()
-
 	args <- list (...)
 	if (!exists (".rk.default.device")) {
 		if (base::.Platform$OS.type == "unix") {
@@ -29,8 +27,7 @@
 
 	.rk.do.call ("endOpenX11", as.character (dev.cur ()));
 
-	if (getOption ("rk.enable.graphics.history"))
-		rk.record.plot$onAddDevice (old_dev, dev.cur (), is.being.duplicated, is.preview.device)
+	rk.record.plot$onAddDevice ()
 
 	invisible (x)
 }
@@ -56,7 +53,7 @@
 	a <- .rk.variables$.rk.preview.devices[[x]]
 	if (is.null (a)) {
 		devnum <- dev.cur ()
-		x11 (is.preview.device = TRUE)
+		rk.without.plot.history (rk.screen.device ())
 		if (devnum != dev.cur ()) {
 			.rk.variables$.rk.preview.devices[[x]] <- list (devnum=dev.cur(), par=par (no.readonly=TRUE))
 		} else {
@@ -147,12 +144,9 @@
 				plot_hist_enabled <- getOption ("rk.enable.graphics.history")
 				if (plot_hist_enabled) {
 					rk.record.plot$record (nextplot.pkg = "lattice")
-					on.exit (options (rk.enable.graphics.history=TRUE))
-					options (rk.enable.graphics.history=FALSE)	# avoid duplicate trigger inside plot(), below
 				}
-				plot (x, ...)
+				rk.without.plot.history (plot (x, ...))
 				if (plot_hist_enabled) {
-					options (rk.enable.graphics.history=TRUE)
 					rk.record.plot$.save.tlo.in.hP ()
 				}
 				invisible ()

Modified: branches/development_branches/rkward_graphpics_device/rkward/rbackend/rpackages/rkward/R/public_graphics.R
===================================================================
--- branches/development_branches/rkward_graphpics_device/rkward/rbackend/rpackages/rkward/R/public_graphics.R	2013-04-11 10:38:08 UTC (rev 4684)
+++ branches/development_branches/rkward_graphpics_device/rkward/rbackend/rpackages/rkward/R/public_graphics.R	2013-04-11 11:37:08 UTC (rev 4685)
@@ -109,7 +109,8 @@
 	if (is.null (width)) width <- 7
 	if (is.null (height)) height <- 7
 	ret <- .Call ("rk.graphics.device", as.integer (width), as.integer (height), as.integer (pointsize), family, bg, title, isTRUE (antialias), PACKAGE="(embedding)")
-	inivisble (ret)	# Current always NULL
+	rk.record.plot$onAddDevice (dev.cur ())
+	invisible (ret)	# Current always NULL
 }
 
 #' \code{rk.graph.off()} closes the device that was opened by \code{rk.graph.on}. 
@@ -162,8 +163,10 @@
 #' @export
 "rk.duplicate.device" <- function (devId = dev.cur ())
 {
+	rk.record.plot$duplicating.from.device <- devId
+	on.exit (rk.record.plot$duplicating.from.device <- 1)	# NULL device
 	dev.set (devId)
-	dev.copy (device = x11, is.being.duplicated = TRUE)
+	dev.copy (device = rk.screen.device)
 }
 
 # A global history of various graphics calls;
@@ -235,16 +238,15 @@
 	}
 	
 	## Device specific functions:
-	onAddDevice <- function (devId.from = 1, devId = dev.cur (), 
-		is.being.duplicated = FALSE, is.preview.device = FALSE)
+	onAddDevice <- function (devId = dev.cur ())
 	{
-		if (is.preview.device) return (invisible ())
+		if (!isTRUE (getOption ("rk.enable.graphics.history"))) return (invisible ())
 		
-		devId.from <- as.character (devId.from)
+		devId.from <- as.character (env$duplicating.from.device)
 		devId <- as.character (devId)
 		
 		histPositions [[devId]] <<- .hP.template
-		if (is.being.duplicated && !histPositions [[devId.from]]$is.this.dev.new) {
+		if ((env$duplicating.from.device > 1) && !histPositions [[devId.from]]$is.this.dev.new) {
 			# devId.from > 1
 			## TODO: see if so many "[[" calls can be reduced?
 			histPositions [[devId]]$is.this.plot.new <<- TRUE
@@ -623,9 +625,9 @@
 			# access it
 			if (cur.devId != as.numeric (devId))
 				tlo.ls <- get ("lattice.status", envir = lattice:::.LatticeEnv)
-			options (rk.enable.graphics.history=FALSE); on.exit (options (rk.enable.graphics.history=TRUE))
-			plot (savedPlots [[st]]$plot, save.object = (cur.devId == as.numeric (devId)))
-			options (rk.enable.graphics.history=TRUE)
+			rk.without.plot.history ({
+				plot (savedPlots [[st]]$plot, save.object = (cur.devId == as.numeric (devId)))
+			})
 			if (cur.devId != as.numeric (devId))
 				assign ("lattice.status", tlo.ls, envir = lattice:::.LatticeEnv)
 		}
@@ -870,6 +872,7 @@
 		# Existing plots are not checked for their sizes, only the new ones are.
 	}
 
+	env$duplicating.from.device <- 1 # NULL device
 	env
 }
 rk.record.plot <- rk.record.plot ()
@@ -958,3 +961,15 @@
 			NULL)
 	ret
 }
+#' Run a (plotting) action, without recording anything in the plot history.
+#' Internally, the plot history option is turned off for the duration of the action.
+#' 
+#' @export
+"rk.without.plot.history" <- function (expr)
+{
+	if (getOption ("rk.enable.graphics.history")) {
+		on.exit (options ("rk.enable.graphics.history" = TRUE))
+	}
+	options ("rk.enable.graphics.history" = FALSE)
+	eval.parent(expr)
+}