Skip to content
Browse files

Allow tcltk to make its windows as MDI children

git-svn-id: https://svn.r-project.org/R/branches/djm-tcltk@39497 00db46b3-68df-0310-9c12-caf00c1e9a41
  • Loading branch information...
1 parent 57a0ec0 commit 16c6dffe4b4eb0708295d1d81a5c0ee38ae7d221 murdoch committed Sep 24, 2006
View
6 src/gnuwin32/CHANGES
@@ -11,6 +11,12 @@ There is a new menu item in Rgui to 'Stop all computations' which
kills all R computations immediately, skips any on.exit conditions and
returns to the comand prompt.
+tcltk windows now appear within the MDI frame when R is run in MDI mode.
+This is incomplete. Current known bugs:
+ - tkwm.deiconify, tkwm.iconify, tkwm.state don't work.
+ - clicking on some components of a window doesn't cause it to gain focus.
+ - the initial title of the window is incorrect
+
R 2.4.0
View
18 src/library/tcltk/R/Tk.R
@@ -293,13 +293,25 @@ tkscale <- function(parent, ...) tkwidget(parent, "scale", ...)
tkscrollbar <- function(parent, ...) tkwidget(parent, "scrollbar", ...)
tktext <- function(parent, ...) tkwidget(parent, "text", ...)
-tktoplevel <- function(parent=.TkRoot,...) {
- w <- tkwidget(parent,"toplevel",...)
+tktoplevel <- function(parent=.TkRoot, ...) {
+ if(.Platform$OS.type == "windows") {
+ handle <- 0
+ if (missing(parent))
+ handle <- .C("tcltk_window", handle=as.integer(handle), PACKAGE = "tcltk")$handle
+ if (handle) {
+ use <- sprintf("0x%x", handle)
+ w <- tkwidget(parent, "toplevel", use=use, ...)
+ } else w <- tkwidget(parent, "toplevel", ...)
+ } else
+ w <- tkwidget(parent,"toplevel",...)
+
ID <- .Tk.ID(w)
tkbind(w, "<Destroy>",
function() {
if (exists(ID, envir=parent$env, inherits=FALSE))
- rm(list=ID, envir=parent$env)
+ rm(list=ID, envir=parent$env)
+ if (.Platform$OS.type == "windows" && handle)
+ .C("tcltk_window", handle=as.integer(handle), PACKAGE = "tcltk")
tkbind(w, "<Destroy>","")
})
w
View
4 src/library/tcltk/R/windows/zzz.R
@@ -13,7 +13,9 @@
library.dynam("tcltk", pkg, lib)
Sys.putenv(PATH=opath)
}
- .C("tcltk_start", PACKAGE="tcltk")
+ .C("tcltk_start", handle=ifelse(getWindowsHandle("Frame"),
+ getWindowsHandle("Console"), 0),
+ PACKAGE="tcltk")
extra <- system.file("exec", package = "tcltk")
extra <- gsub("\\\\", "/", extra)
addTclPath(extra)
View
3 src/library/tcltk/src/init.c
@@ -25,8 +25,9 @@
static const R_CMethodDef CEntries[] = {
{"tcltk_init", (DL_FUNC) &tcltk_init, 0},
#ifdef Win32
- {"tcltk_start", (DL_FUNC) &tcltk_start, 0},
+ {"tcltk_start", (DL_FUNC) &tcltk_start, 1},
{"tcltk_end", (DL_FUNC) &tcltk_end, 0},
+ {"tcltk_window", (DL_FUNC) &tcltk_window, 1},
#else
{"delTcl", (DL_FUNC) &delTcl, 0},
#ifndef TCL80
View
1 src/library/tcltk/src/tcltk.h
@@ -30,6 +30,7 @@ SEXP dotTclcallback(SEXP args);
#ifdef Win32
void tcltk_start(void);
void tcltk_end(void);
+void tcltk_window(int*);
#else
void delTcl(void);
void RTcl_ActivateConsole(void);
View
167 src/library/tcltk/src/tcltk_win.c
@@ -1,7 +1,12 @@
-#include <tcl.h>
#define WIN32_LEAN_AND_MEAN 1
#include <windows.h>
+#include <tk.h>
+#include <tkPlatDecls.h>
+
+/* Define this to activate the MDI support code */
+#define TCLMDI
+
void tcltk_init();
extern __declspec(dllimport) void (* R_tcldo)();
@@ -13,17 +18,175 @@ static void _R_tcldo()
static void (* old_R_tcldo)();
-void tcltk_start()
+#ifdef TCLMDI
+static HWND MDIClientHandle = 0;
+static int UpdateMDIMenu = 0;
+/* This would make more sense in GWL_USERDATA, but changes there don't take effect fast enough */
+static int nestedCall = 0;
+#endif
+
+void tcltk_start(int* handle)
{
HWND active = GetForegroundWindow(); /* ActiveTCL steals the focus */
tcltk_init(); /* won't return on error */
old_R_tcldo = R_tcldo;
R_tcldo = &_R_tcldo;
_R_tcldo(); /* one call to trigger the focus stealing bug */
SetForegroundWindow(active); /* and fix it */
+ #ifdef TCLMDI
+ if (*handle) MDIClientHandle = GetParent((HWND)*handle);
+ #endif
}
void tcltk_end()
{
R_tcldo = old_R_tcldo;
}
+
+#ifdef TCLMDI
+
+#define TK_CLAIMFOCUS (WM_USER)
+#define TK_GEOMETRYREQ (WM_USER+1)
+#define TK_ATTACHWINDOW (WM_USER+2)
+#define TK_DETACHWINDOW (WM_USER+3)
+#define GWL_CONTAINEE (GWL_USERDATA)
+
+static int adjwidth() {
+ return 2 * GetSystemMetrics(SM_CXEDGE) + 3;
+}
+
+static int adjheight() {
+ return GetSystemMetrics(SM_CYCAPTION) +
+ 2 * GetSystemMetrics(SM_CYEDGE) + 3;
+}
+
+LRESULT CALLBACK tcltk_windowProc(HWND hwnd, UINT message, WPARAM wParam, LPARAM lParam) {
+
+ switch (message) {
+ case WM_CREATE:
+ UpdateMDIMenu = 1;
+ break;
+
+ case WM_WINDOWPOSCHANGED: {
+ WINDOWPOS *pos = (WINDOWPOS *) lParam;
+ HWND hContainee = (HWND) GetWindowLong(hwnd, GWL_CONTAINEE);
+ Tk_Window winPtr = Tk_HWNDToWindow(hContainee);
+
+ if (!winPtr) break;
+
+ if (!(pos->flags & SWP_NOSIZE)) {
+ if (!nestedCall) {
+ /*
+ * Update the shape of the contained window.
+ */
+ RECT rect;
+ int width, height;
+
+ nestedCall = 1;
+ width = pos->cx - adjwidth();
+ height = pos->cy - adjheight();
+
+ GetWindowRect(hContainee, &rect);
+ if (width != rect.right-rect.left || height != rect.bottom-rect.top) {
+ XWindowChanges changes;
+ changes.width = width;
+ changes.height = height;
+ Tk_ConfigureWindow(winPtr, CWWidth | CWHeight, &changes);
+ Tcl_ServiceAll();
+ }
+ SetWindowPos(hwnd, NULL, 0, 0, pos->cx, pos->cy,
+ SWP_NOMOVE | SWP_NOZORDER | SWP_NOACTIVATE);
+ nestedCall = 0;
+ }
+ return 0;
+ }
+ break;
+ }
+ case WM_PAINT:
+ if (UpdateMDIMenu) {
+ SendMessage(MDIClientHandle, WM_MDIREFRESHMENU, 0, 0);
+ DrawMenuBar(GetParent(MDIClientHandle));
+ UpdateMDIMenu = 0;
+ }
+ break;
+
+ case TK_CLAIMFOCUS:
+ if (wParam || (GetFocus() != NULL)) {
+ HWND hContainee = (HWND) GetWindowLong(hwnd, GWL_CONTAINEE);
+ SetFocus(hContainee);
+ }
+ return 0;
+
+ case TK_GEOMETRYREQ: {
+ /*
+ * Skip nested calls to avoid flashing
+ */
+ if (nestedCall) return 0;
+ /*
+ * Adjust the request to include the frame; it will be handled by
+ * the WM_WINDOWPOSCHANGED handler
+ */
+
+ wParam += adjwidth();
+ lParam += adjheight();
+
+ SetWindowPos(hwnd, NULL, 0, 0, wParam, lParam,
+ SWP_NOMOVE | SWP_NOZORDER | SWP_NOACTIVATE);
+ return 0;
+ }
+ case TK_ATTACHWINDOW:
+ SetWindowLong(hwnd, GWL_CONTAINEE, (long) wParam);
+ SetParent((HWND)wParam, hwnd);
+ return 0;
+
+ case TK_DETACHWINDOW:
+ SetWindowLong(hwnd, GWL_CONTAINEE, 0);
+ PostMessage(hwnd, WM_CLOSE, 0, 0);
+ return 0;
+ }
+ return DefMDIChildProc(hwnd, message, wParam, lParam);
+}
+
+static ATOM registerTCLTKClass() {
+ WNDCLASSEX wcex;
+ ZeroMemory( &wcex, sizeof(WNDCLASSEX) );
+ wcex.cbSize = sizeof(WNDCLASSEX);
+ wcex.cbWndExtra = sizeof (long);
+ wcex.lpfnWndProc = (WNDPROC) tcltk_windowProc;
+ wcex.hIcon = LoadIcon(Tk_GetHINSTANCE(), "tk");
+ wcex.hIconSm = LoadIcon(Tk_GetHINSTANCE(), "tk");
+ wcex.hCursor = LoadCursor(NULL, IDC_ARROW);
+ wcex.hbrBackground = (HBRUSH)(COLOR_BTNFACE + 1);
+ wcex.lpszClassName = "RTkTopLevel";
+ return RegisterClassEx(&wcex);
+}
+
+static ATOM RTCLTKclass = 0;
+
+void tcltk_window(int * handle)
+{
+ if (*handle) PostMessage((HWND) *handle, WM_CLOSE, 0, 0);
+ else {
+ if (MDIClientHandle) {
+ if (!RTCLTKclass) RTCLTKclass = registerTCLTKClass();
+
+ *handle = (int) CreateMDIWindow(
+ MAKEINTATOM(RTCLTKclass)
+ , "tcltk"
+ , MDIS_ALLCHILDSTYLES | WS_OVERLAPPEDWINDOW | WS_CLIPCHILDREN
+ , CW_USEDEFAULT, CW_USEDEFAULT
+ , CW_USEDEFAULT, CW_USEDEFAULT
+ , MDIClientHandle
+ , GetModuleHandle(NULL)
+ , 0
+ );
+ SetFocus((HWND)*handle);
+ }
+ }
+ }
+#else
+void tcltk_window(int * handle)
+{
+ *handle = 0;
+}
+#endif /* TCLMDI */

0 comments on commit 16c6dff

Please sign in to comment.
Something went wrong with that request. Please try again.