int selectDevice(int devNum)
{
/* Valid to select nullDevice, but that will open a new device.
See ?dev.set.
*/
if((devNum >= 0) && (devNum < R_MaxDevices) &&
(R_Devices[devNum] != NULL) && active[devNum])
{
pGEDevDesc gdd;
if (!NoDevices()) {
pGEDevDesc oldd = GEcurrentDevice();
if (oldd->dev->deactivate) oldd->dev->deactivate(oldd->dev);
}
R_CurrentDevice = devNum;
/* maintain .Device */
gsetVar(R_DeviceSymbol,
elt(getSymbolValue(R_DevicesSymbol), devNum),
R_BaseEnv);
gdd = GEcurrentDevice(); /* will start a device if current is null */
if (!NoDevices()) /* which it always will be */
if (gdd->dev->activate) gdd->dev->activate(gdd->dev);
return devNum;
}
else
return selectDevice(nextDevice(devNum));
}
void GEaddDevice(pGEDevDesc gdd)
{
int i;
Rboolean appnd;
SEXP s, t;
pGEDevDesc oldd;
PROTECT(s = getSymbolValue(R_DevicesSymbol));
if (!NoDevices()) {
oldd = GEcurrentDevice();
if(oldd->dev->deactivate) oldd->dev->deactivate(oldd->dev);
}
/* find empty slot for new descriptor */
i = 1;
if (CDR(s) == R_NilValue)
appnd = TRUE;
else {
s = CDR(s);
appnd = FALSE;
}
while (R_Devices[i] != NULL) {
i++;
if (CDR(s) == R_NilValue)
appnd = TRUE;
else
s = CDR(s);
}
R_CurrentDevice = i;
R_NumDevices++;
R_Devices[i] = gdd;
active[i] = TRUE;
GEregisterWithDevice(gdd);
if(gdd->dev->activate) gdd->dev->activate(gdd->dev);
/* maintain .Devices (.Device has already been set) */
t = PROTECT(duplicate(getSymbolValue(R_DeviceSymbol)));
if (appnd)
SETCDR(s, CONS(t, R_NilValue));
else
SETCAR(s, t);
UNPROTECT(2);
/* In case a device driver did not call R_CheckDeviceAvailable
before starting its allocation, we complete the allocation and
then call killDevice here. This ensures that the device gets a
chance to deallocate its resources and the current active
device is restored to a sane value. */
if (i == R_MaxDevices - 1) {
killDevice(i);
error(_("too many open devices"));
}
}
void onBeforeExecute(DeviceContext* pDC)
{
// if the shadow device has somehow become the active device
// then switch to the rstudio device. note this can occur if the
// user creates another device such as windows() or postscript() and
// then does a dev.off
pGEDevDesc pCurrentDevice = NoDevices() ? NULL : GEcurrentDevice();
ShadowDeviceData* pShadowDevData = (ShadowDeviceData*)pDC->pDeviceSpecific;
if (pCurrentDevice != NULL && pShadowDevData != NULL)
{
if (pCurrentDevice->dev == pShadowDevData->pShadowPngDevice)
{
// select the rstudio device
selectDevice(ndevNumber(pDC->dev));
}
}
}
Rboolean haveListeningDev()
{
Rboolean ret = FALSE;
pDevDesc dd;
pGEDevDesc gd;
if(!NoDevices())
{
for(int i = 1; i < NumDevices(); i++)
{
if ((gd = GEgetDevice(i)) && (dd = gd->dev)
&& dd->gettingEvent){
ret = TRUE;
break;
}
}
}
return ret;
}
pGEDevDesc GEcurrentDevice(void)
{
/* If there are no active devices
* check the options for a "default device".
* If there is one, start it up. */
if (NoDevices()) {
SEXP defdev = GetOption1(install("device"));
if (isString(defdev) && length(defdev) > 0) {
SEXP devName = install(CHAR(STRING_ELT(defdev, 0)));
/* Not clear where this should be evaluated, since
grDevices need not be in the search path.
So we look for it first on the global search path.
*/
defdev = findVar(devName, R_GlobalEnv);
if(defdev != R_UnboundValue) {
PROTECT(defdev = lang1(devName));
eval(defdev, R_GlobalEnv);
UNPROTECT(1);
} else {
/* Not globally visible:
try grDevices namespace if loaded.
The option is unlikely to be set if it is not loaded,
as the default setting is in grDevices:::.onLoad.
*/
SEXP ns = findVarInFrame(R_NamespaceRegistry,
install("grDevices"));
if(ns != R_UnboundValue &&
findVar(devName, ns) != R_UnboundValue) {
PROTECT(defdev = lang1(devName));
eval(defdev, ns);
UNPROTECT(1);
} else
error(_("no active or default device"));
}
} else if(TYPEOF(defdev) == CLOSXP) {
PROTECT(defdev = lang1(defdev));
eval(defdev, R_GlobalEnv);
UNPROTECT(1);
} else
error(_("no active or default device"));
}
return R_Devices[R_CurrentDevice];
}
SEXP attribute_hidden
do_getGraphicsEvent(SEXP call, SEXP op, SEXP args, SEXP env)
{
SEXP result = R_NilValue, prompt;
pDevDesc dd;
pGEDevDesc gd;
int i, count=0, devNum;
checkArity(op, args);
prompt = CAR(args);
if (!isString(prompt) || !length(prompt)) error(_("invalid prompt"));
/* NB: cleanup of event handlers must be done by driver in onExit handler */
if (!NoDevices()) {
/* Initialize all devices */
i = 1;
devNum = curDevice();
while (i++ < NumDevices()) {
gd = GEgetDevice(devNum);
dd = gd->dev;
if (dd->gettingEvent)
error(_("recursive use of getGraphicsEvent not supported"));
if (dd->eventEnv != R_NilValue) {
if (dd->eventHelper) dd->eventHelper(dd, 1);
dd->gettingEvent = TRUE;
defineVar(install("result"), R_NilValue, dd->eventEnv);
count++;
}
devNum = nextDevice(devNum);
}
if (!count)
error(_("no graphics event handlers set"));
Rprintf("%s\n", CHAR(asChar(prompt)));
R_FlushConsole();
/* Poll them */
while (result == R_NilValue) {
R_ProcessEvents();
R_CheckUserInterrupt();
i = 1;
devNum = curDevice();
while (i++ < NumDevices()) {
gd = GEgetDevice(devNum);
dd = gd->dev;
if (dd->eventEnv != R_NilValue) {
if (dd->eventHelper) dd->eventHelper(dd, 2);
result = findVar(install("result"), dd->eventEnv);
if (result != R_NilValue && result != R_UnboundValue) {
break;
}
}
devNum = nextDevice(devNum);
}
}
/* clean up */
i = 1;
devNum = curDevice();
while (i++ < NumDevices()) {
gd = GEgetDevice(devNum);
dd = gd->dev;
if (dd->eventEnv != R_NilValue) {
if (dd->eventHelper) dd->eventHelper(dd, 0);
dd->gettingEvent = FALSE;
}
devNum = nextDevice(devNum);
}
}
return(result);
}