[rkward-cvs] SF.net SVN: rkward:[3010] trunk/rkward/rkward

kapatp at users.sourceforge.net kapatp at users.sourceforge.net
Fri Sep 10 18:27:04 UTC 2010


Revision: 3010
          http://rkward.svn.sourceforge.net/rkward/?rev=3010&view=rev
Author:   kapatp
Date:     2010-09-10 18:27:03 +0000 (Fri, 10 Sep 2010)

Log Message:
-----------
Another shot at plot history - second attemp to commit

Modified Paths:
--------------
    trunk/rkward/rkward/rbackend/rpackages/rkward/R/internal_graphics.R
    trunk/rkward/rkward/rbackend/rpackages/rkward/R/public_graphics.R
    trunk/rkward/rkward/settings/rksettingsmoduleoutput.cpp
    trunk/rkward/rkward/windows/rkcatchedx11windowpart.rc
    trunk/rkward/rkward/windows/rkwindowcatcher.cpp
    trunk/rkward/rkward/windows/rkwindowcatcher.h

Modified: trunk/rkward/rkward/rbackend/rpackages/rkward/R/internal_graphics.R
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/rkward/R/internal_graphics.R	2010-09-09 19:03:26 UTC (rev 3009)
+++ trunk/rkward/rkward/rbackend/rpackages/rkward/R/internal_graphics.R	2010-09-10 18:27:03 UTC (rev 3010)
@@ -2,7 +2,7 @@
 ## These functions are _not_ supposed to be called by the end user.
 
 # overriding x11 to get informed, when a new x11 window is opened
-"rk.screen.device" <- function (..., is.preview.device = FALSE) {
+"rk.screen.device" <- function (..., is.being.duplicated = FALSE, is.preview.device = FALSE) {
 	.rk.do.call ("startOpenX11", as.character (dev.cur ()));
 
 	old_dev <- dev.cur ()
@@ -23,7 +23,7 @@
 
 	.rk.do.call ("endOpenX11", as.character (dev.cur ()));
 
-	rk.record.plot$onAddDevice (old_dev = old_dev, deviceId = dev.cur ())
+	rk.record.plot$onAddDevice (old_dev, dev.cur (), is.being.duplicated, is.preview.device)
 
 	invisible (x)
 }
@@ -43,20 +43,18 @@
 ".rk.preview.devices" <- list ();
 
 ".rk.startPreviewDevice" <- function (x) {
-	rk.record.plot$printPars()
+	rk.record.plot$getDevSummary() ## DEBUG
 	a <- .rk.preview.devices[[x]]
 	if (is.null (a)) {
 		a <- dev.cur ()
-		rk.record.plot$.set.isPreviewDevice (TRUE)
-		x11 ()
-		rk.record.plot$.set.isPreviewDevice (FALSE)
+		x11 (is.preview.device = TRUE)
 		if (a != dev.cur ()) {
 			.rk.preview.devices[[x]] <<- dev.cur ()
 		}
 	} else {
 		dev.set (a)
 	}
-	rk.record.plot$printPars()
+	rk.record.plot$getDevSummary() ## DEBUG
 }
 
 ".rk.killPreviewDevice" <- function (x) {
@@ -72,8 +70,9 @@
 "plot.new" <- function () 
 {
 	if (dev.cur() == 1) rk.screen.device ()
-	rk.record.plot$record.all.recordable ()
-	rk.record.plot$record (newplot.gType = 'standard')
+rk.record.plot$.my.message ("------- call begin -----------")
+	rk.record.plot$record (nextplot.pkg = "graphics")
+rk.record.plot$.my.message ("------- call end   -----------")
 	eval (body (.rk.plot.new.default))
 }
 formals (plot.new) <- formals (graphics::plot.new)
@@ -81,7 +80,7 @@
 
 "dev.off" <- function (which = dev.cur ())
 {
-	rk.record.plot$onDelDevice (deviceId = which)
+	rk.record.plot$onDelDevice (devId = which)
 	
 	# see http://thread.gmane.org/gmane.comp.statistics.rkward.devel/802
 	.rk.do.call ("killDevice", as.character (which))
@@ -105,9 +104,13 @@
 			{
 				if (dev.cur() == 1) rk.screen.device ()
 				## TODO: use "trellis" instead of "lattice" to accomodate ggplot2 plots?
-				rk.record.plot$record.all.recordable ()
-				rk.record.plot$record (newplot.gType = 'lattice')
+rk.record.plot$.my.message ("------- call begin -----------")
+				rk.record.plot$record (nextplot.pkg = "lattice")
+rk.record.plot$.my.message ("------- call end   -----------")
 				plot (x, ...)
+rk.record.plot$.my.message ("------- call begin -----------")
+				rk.record.plot$.save.tlo.in.hP ()
+rk.record.plot$.my.message ("------- call end   -----------")
 				invisible ()
 			})
 	)
@@ -117,8 +120,9 @@
 		function (...)
 		{
 			if (dev.cur() == 1) rk.screen.device ()
-			rk.record.plot$record.all.recordable ()
-			rk.record.plot$record (newplot.gType = 'standard')
+rk.record.plot$.my.message ("------- call begin -----------")
+			rk.record.plot$record (nextplot.pkg = "graphics")
+rk.record.plot$.my.message ("------- call end   -----------")
 		},
 		action = "append"
 	)

Modified: trunk/rkward/rkward/rbackend/rpackages/rkward/R/public_graphics.R
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/rkward/R/public_graphics.R	2010-09-09 19:03:26 UTC (rev 3009)
+++ trunk/rkward/rkward/rbackend/rpackages/rkward/R/public_graphics.R	2010-09-10 18:27:03 UTC (rev 3010)
@@ -55,339 +55,650 @@
 	ret
 }
 
-"rk.duplicate.device" <- function (deviceId = dev.cur ())
+"rk.duplicate.device" <- function (devId = dev.cur ())
 {
-	dev.set (deviceId)
-	rk.record.plot$.set.isDuplicate (TRUE)
-	dev.copy (device = x11)
-	rk.record.plot$.set.isDuplicate (FALSE)
-	#rk.record.plot$printPars () # DEBUG
+	rk.record.plot$.my.message ("------- call begin -----------")
+	rk.record.plot$.my.message ("in: rk.duplicate.device")
+	dev.set (devId)
+	dev.copy (device = x11, is.being.duplicated = TRUE)
+	rk.record.plot$.my.message ("------- call end   -----------")
 }
 
