The R Project SVN R

/*
 *  R : A Computer Language for Statistical Data Analysis
 *  Copyright (C) 2000--2013  The R Core Team
 *
 *  This program is free software; you can redistribute it and/or modify
 *  it under the terms of the GNU General Public License as published by
 *  the Free Software Foundation; either version 2 of the License, or
 *  (at your option) any later version.
 *
 *  This program is distributed in the hope that it will be useful,
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 *  GNU General Public License for more details.
 *
 *  You should have received a copy of the GNU General Public License
 *  along with this program; if not, a copy is available at
 *  https://www.R-project.org/Licenses/
 */

#include "tcltk.h"

#include <R_ext/Boolean.h>
#define WIN32_LEAN_AND_MEAN 1
#include <windows.h>

Rboolean R_ToplevelExec(void (*fun)(void *), void *data);

/* We don't need a re-entrancy guard on Windows as Tcl_ServiceAll
   has one -- it uses serviceMode, setting it to TCL_SERVICE_NONE
   whilst it is running.  Unlike TclDoOneEvent, it checks on entry.
 */
static void TclSpinLoop(void *data)
{
    Tcl_ServiceAll();
}

static void _R_tcldo(void)
{
    (void) R_ToplevelExec(TclSpinLoop, NULL);
}

/* import from src/gnuwin32/system.c -- private, so in no header */
typedef void (*DO_FUNC)();
extern void set_R_Tcldo(DO_FUNC ptr);
extern void unset_R_Tcldo(DO_FUNC ptr);
static int TkUp = 0, Tcl_polled = 0;


void tcltk_start(void)
{
    HWND active = GetForegroundWindow(); /* ActiveTCL steals the focus */

    if(!TkUp) tcltk_init(&TkUp); /* won't return on error */
    if (!Tcl_polled) {
    set_R_Tcldo(&_R_tcldo);
    Tcl_polled = 1;
    }
    _R_tcldo();  /* one call to trigger the focus stealing bug */
    SetForegroundWindow(active); /* and fix it */
}

void tcltk_end(void)
{
//    Tcl_DeleteInterp(RTcl_interp);
//    Tcl_Finalize();
    unset_R_Tcldo(&_R_tcldo);
    Tcl_polled = 0;
//    TkUp = 0;
}