[rkward-cvs] SF.net SVN: rkward:[2893] trunk/rkward/rkward
kapatp at users.sourceforge.net
kapatp at users.sourceforge.net
Thu Jun 24 01:05:41 UTC 2010
Revision: 2893
http://rkward.svn.sourceforge.net/rkward/?rev=2893&view=rev
Author: kapatp
Date: 2010-06-24 01:05:41 +0000 (Thu, 24 Jun 2010)
Log Message:
-----------
Improving the graphics history: (1) take care of separate devices, (2) ignore non-interactive and preview devices, and (3) include dev.off wrapper
Modified Paths:
--------------
trunk/rkward/rkward/rbackend/rpackages/rkward/R/internal.R
trunk/rkward/rkward/rbackend/rpackages/rkward/R/internal_graphics.R
trunk/rkward/rkward/rbackend/rpackages/rkward/R/public_graphics.R
trunk/rkward/rkward/windows/rkwindowcatcher.cpp
Modified: trunk/rkward/rkward/rbackend/rpackages/rkward/R/internal.R
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/rkward/R/internal.R 2010-06-23 05:34:48 UTC (rev 2892)
+++ trunk/rkward/rkward/rbackend/rpackages/rkward/R/internal.R 2010-06-24 01:05:41 UTC (rev 2893)
@@ -420,5 +420,5 @@
assignInNamespace ("select.list", select.list, envir=as.environment ("package:utils"))
# call separate assignments functions:
- eval (body (.rk.fix.assignments.graphics)) # internal_graphics.R
+ if (exists (".rk.fix.assignments.graphics")) eval (body (.rk.fix.assignments.graphics)) # internal_graphics.R
}
Modified: trunk/rkward/rkward/rbackend/rpackages/rkward/R/internal_graphics.R
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/rkward/R/internal_graphics.R 2010-06-23 05:34:48 UTC (rev 2892)
+++ trunk/rkward/rkward/rbackend/rpackages/rkward/R/internal_graphics.R 2010-06-24 01:05:41 UTC (rev 2893)
@@ -2,9 +2,11 @@
## 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 (...) {
+"rk.screen.device" <- function (..., is.preview.device = FALSE) {
.rk.do.call ("startOpenX11", as.character (dev.cur ()));
+ if (!is.preview.device) dupFrom <- dev.cur ()
+
if (!exists (".rk.default.device")) {
if (base::.Platform$OS.type == "unix") {
device <- grDevices::x11
@@ -21,6 +23,8 @@
.rk.do.call ("endOpenX11", as.character (dev.cur ()));
+ if (!is.preview.device) rk.record.plot$onAddDevice (duplicateId = dupFrom, deviceId = dev.cur ())
+
invisible (x)
}
@@ -42,7 +46,7 @@
a <- .rk.preview.devices[[x]]
if (is.null (a)) {
a <- dev.cur ()
- x11 ()
+ x11 (is.preview.device = TRUE)
if (a != dev.cur ()) {
.rk.preview.devices[[x]] <<- dev.cur ()
}
@@ -54,22 +58,33 @@
".rk.killPreviewDevice" <- function (x) {
a <- .rk.preview.devices[[x]]
if (!is.null (a)) {
- .rk.preview.devices[[x]] <<- NULL
if (a %in% dev.list ()) {
dev.off (a)
}
+ .rk.preview.devices[[x]] <<- NULL
}
}
"plot.new" <- function ()
{
- rk.record.plot$record ()
+ if (dev.cur() == 1) rk.screen.device ()
+ if (dev.interactive () && !(dev.cur() %in% .rk.preview.devices)) rk.record.plot$record ()
eval (body (.rk.plot.new.default))
}
formals (plot.new) <- formals (graphics::plot.new)
.rk.plot.new.default <- graphics::plot.new
+"dev.off" <- function (which = dev.cur ())
+{
+ # Why use 'which'? There is a which ()!!
+ if (dev.interactive () && !(which %in% .rk.preview.devices)) rk.record.plot$onDelDevice (deviceId = which)
+ eval (body (.rk.dev.off.default))
+}
+formals (dev.off) <- formals (grDevices::dev.off)
+.rk.dev.off.default <- grDevices::dev.off
+
# see .rk.fix.assignmetns () in internal.R
".rk.fix.assignments.graphics" <- function () {
assignInNamespace ("plot.new", plot.new, envir=as.environment ("package:graphics"))
+ assignInNamespace ("dev.off", dev.off, envir=as.environment ("package:grDevices"))
}
Modified: trunk/rkward/rkward/rbackend/rpackages/rkward/R/public_graphics.R
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/rkward/R/public_graphics.R 2010-06-23 05:34:48 UTC (rev 2892)
+++ trunk/rkward/rkward/rbackend/rpackages/rkward/R/public_graphics.R 2010-06-24 01:05:41 UTC (rev 2893)
@@ -47,111 +47,128 @@
dev.off()
}
+"rk.duplicate.device" <- function (deviceId = dev.cur ())
+{
+ dev.set (deviceId)
+ dev.copy (device = x11)
+}
+
# create a (global) history of various graphics calls - a rudimentary attempt
-# can do: record, showPrevious, showNext, replay
"rk.record.plot" <- function ()
{
# TODO:
- # - record / show from which device? - Partially implemented
- # - Create separate history for each device?
+ # - add showFirst and showLast to menubar / toolbar
+ # - add a length and size limit to recorded () list
+ # - add a menu / toolbar to clear history
+ # - Create separate history for each device? May be not!
# - Destroy the history when a device is closed?
# - .... ?
env <- environment()
recorded <- list()
- current <- numeric (length(dev.list()) + 2); # 1 is always null device
- newPlotExists <- FALSE
+ current <- as.list(0) # 1 is always null device
+ newPlotExists <- as.list(FALSE)
- onAddDevice <- function (deviceId)
+ onAddDevice <- function (duplicateId = 1, deviceId = dev.cur ())
{
- recordUnsaved (deviceId)
- current <<- c(current, current[deviceId])
+ if (duplicateId > 1) recordUnsaved (duplicateId)
+ current [[deviceId]] <<- current [[duplicateId]]
+ newPlotExists [[deviceId]] <<- newPlotExists [[duplicateId]]
}
onDelDevice <- function (deviceId = dev.cur())
{
recordUnsaved (deviceId)
- current <<- current[-deviceId]
+ # using NULL instead of NA, shrinks the list by 1 component, which is exactly the thing to avoid here!
+ current [[deviceId]] <<- NA
+ newPlotExists [[deviceId]] <<- FALSE
}
- record <- function(newplotflag = TRUE, force = FALSE)
+ record <- function(deviceId = dev.cur (), newplotflag = TRUE, force = FALSE)
{
- if (newPlotExists) {
- if (class (try (unsavedPlot <- recordPlot(), silent=TRUE)) != 'try-error')
- {
- current[dev.cur()] <<- length(recorded) + 1L
- recorded[[current[dev.cur()]]] <<- unsavedPlot
+ cur.deviceId <- dev.cur ()
+ dev.set (deviceId)
+ if (newPlotExists [[deviceId]]) {
+ if (class (try (unsavedPlot <- recordPlot(), silent=TRUE)) != 'try-error') {
+ current [[deviceId]] <<- length(recorded) + 1L
+ recorded [[current [[deviceId]]]] <<- unsavedPlot
}
- }
- if (force) {
- if (class (try (unsavedPlot <- recordPlot(), silent=TRUE)) != 'try-error')
- {
- recorded[[current[dev.cur()]]] <<- unsavedPlot
+ } else if (force) {
+ if (class (try (unsavedPlot <- recordPlot(), silent=TRUE)) != 'try-error') {
+ recorded [[current [[deviceId]]]] <<- unsavedPlot
}
}
- newPlotExists <<- newplotflag
+ newPlotExists [[deviceId]] <<- newplotflag
+ dev.set (cur.deviceId)
}
- recordUnsaved <- function (deviceId)
+ recordUnsaved <- function (deviceId = dev.cur ())
{
- if ((current[deviceId] == length (recorded)) && newPlotExists) {
- record (newplotflag = FALSE)
+ if (newPlotExists [[deviceId]]) {
+ record (deviceId, newplotflag = FALSE)
}
}
- replay <- function(n = current[dev.cur()] - 1L, deviceId = dev.cur ())
+ replay <- function(n = current [[deviceId]] - 1L, deviceId = dev.cur ())
{
+ cur.deviceId <- dev.cur ()
+ dev.set (deviceId)
if (n > 0 && n <= length(recorded)) {
- current[deviceId] <<- n
+ current [[deviceId]] <<- n
replayPlot(recorded[[n]])
}
- #else message("'n' not in valid range: ", n)
+ else message("replay: 'n' not in valid range: ", n)
+ dev.set (cur.deviceId)
}
- restore <- function() replay(n = length(recorded))
+ showFirst <- function(deviceId = dev.cur()) replay(n = 1, deviceId)
showPrevious <- function(deviceId)
{
recordUnsaved (deviceId)
- replay(n = current[deviceId] - 1L, deviceId = deviceId)
+ replay(n = current [[deviceId]] - 1L, deviceId = deviceId)
}
showNext <- function(deviceId)
{
recordUnsaved (deviceId)
- replay(n = current[deviceId] + 1L, deviceId = deviceId)
+ replay(n = current [[deviceId]] + 1L, deviceId = deviceId)
}
+ showLast <- function(deviceId = dev.cur()) replay(n = length(recorded), deviceId)
resetHistory <- function ()
{
recorded <<- list()
- current <<- numeric (length(dev.list()) + 2)
- newPlotExists <<- FALSE
-
+ current <- as.list(0)
+ newPlotExists <- as.list(FALSE)
}
+ printPars <- function ()
+ {
+ message ('History len: ', length (recorded))
+ message ('Current devices: ', paste (unlist (current), collapse = ', '))
+ message ('New plot exists? ', paste (unlist (newPlotExists), collapse = ', '))
+ }
env
}
rk.record.plot <- rk.record.plot ()
# quick wrappers around rk.record.plot$show{Previous,Next} :
# 1 is always the null device
+# TODO : comment / remove printPars call
+"rk.first.plot" <- function (deviceId = 2)
+{
+ rk.record.plot$showFirst (deviceId)
+ rk.record.plot$printPars ()
+}
"rk.next.plot" <- function (deviceId = 2)
{
- # TODO - utilze the device number when rk.record.plot matures
- cur.deviceId <- dev.cur ()
- dev.set (which = deviceId)
rk.record.plot$showNext (deviceId)
- dev.set (which = cur.deviceId)
- invisible ()
+ rk.record.plot$printPars ()
}
"rk.current.plot" <- function (deviceId = 2)
{
- # TODO - utilze the device number when rk.record.plot matures
- cur.deviceId <- dev.cur ()
- dev.set (which = deviceId)
- rk.record.plot$record (newplotflag=FALSE, force=TRUE)
- dev.set (which = cur.deviceId)
- invisible ()
+ if (!(deviceId %in% .rk.preview.devices)) rk.record.plot$record (deviceId, newplotflag=FALSE, force=TRUE)
+ rk.record.plot$printPars ()
}
"rk.previous.plot" <- function (deviceId = 2)
{
- # TODO - utilze the device number when rk.record.plot matures
- cur.deviceId <- dev.cur ()
- dev.set (which = deviceId)
rk.record.plot$showPrevious (deviceId)
- dev.set (which = cur.deviceId)
- invisible ()
+ rk.record.plot$printPars ()
}
-
+"rk.last.plot" <- function (deviceId = 2)
+{
+ rk.record.plot$showLast (deviceId)
+ rk.record.plot$printPars ()
+}
Modified: trunk/rkward/rkward/windows/rkwindowcatcher.cpp
===================================================================
--- trunk/rkward/rkward/windows/rkwindowcatcher.cpp 2010-06-23 05:34:48 UTC (rev 2892)
+++ trunk/rkward/rkward/windows/rkwindowcatcher.cpp 2010-06-24 01:05:41 UTC (rev 2893)
@@ -314,7 +314,7 @@
RK_TRACE (MISC);
// RKGlobals::rInterface ()->issueCommand ("dev.set (" + QString::number (device_number) + ")\ndev.copy (device=x11)", RCommand::App, i18n ("Duplicate graphics device number %1", device_number), error_dialog);
- RKGlobals::rInterface ()->issueCommand ("dev.set (" + QString::number (device_number) + ")\nrk.record.plot$onAddDevice (" + QString::number (device_number) + ")\ndev.copy (device=x11)", RCommand::App, i18n ("Duplicate graphics device number %1", device_number), error_dialog);
+ RKGlobals::rInterface ()->issueCommand ("rk.duplicate.device (" + QString::number (device_number) + ")", RCommand::App, i18n ("Duplicate graphics device number %1", device_number), error_dialog);
}
void RKCaughtX11Window::nextPlot () {
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