-"rk.activate.device" <- function (deviceId = dev.cur ())
+## TODO: need a wrapper around dev.set () and dev.copy!!
+## o/w a user call of dev.set () and dev.copy () will not be set/initiate the history properly
+"rk.activate.device" <- function (devId = dev.cur ())
 {
-	dev.set (deviceId)
-	rk.record.plot$.set.trellis.last.object (deviceId)
-	#rk.record.plot$printPars () # DEBUG
+	rk.record.plot$.my.message ("------- call begin -----------")
+	dev.set (devId)
+	rk.record.plot$.set.trellis.last.object ()
+	rk.record.plot$getDevSummary ()
+	rk.record.plot$.my.message ("------- call end   -----------")
 }
 
 # A global history of various graphics calls;
 "rk.record.plot" <- function ()
 {
-## TODO: 
-	# - add one or more tests to rkward_application_tests.R
-	# - .... ?
-	
 	env <- environment()
-	recorded <- list()
-	histPositions <- list("1" = 0)     # one element for every managed graphics device / window; 1 is always null device
-	replacePositions <- list ("1" = 0)
-	isDuplicate <- FALSE
-	isPreviewDevice <- FALSE
 	
-	# graphics types (standard / lattice / ...) for the stored / new plots
-	gType <- list ()
+	.sP.index <- list ()
+	sP.length <- length (.sP.index)
+	.set.sP.length <- function () sP.length <<- length (.sP.index)
 	
-	.set.isDuplicate <- function (x = FALSE) { isDuplicate <<- x }
-	.set.isPreviewDevice <- function (x = FALSE) { isPreviewDevice <<- x }
-	.set.trellis.last.object <- function (deviceId = dev.cur ())
+	.sP.template <- list (plot = NULL, pkg = "", time = NULL, call = NULL)
+	savedPlots <- list () # length (savedPlots) should always be == length (.sP.index) == sP.length
+	.unsavedPlot <- list (plot = NULL, pkg = NA_character_, is.os = NA, tryerr = NA)
+	
+	.hP.template <- list (is.this.plot.new = FALSE, is.this.dev.new = TRUE, 
+		pos.cur = NA_integer_, pos.prev = NA_integer_, pos.dupfrom = NA_integer_, 
+		#do.record = FALSE, do.append = FALSE, do.replace = FALSE, 
+		pkg = "", plot = NA)
+	histPositions <- list ("1" = .hP.template)
+	.hP.names <- names (histPositions)
+	.set.hP.names <- function () .hP.names <<- names (histPositions)
+	
+	.rk.rp.debug <- FALSE
+	.set.rk.rp.debug <- function (x) .rk.rp.debug <<- x
+	
+	.ss.used <- FALSE # split.screen variable
+	.pop.notify <- TRUE # used when hist limit is reached
+	.cll <- 50
+	.set.call.lab.len <- function (x) .cll <<- x
+	
+	## Generic functions:
+	.get.sys.time <- function () format (Sys.time (), "%Y%m%d%H%M%OS3")
+	.is.device.managed <- function (devId) as.character (devId) %in% .hP.names[-1]
+	.set.trellis.last.object <- function (devId = dev.cur ())
 	{
-		deviceId <- as.character (deviceId)
-		n <- histPositions [[deviceId]]
-		gType.n.exists <- length (gType) >= n
-		recorded.n.exists <- length (recorded) >= n
-		if (n > 0 && gType.n.exists && recorded.n.exists && gType[[n]] == "lattice")
-			assign ("last.object", recorded[[n]], envir = lattice:::.LatticeEnv)
+		# called only from rk.activate.device ()
+		devId <- as.character (devId)
+		if (histPositions[[devId]]$pkg != "lattice") return (invisible ())
+		
+		.my.message ("call from .set.tlo: Will set tlo")
+		if (histPositions[[devId]]$is.this.plot.new)
+			tlo <- histPositions[[devId]]$plot
+		else
+			tlo <- savedPlots [[.sP.index [[histPositions[[devId]]$pos.cur]]]]$plot
+		
+		assign ("last.object", tlo, envir = lattice:::.LatticeEnv)
+	}
+	.is.par.or.screen.inuse <- function ()
+	{
+		# takes care of par (mfrow / mfcol) and split.screen () issues "almost!"
+		ret <- FALSE
+		if (sum (par ("mfg") * c(-1,-1,1,1)) != 0)
+			ret <- TRUE
+		else if (graphics:::.SSexists ("sp.screens")) {
+			if (!.ss.used)
+				.ss.used <<- TRUE
+			else
+				ret <- TRUE
+		} else 
+			.ss.used <<- FALSE
+		ret
+	}
+	
+	## Device specific functions:
+	onAddDevice <- function (devId.from = 1, devId = dev.cur (), 
+		is.being.duplicated = FALSE, is.preview.device = FALSE)
+	{
+		.my.message ("------- call begin -----------")
+		.my.message ("in: onAddDevice")
+		if (is.preview.device) return (invisible ())
+		
+		devId.from <- as.character (devId.from)
+		devId <- as.character (devId)
+		
+		histPositions [[devId]] <<- .hP.template
+		if (is.being.duplicated && !histPositions [[devId.from]]$is.this.dev.new) {
+			.my.message ("Being duplicated")
+			# devId.from > 1
+			histPositions [[devId]]$is.this.plot.new <<- TRUE
+			histPositions [[devId]]$is.this.dev.new <<- FALSE
+			histPositions [[devId]]$pkg <<- histPositions [[devId.from]]$pkg
+			if (!histPositions [[devId.from]]$is.this.plot.new)
+				histPositions [[devId]]$pos.dupfrom <<- histPositions [[devId.from]]$pos.cur
+			histPositions [[devId]]$plot <<- histPositions [[devId.from]]$plot
+		}
+		.set.hP.names ()
+		getDevSummary ()
+		.rk.update.hist.actions ()
+		.my.message ("------- call end   -----------")
 		invisible ()
 	}
-	onAddDevice <- function (old_dev = 1, deviceId = dev.cur ())
+	onDelDevice <- function (devId = dev.cur())
 	{
-		# onAddDevice is called only from rk.screen.device, so no need to check dev.interactive ()
+		.my.message ("------- call begin -----------")
+		.my.message ("in: onDelDevice")
+		devId <- as.character (devId)
+		if (!(devId %in% .hP.names[-1])) return (invisible ())
 		
-		if (isPreviewDevice) return (invisible (NULL))
+		## TODO: ask for confirmation before appending a plot
+		record (devId, action = "dev.off")
+		histPositions [[devId]] <<- NULL
+		.set.hP.names ()
 		
-		old_dev <- as.character (old_dev)
-		deviceId <- as.character (deviceId)
+		getDevSummary ()
+		.my.message ("------- call end   -----------")
+		invisible ()
+	}
+	.save.tlo.in.hP <- function (devId = dev.cur ())
+	{
+		.my.message ("in: .save.tlo.in.hP")
+		# tlo = trellis.last.object
+		## TODO: explain why this is needed
+		devId <- as.character (devId)
+		histPositions [[devId]]$plot <<- trellis.last.object ()
+		.my.hP.print (devId)
+		invisible ()
+	}
+	.prep.new.device <- function (devId, pkg)
+	{
+		.my.message ("in: .prep.new.device")
+		histPositions [[devId]]$is.this.dev.new <<- FALSE
+		histPositions [[devId]]$is.this.plot.new <<- TRUE
+		histPositions [[devId]]$pkg <<- pkg
+		getDevSummary ()
+		invisible ()
+	}
+	
+	## Recording functions
+	record <- function(devId = dev.cur (), isManaged = NULL, action = "", callUHA = TRUE, nextplot.pkg = "")
+	{
+		.my.message ("in: record")
+		devId <- as.character (devId)
 		
-		# save any unsaved plots before duplicating:
-		if ((old_dev %in% names (histPositions)) && (old_dev != "1") && (histPositions[[old_dev]] > 0))
-			record (old_dev)
+		if (is.null (isManaged)) isManaged <- .is.device.managed (devId)
+		if (!isManaged) return (invisible ())
 		
-		if (isDuplicate) {
-			histPositions [[deviceId]] <<- histPositions [[old_dev]]
-			replacePositions [[deviceId]] <<- replacePositions [[old_dev]]
+		if (histPositions[[devId]]$is.this.dev.new) {
+			# a new device: ie after an x11 () call
+			if (action == "")  
+				return (invisible (.prep.new.device (devId, nextplot.pkg))) # call from plot.new () / persp () / print.trellis ()
+			else if (action == "force.append")
+				return (invisible (rk.show.message ("Nothing to record!", "Record Warning", FALSE))) # call from rk.force.append.plot
+			else
+				return (invisible ()) # if needed, handle individual actions separately
+		}
+		
+		#if (histPositions[[devId]]$pkg == "") histPositions[[devId]]$pkg <<- "graphics"
+		
+		newplot.in.Q <- nextplot.pkg != ""
+		if (action == "force.append") {
+			histPositions[[devId]]$is.this.plot.new <<- TRUE
+			histPositions[[devId]]$pkg <<- "unknown"
+		} else if (nextplot.pkg == "graphics") {
+			# unless force.append is used,
+			# check for par (mfrow / mfcol / mfg) and split.screen scenarios:
+			if (.is.par.or.screen.inuse () && action != "dev.off") return (invisible ())
+		}
+		st <- .get.sys.time ()
+		n <- switch (histPositions[[devId]]$pkg,
+			graphics = .record.graphics (devId, action, newplot.in.Q, st),
+			unknown = .record.graphics (devId, action, newplot.in.Q, st),
+			lattice = .record.lattice (devId, action, newplot.in.Q, st),
+			NA_integer_)
+		
+		.my.message ("'n' = ", n, " (RET from record.xxx)")
+		.my.message ("New plot in Q? ", newplot.in.Q)
+		
+		if (newplot.in.Q) {
+			.tmp.hP <- modifyList (.hP.template, 
+				list (is.this.plot.new = TRUE, is.this.dev.new = FALSE, pkg = nextplot.pkg))
+			.tmp.hP$pos.prev <- ifelse (is.null (.unsavedPlot$plot) && .unsavedPlot$is.os, 
+				histPositions [[devId]]$pos.prev, n)
+			histPositions [[devId]] <<- .tmp.hP
 		} else {
-			n <- length (recorded)
-			histPositions [[deviceId]] <<- if (n > 0) n+1 else 0
-			replacePositions [[deviceId]] <<- 0
+			## TODO: if (is.na (n))
+			histPositions [[devId]]$is.this.plot.new <<- FALSE
+			## TODO: pos.prev ??
+			if (!is.na (n)) histPositions [[devId]]$pos.cur <<- n
+			if (action == "force.append") histPositions [[devId]]$plot <<- NA
 		}
-		.rk.graph.history.gui () # (deviceId)
+		
+		if (callUHA) .rk.update.hist.actions ()
+		getDevSummary ()
+		invisible ()
 	}
-	onDelDevice <- function (deviceId = dev.cur())
+	.record.graphics <- function (devId, action, newplot.in.Q, st)
 	{
-		deviceId <- as.character (deviceId)
+		.my.message ("in: .record.graphics")
+		.record.main (devId, "graphics")
+		if (is.null (.unsavedPlot$plot)) return (invisible (NA_integer_))
 		
-		# save any unsaved plot before closing the device / window
-		if (deviceId %in% names (histPositions) && deviceId != "1"  && histPositions[[deviceId]] > 0) {
-			record (deviceId)
-			histPositions [[deviceId]] <<- NULL
-			replacePositions [[deviceId]] <<- NULL
+		if (histPositions [[devId]]$is.this.plot.new) {
+			save.mode <- ifelse (newplot.in.Q, "append", action)
+			if (save.mode %in% c("arrows", "dev.off", "force.append")) save.mode <- "append"
+		} else {
+			save.mode <- ifelse (newplot.in.Q, "overwrite", action)
+			if (save.mode %in% c("arrows", "dev.off")) save.mode <- "overwrite"
 		}
-		#printPars () # DEBUG
+		
+		.my.message ("save.mode: ", save.mode)
+		
+		n <- save.plot.to.history (devId, save.mode, 
+			ifelse (action == "force.append", "unknown", "graphics"), st)
+		.my.message ("'n' = ", n, " (RET from save.plot.to.history)")
+		invisible (n)
 	}
-	.grow.history <- function (deviceId, np.gT)
+	.record.lattice <- function (devId, action, newplot.in.Q, st)
 	{
-		len.r <- length(recorded)
-		ml <- getOption ('rk.graphics.hist.max.length')
+		.my.message ("in: .record.lattice")
+		if (!histPositions [[devId]]$is.this.plot.new) return (invisible (histPositions [[devId]]$pos.cur))
 		
-		if (len.r < ml) {
-			n <- len.r + 1
-		} else if (len.r == ml) {
-			warning ('Max length reached, popping out the first plot.')
-			remove (deviceId = NULL, pos = 1)
-			n <- len.r
+		.record.main (devId, "lattice")
+		if (is.null (.unsavedPlot$plot)) return (invisible (NA_integer_))
+		
+		save.mode <- ifelse (newplot.in.Q, "append", action)
+		if (save.mode %in% c("arrows", "dev.off")) save.mode <- "append"
+		
+		.my.message ("save.mode: ", save.mode)#, ", check.odsp: ", check.odsp)
+		
+		n <- save.plot.to.history (devId, save.mode, "lattice", st)
+		.my.message ("'n' = ", n, " (RET from save.plot.to.history)")
+		invisible (n)
+	}
+	.record.main <- function (devId, pkg)
+	{
+		.my.message ("in: .record.main")
+		devId.cur <- dev.cur ()
+		unsplot <- NULL
+		if (pkg %in% c("graphics", "unknown")) {
+			dev.set (as.numeric (devId))
+			try (unsplot <- recordPlot(), silent=TRUE)
+			dev.set (devId.cur)
+		} else if  (pkg == "lattice") {
+			dev.set (as.numeric (devId))
+			try (unsplot <- trellis.last.object (), silent=TRUE)
+			dev.set (devId.cur)
 		} else {
-			warning ('Current history length > max length: plot not added to history!')
-			return (invisible ())
+			##TODO: is is still possible to save it?
+			.unsavedPlot <<- list (plot = NULL, pkg = NA_character_, is.os = NA, tryerr = NA)
+			return (invisible (rk.show.message ("Unknown graphics function. Use append to store.", "Recording error", FALSE)))
 		}
-		replacePositions [[deviceId]] <<- histPositions [[deviceId]]
-		histPositions [[deviceId]] <<- n
-		gType [[n]] <<- np.gT
+		
+		if (class (unsplot) == "try-error") {
+			.unsavedPlot <<- list (plot = NULL, pkg = pkg, is.os = NA, tryerr = TRUE)
+			return (invisible (rk.show.message ("Unknown recording error", "Recording error", FALSE)))
+		}
+		
+		.unsavedPlot <<- list (plot = unsplot, pkg = pkg, 
+			is.os = object.size (unsplot) > getOption ("rk.graphics.hist.max.plotsize") * 1024, tryerr = FALSE)
+		
 		invisible ()
 	}
-	record.all.recordable <- function ()
+	
+	## Saving (the recorded plot) functions:
+	save.plot.to.history <- function (devId, save.mode, pkg, st)
 	{
-		for (d in names(histPositions)[-1]) {
-			n <- histPositions[[d]]
-			gType.n.exists <- length (gType) >= n
-			if (n > 0 && gType.n.exists) record (d)
-		}
-		invisible ()
+		.my.message ("in: save.plot.to.history")
+		switch (save.mode,
+			append = .save.plot.to.history.append (devId, pkg, st),
+			overwrite = .save.plot.to.history.overwrite (devId, pkg, st),
+			NA_integer_)
 	}
-	record <- function(deviceId = dev.cur (), newplot.gType = NULL)
+	.save.plot.to.history.append <- function (devId, pkg, st)
 	{
-		deviceId <- as.character (deviceId)
+		.my.message ("in: .save.plot.to.history.append")
+		if (!.save.oversized.plot ()) return (invisible (NA_integer_))
 		
-		isManaged <- deviceId %in% names (histPositions)
+		n <- .grow.history (st)
+		if (is.na (n)) return (invisible (n))
 		
-		# non-interactive devices, such as pdf (), png (), ... are returned at this stage:
-		if (!isManaged) return (invisible (NULL)) # --- (*)
+		savedPlots [[st]] <<- list (plot = .unsavedPlot$plot, pkg = pkg, time = st, call = NULL)
+		savedPlots [[st]]$call <<- try (.get.oldplot.call (n, .cll))
+		.my.message ("'n' = ", n, " (.save.plot.to.history.append)")
+		invisible (n)
+	}
+	.save.plot.to.history.overwrite <- function (devId, pkg, st)
+	{
+		.my.message ("in: .save.plot.to.history.overwrite")
+		# this is not setup to handle an (yet unwritten) 'overwrite' action from tool/menu bar
+		n <- histPositions [[devId]]$pos.cur
+		.st. <- .sP.index [[n]]
+		if (!.check.identical (.st., pkg) && !is.null (.unsavedPlot$plot)) {
+			if (!.save.oversized.plot ()) return (invisible (n))
+			.my.message ("_NOT_ identical, so overwriting!")
+			savedPlots [[.st.]]$plot <<- .unsavedPlot$plot
+			savedPlots [[.st.]]$call <<- try (.get.oldplot.call (n, .cll))
+			.check.other.dev.at.same.pos (devId, n)
+		} else .my.message ("_IS_ identical, so not ckecking for odsp")
+		.my.message ("'n' = ", n, " (.save.plot.to.history.overwrite)")
+		invisible (n)
+	}
+	.save.oversized.plot <- function ()
+	{
+		if (is.na (.unsavedPlot$is.os))
+			ret <- FALSE
+		else if (!.unsavedPlot$is.os)
+			ret <- TRUE
+		else 
+			ret <- rk.show.question ("Large plot!\nDo you still want to store it in the history?", 
+				"WARNING!", button.cancel = "")
+		ret
+	}
+	.check.identical <- function (.st., pkg=NA_character_) {
+		# this may need to be split into separate .check.identical."pkg" functions
+		identical (savedPlots[[.st.]]$plot, .unsavedPlot$plot)
+	}
+	.check.other.dev.at.same.pos <- function (devId, .n.)
+	{
+		# length (.n.) >= 1 when .verify.hist.limits () calls remove ()
+		.my.message ("in: .check.other.dev.at.same.pos")
+		odnames <- .hP.names [!(.hP.names %in% c("1", devId))]
+		.my.message ("odnames: ", paste (odnames, collapse = ", "))
+		if (length (odnames) == 0) return (invisible ())
 		
-		if (isManaged) {
-			# device is managed, that is, non-preview-interactive
-			
-			cur.deviceId <- dev.cur ()
-			dev.set (as.numeric(deviceId))
+		odpos <- sapply (histPositions [odnames], "[[", "pos.cur") # names kept
+		odpos <- odpos [which (odpos %in% .n.)]
+		.my.message ("names (odpos): ", paste (names (odpos), collapse = ", "))
+		.my.message ("        odpos: ", paste (odpos, collapse = ", "))
+		if (length (odpos) == 0) return (invisible ())
 		
-			if (histPositions [[deviceId]] == 0) .grow.history (deviceId, NULL)
-			n <- histPositions [[deviceId]]
-			unsavedPlot <- NULL
-			recording.succeeded <- FALSE
-			gType.n.exists <- length (gType) >= n
-			recorded.n.exists <- length (recorded) >= n
-			
-			if (gType.n.exists) {
-				if (gType[[n]] == "standard") {
-					if (class (try (unsavedPlot <- recordPlot(), silent=TRUE)) != "try-error") recording.succeeded <- TRUE
-				} else if  (gType[[n]] == "lattice") {
-					if (class (try (unsavedPlot <- trellis.last.object (), silent=TRUE)) != "try-error") recording.succeeded <- TRUE
-				}
-			}
-			
-			if (recording.succeeded) {
-				s <- object.size (unsavedPlot) # in bytes
-				
-				if (s <= getOption ('rk.graphics.hist.max.plotsize') * 1024) {
-					recorded [[n]] <<- unsavedPlot
-					if (!is.null (newplot.gType)) {
-						.grow.history (deviceId, newplot.gType)
-					} else {
-						replacePositions [[deviceId]] <<- n
-					}
-				} else {
-					# this oversized plot is lost :(
-					warning ('Oversized plot: not added to history!') # don't use stop (...)
-					if ((!is.null (newplot.gType)) && !recorded.n.exists) gType [[n]] <<- newplot.gType
-				}
-			} else {
-				if (gType.n.exists) warning ("Recording failed for some reason.")
-				if ((!is.null (newplot.gType)) && !recorded.n.exists) gType [[n]] <<- newplot.gType
-			}
-			
-			dev.set (cur.deviceId)
-			.rk.graph.history.gui ()
-			#printPars () # DEBUG
-			return (invisible ())
+		for (d in names (odpos)) {
+			histPositions[[d]]$is.this.plot.new <<- TRUE
+			histPositions[[d]]$pos.prev <<- histPositions[[d]]$pos.cur ## may not be approprite for "remove"
+			histPositions[[d]]$pos.cur <<- NA_integer_
 		}
+		invisible ()
 	}
-	remove <- function (deviceId = dev.cur (), pos = NULL) # pos can be of length > 1
+	.grow.history <- function (st)
 	{
-		history_length <- length (recorded)
-		if (history_length == 1) {
+		.my.message ("in: grow.history")
+		len.sP <- sP.length
+		ml <- getOption ('rk.graphics.hist.max.length')
+		
+		if (len.sP < ml) {
+			n <- len.sP + 1
+		} else if (len.sP == ml) {
+			if (.pop.notify)
+				.pop.notify <<- rk.show.question ("History limit reached, removing the first plot. Limits can be changed at Settings > RKWard > Output.\n\nDo you want to be notified in future?", 
+					"WARNING!", button.cancel = "")
+			remove (devId = NULL, pos = 1) # sP.length changes at this point
+			n <- len.sP
+		} else {
+			# this can happen, if max history length gets set below sP.length, without removing the excess plots,
+			# still, this should be avoided.
+			rk.show.message ("Current history length > max length: plot not added to history!", "WARNING!")
+			return (invisible (NA_integer_))
+		}
+		.sP.index [[n]] <<- st
+		.set.sP.length ()
+		.my.message ("'n' = ", n, " (grow.history)")
+		n
+	}
+	
+	## Removal function:
+	remove <- function (devId = dev.cur (), pos = NA_integer_) # pos can be of length > 1
+	{
+		.my.message ("in: remove")
+		# devId == NULL when called from verify.hist.length ()
+		
+		if (sP.length == 1) {
 			clearHistory ()
-			rk.show.message ("Plot history cleared!")
+			rk.show.message ("Plot history cleared!", "Remove plot", FALSE)
 		}
-		if (history_length <= 1) {
-			return (invisible (NULL))
+		if (sP.length <= 1) return (invisible ())
+		
+		if (!is.null (devId)) devId <- as.character (devId)
+		
+		if (!is.null (devId)) {
+			if (histPositions[[devId]]$is.this.dev.new) # on an empty device
+				return (invisible (rk.show.message ("Nothing to remove!", "Remove plot", FALSE)))
+			else if (is.na (pos) || histPositions[[devId]]$is.this.plot.new) {
+				.my.message ("removing unsaved plot from device", devId, " @ pos", pos)
+				# unsaved plot on the device, so just replay the "previous" plot
+				.p. <- histPositions[[devId]]$pos.prev
+				if (is.na (.p.)) .p. <- sP.length
+				replay (.p., devId)
+				return (invisible ())
+			}
 		}
 		
-		pop.and.update <- function (n) {
-			# length (n) can be > 1: see .verify.hist.limits ()
-			
-			len.n <- length (n)
-			recorded[n] <<- NULL
-			gType[n] <<- NULL
-			len.r <- length (recorded)
-			
-			#printPars () # DEBUG
-			for (d in names (histPositions)[-1]) {
-				m <- min (histPositions [[d]] - len.n + 1, len.r)
-				histPositions [[d]] <<- replacePositions [[d]] <<- m
-				message ("d: ", d, ", m: ", m)  # DEBUG
-				replay (m, d)
+		.my.message ("pos: ", paste (pos, collapse = ","))
+		.check.other.dev.at.same.pos (devId, pos) # works for devId = NULL as well
+		
+		.my.message ("sP.length: ", sP.length)
+		.sP.pos <- unlist (.sP.index [pos])
+		savedPlots [.sP.pos] <<- NULL
+		.sP.index [pos] <<- NULL
+		.set.sP.length ()
+		.my.message ("sP.length: ", sP.length)
+		
+		if (!is.null (devId)) replay (min (pos, sP.length), devId) # in this case, length (pos) == 1
+		
+		.l. <- length (pos)
+		hP.gt.pos <- sapply (histPositions, "[[", "pos.cur")
+		hP.gt.pos <- hP.gt.pos [which (hP.gt.pos > pos[.l.])] # removes NAs; pos[.l.] == max (pos)
+		.my.message ("names (hP.gt.pos): ", names (hP.gt.pos))
+		.my.message ("       hP.gt.pos : ", hP.gt.pos)
+		if (length (hP.gt.pos) > 0) {
+			for (.d. in names (hP.gt.pos)) {
+				histPositions[[.d.]]$pos.cur <<- min (histPositions [[.d.]]$pos.cur - .l., sP.length)
+				histPositions[[.d.]]$pos.prev <<- min (histPositions [[.d.]]$pos.prev - .l., sP.length)
 			}
-			#printPars () # DEBUG
-			.rk.graph.history.gui ()
 		}
 		
-		if (is.null (pos)) {
-			# pos == NULL means call originated from a managed device by clicking on 'Remove from history' icon,
-			# it does not mean that the position on the concerned device is NULL! The actual position is
-			# appropriately set below.
-			
-			if (is.null (deviceId)) stop ('Both deviceId and pos are NULL') # why should this happen ??
-			deviceId <- as.character (deviceId)
-			if (! (deviceId %in% names(histPositions))) stop (paste ('Device', deviceId, 'is not managed'))
-			
-			pos <- histPositions [[deviceId]] # here length (pos) = 1
-			pop.and.update (n = pos)
-		} else if (all(pos > 0) && all (pos <= history_length)) {
-			# call from: .grow.history () and .verify.hist.limits (); not from any device
-			
-			pop.and.update (n = pos)
-		} else
-			stop (paste ('Invalid position(s)'))
-		
-		invisible (NULL)
+		.rk.update.hist.actions ()
+		invisible ()
 	}
-	replay <- function(n = histPositions [[as.character (deviceId)]] - 1L, deviceId = dev.cur ())
+	clearHistory <- function ()
 	{
-		# when this function is called, there are NO unsaved plots! Saving the unsaved plot is taken care off
-		# by the wrapper functions, showXxxxx (), below
+		.my.message ("------- call begin -----------")
+		.my.message ("in: clearHistory")
+		.sP.index <<- list (); .set.sP.length ()
+		savedPlots <<- list ()
+		.unsavedPlot <<- list (plot = NULL, pkg = NA_character_, is.os = NA, tryerr = NA)
+		.ss.used <<- FALSE
+		for (d in .hP.names[-1]) {
+			if (!histPositions [[d]]$is.this.dev.new)
+				histPositions [[d]]$is.this.plot.new <<- TRUE
+			histPositions [[d]]$pos.cur <<- NA_integer_
+			histPositions [[d]]$pos.prev <<- NA_integer_
+			histPositions [[d]]$pos.dupfrom <<- NA_integer_
+		}
+		.rk.update.hist.actions ()
+		getDevSummary ()
+		.my.message ("------- call end   -----------")
+		invisible ()
+	}
+	
+	## Replay function:
+	replay <- function(n, devId = dev.cur ())
+	{
+		.my.message ("in: replay")
+		.my.message ("'n' = ", n, " (replay)")
+		on.exit (.rk.update.hist.actions ())
+		if (missing (n))
+			return (invisible (rk.show.messgae ("Position missing", "Replay error", FALSE)))
+		if (is.na (n) || n < 0 || n > sP.length)
+			return (invisible (rk.show.message(paste ("replay: 'n' not in valid range: ", n), "Replay error", FALSE)))
 		
-		deviceId <- as.character (deviceId)
+		devId <- as.character (devId)
+		cur.devId <- dev.cur ()
+		dev.set (as.numeric(devId))
 		
-		if (n > 0 && n <= length(recorded)) {
-			cur.deviceId <- dev.cur ()
-			dev.set (as.numeric(deviceId))
+		st <- .sP.index [[n]]
+		pkg <- savedPlots [[st]]$pkg
 		
-			if (gType [[n]] == "standard") {
-				replayPlot (recorded[[n]])
-			} else if (gType [[n]] == "lattice") {
-				# (re-)plot the lattice object but, if the current window is NOT active, then do not save
-				# it to lattice:::.LatticeEnv$last.object ("trellis.last.object")
-				plot (recorded[[n]], save.object = (cur.deviceId == as.numeric (deviceId)))
-			}
-			replacePositions [[deviceId]] <<- histPositions [[deviceId]] <<- n
-			histPositions [[deviceId]] <<- n
-			dev.set (cur.deviceId)
-			.rk.graph.history.gui ()
+		if (pkg %in% c("graphics", "unknown")) {
+			replayPlot (savedPlots [[st]]$plot)
+		} else if (pkg == "lattice") {
+			# (re-)plot the lattice object but, if the current window is NOT active, then do not save
+			# it to lattice:::.LatticeEnv$last.object ("trellis.last.object")
+			plot (savedPlots [[st]]$plot, save.object = (cur.devId == as.numeric (devId)))
 		}
-		else message("replay: 'n' not in valid range: ", n)
+		histPositions [[devId]] <<- modifyList (.hP.template, 
+			list (is.this.plot.new = FALSE, is.this.dev.new = FALSE, pos.prev = n, pos.cur = n, pkg = pkg))
+		.my.hP.print (devId)
+		dev.set (cur.devId)
+		invisible()
 	}
-	replaceby <- function (deviceId = dev.cur ())
+	
+	## Action wrappers:
+	showFirst <- function(devId = dev.cur())
 	{
-		deviceId <- as.character (deviceId)
-		p <- replacePositions [[deviceId]]
-		record (deviceId)
-		n <- histPositions [[deviceId]]
-		recorded [[p]] <<- recorded [[n]]
-		gType [[p]] <<- gType [[n]]
-		remove (pos = n)
-		histPositions [[deviceId]] <<- p
-		replay (n = p, deviceId)
-		invisible ()
+		if (!.is.device.managed (devId)) return (invisible ())
+		record (devId, isManaged = TRUE, action = "arrows")
+		replay(n = 1, devId)
 	}
-	showFirst <- function(deviceId = dev.cur())
+	showPrevious <- function(devId)
 	{
-		record (deviceId)
-		replay(n = 1, deviceId)
+		if (!.is.device.managed (devId)) return (invisible ())
+		record (devId, isManaged = TRUE, action = "arrows")
+		.n. <- histPositions [[as.character (devId)]]$pos.cur - 1L
+		if (is.na (.n.)) .n. <- sP.length # this happens when sP.length > 0 and the user calls x11 ()
+		replay(n = .n., devId = devId)
 	}
-	showPrevious <- function(deviceId)
+	showNext <- function(devId)
 	{
-		record (deviceId)
-		replay(n = histPositions [[as.character (deviceId)]] - 1L, deviceId = deviceId)
+		if (!.is.device.managed (devId)) return (invisible ())
+		record (devId, isManaged = TRUE, action = "arrows")
+		replay(n = histPositions [[as.character (devId)]]$pos.cur + 1L, devId = devId)
 	}
-	showNext <- function(deviceId)
+	showLast <- function(devId = dev.cur())
 	{
-		record (deviceId)
-		replay(n = histPositions [[as.character (deviceId)]] + 1L, deviceId = deviceId)
+		if (!.is.device.managed (devId)) return (invisible ())
+		record (devId, isManaged = TRUE, action = "arrows")
+		replay(n = sP.length, devId)
 	}
-	showLast <- function(deviceId = dev.cur())
+	showPlot <- function(devId = dev.cur(), index)
 	{
-		record (deviceId)
-		replay(n = length(recorded), deviceId)
+		.my.message ("in: showPlot")
+		if (!.is.device.managed (devId)) return (invisible ())
+		
+		.n. <- histPositions [[devId]]$pos.cur
+		if (index == ifelse (is.na (.n.), sP.length + 1, .n.)) {
+			.my.message ("Same position! No action needed.")
+			return (invisible ())
+		}
+		
+		## TODO: record might remove a plot form history, thus changing the indices!
+		record (devId, isManaged = TRUE, action = "arrows")
+		.my.message ("index: ", index)
+		index <- max (as.integer (index), 1L)
+		.my.message ("index: ", index, " (after max)")
+		.my.message ("'n': ", min (sP.length, index), " (still in showPlot)")
+		replay(n = min (sP.length, index), devId)
 	}
-	showPlot <- function(deviceId = dev.cur(), index)
+	forceAppend <- function (devId = dev.cur ())
 	{
-		# TODO: record might remove a plot form history, thus changing the indices!
-		record (deviceId)
-		index = max (as.integer (index), 1L)
-		replay(n = min (length (recorded), index))
+		if (!.is.device.managed (devId)) return (invisible (rk.show.message ("Device not managed", "Append this plot", FALSE)))
+		record (devId, isManaged = TRUE, action = "force.append")
 	}
-	clearHistory <- function ()
+	removePlot <- function (devId = dev.cur ())
 	{
-		isDuplicate <<- FALSE
-		isPreviewDevice <<- FALSE
-		recorded <<- list()
-		gType <<- list ()
-		histPositions [names (histPositions)] <<- 0
-		replacePositions [names (replacePositions)] <<- 0
-		#printPars () # DEBUG
-		.rk.graph.history.gui ()
+		if (!.is.device.managed (devId)) return (invisible (rk.show.message ("Device not managed", "Remove plot", FALSE)))
+		remove (devId, histPositions[[as.character (devId)]]$pos.cur)
 	}
-	printPars <- function ()
+	showPlotInfo <- function (devId = dev.cur ())
 	{
-		message ('History length   : ', length (recorded))
-		message ("History size (KB): ", round (object.size (recorded) / 1024, 2))
-		message ('Current devices  : ', paste (names (histPositions), collapse = ', ')) 
-		message ('Current positions: ', paste (unlist (histPositions), collapse = ', ')) 
-		message ('Previos positions: ', paste (unlist (replacePositions), collapse = ', ')) 
-		message ('gType @ these pos: ', paste (unlist (gType [unlist (histPositions)]), collapse = ', '))
-		message ("Plot proerties   :")
-		for (d in names (histPositions)[-1]) message (try (.get.plot.info.str (d)))
+		.my.message ("------- call begin -----------")
+		.my.message ("in: showPlotInfo")
+		rk.show.message (.get.plot.info.str (devId), caption = "Plot properties")
+		.my.message ("------- call end   -----------")
 	}
-	.rk.graph.history.gui <- function (deviceIds = names (histPositions))
+	
+	## Utility / print functions:
+	getDevSummary <- function ()
 	{
-		# this function is called whenever the history length changes
-		# or the position changes in any device.
+		if (!.rk.rp.debug) return (invisible ())
+		message ('History length   : ', sP.length)
+		message ("History size (KB): ", round (object.size (savedPlots) / 1024, 2))
+		.my.hP.print ()
+	}
+	getSavedPlotsSummary <- function ()
+	{
+		.my.message ("------- call begin -----------")
+		.tmp.df <- data.frame (
+			call = sapply (savedPlots[unlist (.sP.index, use.names = FALSE)], "[[", "call"),
+			size.KB  = sapply (lapply (savedPlots[unlist (.sP.index, use.names = FALSE)], "[[", "plot"), function (x) object.size(x)/1024),
+			pkg  = sapply (savedPlots[unlist (.sP.index, use.names = FALSE)], "[[", "pkg"),
+			timestamp  = sapply (savedPlots[unlist (.sP.index, use.names = FALSE)], "[[", "time"))
+		rownames (.tmp.df) <- NULL
+		.my.message ("------- call end   -----------")
+		.tmp.df
+	}
+	.my.message <- function (...) if (.rk.rp.debug) message (paste (..., sep = " "))
+	.my.hP.print <- function (devId = NULL) {
+		if (!.rk.rp.debug) return (invisible ())
+		if (is.null (devId)) {
+			.tmp.df <- data.frame (
+				pNew = sapply (histPositions, "[[", "is.this.plot.new"),
+				dNew = sapply (histPositions, "[[", "is.this.dev.new"),
+				posC = sapply (histPositions, "[[", "pos.cur"),
+				posP = sapply (histPositions, "[[", "pos.prev"),
+				posD = sapply (histPositions, "[[", "pos.dupfrom"),
+				pkg  = sapply (histPositions, "[[", "pkg"),
+				pCls  = sapply (lapply (histPositions, "[[", "plot"), FUN = function (x) class (x)))
+			rownames (.tmp.df) <- names (histPositions)
+		} else {
+			devId <- as.character (devId)
+			.a.hP <- histPositions[[devId]]
+			.tmp.df <- data.frame (
+				pNew = .a.hP$is.this.plot.new,
+				dNew = .a.hP$is.this.dev.new,
+				posC = .a.hP$pos.cur,
+				posP = .a.hP$pos.prev,
+				posD = .a.hP$pos.dupfrom,
+				pkg  = .a.hP$pkg,
+				pCls  = class (.a.hP$plot))
+			rownames (.tmp.df) <- devId
+		}
+		sink (file = stderr (), type = "output")
+		print (.tmp.df)
+		sink (file = stdout (), type = "output")
+	}
+	
+	## Utility / call labels functions:
+	.get.sP.calls <- function ()
+	{
+		labels <- NULL
+		if (sP.length > 0)
+			labels <- paste (format (1:sP.length), sapply (savedPlots [unlist (.sP.index, use.names = FALSE)], "[[", "call"), sep = ": ")
+		names (labels) <- NULL
+		labels
+	}
+	.get.plot.info.str <- function (devId = dev.cur (), l=0)
+	{
+		devId <- as.character (devId)
+		if (!(devId %in% .hP.names)) return (invisible (rk.show.message (paste ("Device", devId, "is not managed."), wait = FALSE)))
 		
-		deviceIds <- deviceIds [deviceIds != "1"] # ignore NULL device
-		ndevs <- length (deviceIds)
-		if (ndevs>0) {
-			positions <- character (2 * ndevs)
-			positions [2 * (1:ndevs) - 1] <- deviceIds
-			positions [2 * (1:ndevs)] <- unlist (histPositions[deviceIds], use.names = FALSE)
-			labels <- NULL
-			if (length (recorded) > 0) labels <- sapply (1:length (recorded), function (x) try (.get.oldplot.call (x)))
-			.rk.do.call ("updateDeviceHistory", c (length (recorded), labels, positions));
+		n <- histPositions [[devId]]$pos.cur
+		if (is.na (n)) {
+			info.str <- paste ("Device: ", devId, ", Position: <new>, Size: ?\nType: ", histPositions [[devId]]$pkg, sep = "")
+		} else if (n == 0) {
+			info.str <- paste ("Device: ", devId, ", Position: 0", sep = "")
+		} else {
+			info.str <- paste ("Device: ", devId, 
+				", Position: ", n, 
+				", Size (KB): ", round (object.size (savedPlots [[.sP.index [[n]]]]$plot)/1024, 2),
+				"\n", .get.oldplot.call (n, l), sep = "")
 		}
-		#print (positions) # DEBUG
-		invisible (NULL)
+		info.str
 	}
-	.get.oldplot.call.std <- function (n)
+	.get.oldplot.call <- function (n, l=0)
 	{
+		# this can be easily extended to more types
+		switch (savedPlots [[.sP.index [[n]]]]$pkg,
+			graphics = .get.oldplot.call.std (n, l),
+			unknown = .get.oldplot.call.std (n, l),
+			lattice = .get.oldplot.call.lattice (n, l),
+			"Unknown")
+	}
+	.get.oldplot.call.std <- function (n,l=0)
+	{
 		# rp <- recordPlot () is a nested pairlist object (of class "recordedplot"):
 		# rp[[1]] is the "meta data", rp[[2]] is always raw,
 		# We then figure out the relevant stuff from rp[[1]]. Use "str (rp)" for details.
-		# Currently, only main, xlab, and ylab meta data can be extracted, unambiguously.
+		# Currently, only main, sub, xlab, and ylab meta data can be extracted, unambiguously.
 		# The high level calls are not part of the meta data, only the low level .Internal
 		#   calls are stored: Eg: .Primitive (plot.xy), .Primitive (rect), .Primitive (persp), etc...
 		
 		# .f. identifies which element(s) in rp[[1]] contains title (=main,sub,xlab,ylab) information:
 		# differs from call to call. Eg: for plot () calls this is 7, for hist () this is 3, ...
+		.tmp.plot. <- savedPlots [[.sP.index [[n]]]]$plot[[1]]
 		.f. <- function ()
-			which (lapply (recorded [[n]][[1]], FUN = function (x) x[[1]]) == ".Primitive(\"title\")")
+			which (lapply (.tmp.plot., FUN = function (x) x[[1]]) == ".Primitive(\"title\")")
 		# Sometimes there is no title information at all - happens when the high level calling function
 		#   does not specifically provide any of main/sub/xlab/ylab arguemnts: Eg: persp (...)
 		# Sometimes there are more than one .Primitive ("title") calls, eg, when title (...) is called
@@ -399,109 +710,134 @@
 		# From there we pick up the last (which.max) non-null entry for each of main, sub, xlab, and ylab
 		.n. <- .f. ()
 		if (length (.n.) > 0) {
-			.T. <- lapply (lapply (recorded [[n]][[1]] [.n.], FUN = function (.a.) .a.[[2]]), 
+			.T. <- lapply (lapply (.tmp.plot. [.n.], FUN = function (.a.) .a.[[2]]), 
 				FUN = function (.aa.) {names (.aa.) <- c("main", "sub", "xlab", "ylab"); .aa.})
 			
 			for (i in c("main", "sub", "xlab", "ylab"))
 				.x.[[i]] <- .T. [[ which.max (sapply (.T., FUN = function (.a.) !is.null (.a.[[i]]))) ]] [[i]]
 		}
 		
-		paste ("Main: '", .x.$main, "'; X label: '", .x.$xlab, "'; Y label: '", .x.$ylab, "'", sep = "")
+		#.lab.str <- paste ("Main: '", .x.$main, "'; X label: '", .x.$xlab, "'; Y label: '", .x.$ylab, "'", sep = "")
+		.lab.str <- paste ("X: ", .x.$xlab, "; Y: ", .x.$ylab, "; ", .x.$main, sep = "")
+		if (l <= 0 || nchar (.lab.str) <= l) return (.lab.str)
+		
+		paste (substr (.lab.str, 1, l), "...", sep = "")
 	}
-	.get.oldplot.call.lattice <- function (n)
+	.get.oldplot.call.lattice <- function (n,l=0)
 	{
-		# trellis objects contain a call object which is the best meta data possible!
-		# If needed, main/xlab/ylab can be extracted as well.
-		paste ("Call: ", paste (deparse (recorded [[n]]$call), collapse = "\n"), sep = "")
+		.lab.str <- paste (deparse (savedPlots [[.sP.index [[n]]]]$plot$call), collapse = ifelse (l<=0, "\n", ", "))
+		if (l <= 0 || nchar (.lab.str) <= l) return (.lab.str)
+		
+		paste (substr (.lab.str, 1, l), "...", sep = "")
 	}
-	.get.oldplot.call <- function (n)
+	
+	## Utility / R - C++ connection functions:
+	.rk.update.hist.actions <- function (devIds = .hP.names)
 	{
-		# this can be easily extended to more types
-		switch (gType [[n]],
-			standard = .get.oldplot.call.std (n),
-			lattice = .get.oldplot.call.lattice (n),
-			"Unknown")
-	}
-	.get.plot.info.str <- function (deviceId = dev.cur ())
-	{
-		deviceId <- as.character (deviceId)
-		if (!deviceId %in% names (histPositions)) return ("Preview devices is not managed.")
+		# this function is called whenever the history length changes
+		# or the position changes in any device.
 		
-		n <- histPositions [[deviceId]]
-		recorded.n.exists <- length (recorded) >= n
-		if (n == 0) {
-			info.str <- paste ("Device: ", deviceId, ", Position: 0", sep = "")
-		} else if (!recorded.n.exists) {
-			info.str <- paste ("Device: ", deviceId, ", Position: ", n, ", Size: ?\nType: ", gType [[n]], sep = "")
-		} else {
-			info.str <- paste ("Device: ", deviceId, 
-				", Position: ", n, 
-				", Size (KB): ", round (object.size (recorded [[n]])/1024, 2),
-				"\n", .get.oldplot.call (n), sep = "")
+		devIds <- devIds [devIds != "1"] # ignore NULL device
+		ndevs <- length (devIds)
+		if (ndevs > 0) {
+			positions <- character (2 * ndevs)
+			positions [2 * (1:ndevs) - 1] <- devIds
+			ihP <- sapply (histPositions[devIds], "[[", "pos.cur"); ihP [is.na (ihP)] <- sP.length + 1
+			positions [2 * (1:ndevs)] <- ihP
+			#labels <- NULL
+			#if (sP.length > 0) labels <- sapply (1:sP.length, function (x) try (.get.oldplot.call (x, .cll)))
+			labels <- .get.sP.calls ()
+			.rk.do.call ("updateDeviceHistory", c (sP.length, labels, positions));
+			.my.message ("uDHA call:")
+			.my.message ("  length: ", sP.length)
+			.my.message ("  positions: ", paste (positions, collapse = ", "))
+			.my.message ("  labels: ", ifelse (is.null (labels), "NULL", paste ("\n   ", paste (labels, collapse = "\n    "))))
 		}
-		info.str
+		invisible ()
 	}
-	showPlotInfo <- function (deviceId = dev.cur ())
+	.verify.hist.limits <- function (len.max)
 	{
-		rk.show.message (.get.plot.info.str (deviceId), caption = "Plot properties")
-	}
-	.verify.hist.limits <- function ()
-	{
+		.my.message ("------- call begin -----------")
+		.my.message ("in: verify.hist.limits")
+		# this is called from settings/rksettingsmoduleoutput.cpp ~199
 		# Length restriction:
-		len.max <- getOption ('rk.graphics.hist.max.length')
-		len.r <- length (recorded)
+		len.max <- as.integer (len.max)
+		#len.max <- getOption ('rk.graphics.hist.max.length')
 		
-		ans <- 'no'
-		if (len.max < len.r) {
-			ans <- rk.show.question (paste ("Current plot history has more plots than the maximum number specified in the settings.\n",
-				len.r - len.max, " of the foremost plots will be removed.\n\nDo you want to Continue?", sep =""))
-			if (!is.null(ans) && ans)
-				remove (deviceId = NULL, pos = 1:(len.r - len.max))
+		if (len.max < sP.length) {
+			ans <- rk.show.question (paste ("Current plot history has more plots than the specified limit.\nIf you continue then _",
+				sP.length - len.max, "_ of the foremost plots will be removed.\nInstead, if you ignore then the new limit will be effective only after restarting RKWard.", sep =""), 
+				"WARNING!",
+				button.yes = "Continue", button.no = "Ignore for this session", button.cancel = "")
+			if (ans) {
+				options ("rk.graphics.hist.max.length" = len.max)
+				remove (devId = NULL, pos = 1:(sP.length - len.max))
+			}
+		} else {
+			# this takes care of the initialization when RKWard starts..
+			options ("rk.graphics.hist.max.length" = len.max)
 		}
 		
 		# Size restriction:
 		#s <- getOption ('rk.graphics.hist.max.plotsize')
 		# Existing plots are not checked for their sizes, only the new ones are.
+		.my.message ("------- call end   -----------")
 	}
 
 	env
 }
 rk.record.plot <- rk.record.plot ()
 
-# quick wrappers around rk.record.plot$show{Previous,Next} :
+# Users should use only these wrappers:
 # 1 is always the null device
-# TODO : comment / remove printPars call
-"rk.first.plot" <- function (deviceId = dev.cur ())
+# TODO : comment / remove getDevSummary call
+"rk.first.plot" <- function (devId = dev.cur ())
 {
-	rk.record.plot$showFirst (deviceId)
-	rk.record.plot$printPars ()
+	rk.record.plot$.my.message ("------- call begin -----------")
+	rk.record.plot$showFirst (devId)
+	rk.record.plot$getDevSummary ()
+	rk.record.plot$.my.message ("------- call end   -----------")
 }
-"rk.previous.plot" <- function (deviceId = dev.cur ())
+"rk.previous.plot" <- function (devId = dev.cur ())
 {
-	rk.record.plot$showPrevious (deviceId)
-	rk.record.plot$printPars ()
+	rk.record.plot$.my.message ("------- call begin -----------")
+	rk.record.plot$showPrevious (devId)
+	rk.record.plot$getDevSummary ()
+	rk.record.plot$.my.message ("------- call end   -----------")
 }
-"rk.next.plot" <- function (deviceId = dev.cur ())
+"rk.next.plot" <- function (devId = dev.cur ())
 {
-	rk.record.plot$showNext (deviceId)
-	rk.record.plot$printPars ()
+	rk.record.plot$.my.message ("------- call begin -----------")
+	rk.record.plot$showNext (devId)
+	rk.record.plot$getDevSummary ()
+	rk.record.plot$.my.message ("------- call end   -----------")
 }
-"rk.last.plot" <- function (deviceId = dev.cur ())
+"rk.last.plot" <- function (devId = dev.cur ())
 {
-	rk.record.plot$showLast (deviceId)
-	rk.record.plot$printPars ()
+	rk.record.plot$.my.message ("------- call begin -----------")
+	rk.record.plot$showLast (devId)
+	rk.record.plot$getDevSummary ()
+	rk.record.plot$.my.message ("------- call end   -----------")
 }
-"rk.goto.plot" <- function (deviceId = dev.cur (), index=1) {
-	rk.record.plot$showPlot (deviceId, index)
-	rk.record.plot$printPars ()
+"rk.goto.plot" <- function (devId = dev.cur (), index=1) {
+	rk.record.plot$.my.message ("------- call begin -----------")
+	rk.record.plot$.my.message ("in: goto.plot")
+	rk.record.plot$.my.message ("index: ", index)
+	rk.record.plot$showPlot (devId, index)
+	rk.record.plot$getDevSummary ()
+	rk.record.plot$.my.message ("------- call end   -----------")
 }
-"rk.replaceby.plot" <- function (deviceId = dev.cur ())
+"rk.force.append.plot" <- function (devId = dev.cur ())
 {
-	rk.record.plot$replaceby (deviceId)
-	rk.record.plot$printPars ()
+	rk.record.plot$.my.message ("------- call begin -----------")
+	rk.record.plot$forceAppend (devId)
+	rk.record.plot$getDevSummary ()
+	rk.record.plot$.my.message ("------- call end   -----------")
 }
-"rk.removethis.plot" <- function (deviceId = dev.cur ())
+"rk.removethis.plot" <- function (devId = dev.cur ())
 {
-	rk.record.plot$remove (deviceId)
-	rk.record.plot$printPars ()
+	rk.record.plot$.my.message ("------- call begin -----------")
+	rk.record.plot$removePlot (devId)
+	rk.record.plot$getDevSummary ()
+	rk.record.plot$.my.message ("------- call end   -----------")
 }

Modified: trunk/rkward/rkward/settings/rksettingsmoduleoutput.cpp
===================================================================
--- trunk/rkward/rkward/settings/rksettingsmoduleoutput.cpp	2010-09-09 19:03:26 UTC (rev 3009)
+++ trunk/rkward/rkward/settings/rksettingsmoduleoutput.cpp	2010-09-10 18:27:03 UTC (rev 3010)
@@ -194,9 +194,9 @@
 	command.append (", \"rk.graphics.width\"=" + QString::number (graphics_width));
 	command.append (", \"rk.graphics.height\"=" + QString::number (graphics_height));
 	if (graphics_type == "\"JPG\"") command.append (", \"rk.graphics.jpg.quality\"=" + QString::number (graphics_jpg_quality));
-	command.append (", \"rk.graphics.hist.max.length\"=" + QString::number (graphics_hist_max_length));
+	//command.append (", \"rk.graphics.hist.max.length\"=" + QString::number (graphics_hist_max_length));
 	command.append (", \"rk.graphics.hist.max.plotsize\"=" + QString::number (graphics_hist_max_plotsize));
-	list.append (command + ")\nrk.record.plot$.verify.hist.limits ()\n");
+	list.append (command + ")\nrk.record.plot$.verify.hist.limits (" + QString::number (graphics_hist_max_length) + ")\n");
 	
 	return (list);
 }

Modified: trunk/rkward/rkward/windows/rkcatchedx11windowpart.rc
===================================================================
--- trunk/rkward/rkward/windows/rkcatchedx11windowpart.rc	2010-09-09 19:03:26 UTC (rev 3009)
+++ trunk/rkward/rkward/windows/rkcatchedx11windowpart.rc	2010-09-10 18:27:03 UTC (rev 3010)
@@ -19,7 +19,7 @@
 			<Action name="plot_next"/>
 			<Action name="plot_last"/>
 			<Separator/>
-			<Action name="plot_replaceby"/>
+			<Action name="plot_force_append"/>
 			<Action name="plot_remove"/>
 			<Separator/>
 			<Action name="plot_clear_history"/>

Modified: trunk/rkward/rkward/windows/rkwindowcatcher.cpp
===================================================================
--- trunk/rkward/rkward/windows/rkwindowcatcher.cpp	2010-09-09 19:03:26 UTC (rev 3009)
+++ trunk/rkward/rkward/windows/rkwindowcatcher.cpp	2010-09-10 18:27:03 UTC (rev 3010)
@@ -421,10 +421,10 @@
 	RKGlobals::rInterface ()->issueCommand (c);
 }
 
-void RKCaughtX11Window::replacebyCurrentPlot () {
+void RKCaughtX11Window::forceAppendCurrentPlot () {
 	RK_TRACE (MISC);
 
-	RKGlobals::rInterface ()->issueCommand ("rk.replaceby.plot (" + QString::number (device_number) + ')', RCommand::App, i18n ("Overwrite previous plot by the current plot (device number %1)", device_number), error_dialog);
+	RKGlobals::rInterface ()->issueCommand ("rk.force.append.plot (" + QString::number (device_number) + ')', RCommand::App, i18n ("Append this plot to history (device number %1)", device_number), error_dialog);
 	//updateHistoryActions (history_length+1, history_length+1);
 }
 
@@ -465,7 +465,7 @@
 	plot_list_action->setCurrentItem (history_position - 1);
 	plot_list_action->setEnabled (history_length > 0);
 
-	plot_replaceby_action->setEnabled (history_length > 0);
+	plot_force_append_action->setEnabled (history_length > 0);
 	plot_remove_action->setEnabled (history_length > 0);
 
 	plot_clear_history_action->setEnabled (history_length > 0);
@@ -547,11 +547,12 @@
 	actionCollection ()->addAction ("plot_list", action);
 	connect (action, SIGNAL (triggered(int)), window, SLOT (gotoPlot(int)));
 
-	action = actionCollection ()->addAction ("plot_replaceby", window, SLOT (replacebyCurrentPlot()));
- 	action->setText (i18n ("Overwrite previous plot"));
-	window->plot_replaceby_action = (KAction*) action;
+	action = actionCollection ()->addAction ("plot_force_append", window, SLOT (forceAppendCurrentPlot()));
+ 	action->setText (i18n ("Append this plot"));
+	action->setIcon (RKStandardIcons::getIcon (RKStandardIcons::ActionSnapshot));
+	window->plot_force_append_action = (KAction*) action;
 	action = actionCollection ()->addAction ("plot_remove", window, SLOT (removeCurrentPlot()));
- 	action->setText (i18n ("Remove current plot"));
+ 	action->setText (i18n ("Remove this plot"));
 	action->setIcon (RKStandardIcons::getIcon (RKStandardIcons::ActionRemovePlot));
 	window->plot_remove_action = (KAction*) action;
 

Modified: trunk/rkward/rkward/windows/rkwindowcatcher.h
===================================================================
--- trunk/rkward/rkward/windows/rkwindowcatcher.h	2010-09-09 19:03:26 UTC (rev 3009)
+++ trunk/rkward/rkward/windows/rkwindowcatcher.h	2010-09-10 18:27:03 UTC (rev 3010)
@@ -146,7 +146,7 @@
 	void nextPlot ();
 	void lastPlot ();
 	void gotoPlot (int index);
-	void replacebyCurrentPlot ();
+	void forceAppendCurrentPlot ();
 	void removeCurrentPlot ();
 	void clearHistory ();
 	void showPlotInfo ();
@@ -183,7 +183,7 @@
 	KAction *plot_next_action;
 	KAction *plot_first_action;
 	KAction *plot_last_action;
-	KAction *plot_replaceby_action;
+	KAction *plot_force_append_action;
 	KAction *plot_remove_action;
 	KAction *plot_clear_history_action;
 	KAction *plot_properties_action;


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.




More information about the rkward-tracker mailing list