[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