/* tclsizebox.c -- Tcl code to create a sizebox on Windows.
|
/* tclsizebox.c -- Tcl code to create a sizebox on Windows.
|
Copyright (C) 1997, 1998 Cygnus Solutions.
|
Copyright (C) 1997, 1998 Cygnus Solutions.
|
Written by Ian Lance Taylor <ian@cygnus.com>. */
|
Written by Ian Lance Taylor <ian@cygnus.com>. */
|
|
|
#ifdef _WIN32
|
#ifdef _WIN32
|
|
|
#include <windows.h>
|
#include <windows.h>
|
|
|
#include <tcl.h>
|
#include <tcl.h>
|
#include <tk.h>
|
#include <tk.h>
|
|
|
#include "guitcl.h"
|
#include "guitcl.h"
|
|
|
/* We need to make some Tk internal calls. The only alternative is to
|
/* We need to make some Tk internal calls. The only alternative is to
|
actually move this code into Tk. */
|
actually move this code into Tk. */
|
|
|
#include <tkWinInt.h>
|
#include <tkWinInt.h>
|
|
|
/* These should really be defined in the cygwin32 header files. */
|
/* These should really be defined in the cygwin32 header files. */
|
|
|
#ifndef GetStockPen
|
#ifndef GetStockPen
|
#define GetStockPen(p) ((HPEN) GetStockObject (p))
|
#define GetStockPen(p) ((HPEN) GetStockObject (p))
|
#define GetStockBrush(b) ((HBRUSH) GetStockObject (b))
|
#define GetStockBrush(b) ((HBRUSH) GetStockObject (b))
|
#define SelectPen(dc, p) (SelectObject (dc, (HGDIOBJ) p))
|
#define SelectPen(dc, p) (SelectObject (dc, (HGDIOBJ) p))
|
#define SelectBrush(dc, b) (SelectObject (dc, (HGDIOBJ) b))
|
#define SelectBrush(dc, b) (SelectObject (dc, (HGDIOBJ) b))
|
#define DeleteBrush(b) (DeleteObject ((HGDIOBJ) b))
|
#define DeleteBrush(b) (DeleteObject ((HGDIOBJ) b))
|
#endif
|
#endif
|
|
|
/* This file defines the Tcl command sizebox.
|
/* This file defines the Tcl command sizebox.
|
|
|
sizebox PATHNAME [OPTIONS]
|
sizebox PATHNAME [OPTIONS]
|
|
|
Creates a sizebox named PATHNAME. This accepts the standard window
|
Creates a sizebox named PATHNAME. This accepts the standard window
|
options. This should be attached to the lower right corner of a
|
options. This should be attached to the lower right corner of a
|
window in order to work as expected. */
|
window in order to work as expected. */
|
|
|
/* We use
|
/* We use
|
|
|
/* We use an instance of the structure as the Windows user data for
|
/* We use an instance of the structure as the Windows user data for
|
the window. */
|
the window. */
|
|
|
struct sizebox_userdata
|
struct sizebox_userdata
|
{
|
{
|
/* The real window procedure. */
|
/* The real window procedure. */
|
WNDPROC wndproc;
|
WNDPROC wndproc;
|
/* The Tk window. */
|
/* The Tk window. */
|
Tk_Window tkwin;
|
Tk_Window tkwin;
|
};
|
};
|
|
|
/* The window procedure we use for a sizebox. The default sizebox
|
/* The window procedure we use for a sizebox. The default sizebox
|
handling doesn't seem to erase the background if the sizebox is not
|
handling doesn't seem to erase the background if the sizebox is not
|
exactly the correct size, so we handle that here. */
|
exactly the correct size, so we handle that here. */
|
|
|
static LRESULT CALLBACK
|
static LRESULT CALLBACK
|
sizebox_wndproc (HWND hwnd, UINT msg, WPARAM wparam, LPARAM lparam)
|
sizebox_wndproc (HWND hwnd, UINT msg, WPARAM wparam, LPARAM lparam)
|
{
|
{
|
struct sizebox_userdata *su;
|
struct sizebox_userdata *su;
|
|
|
su = (struct sizebox_userdata *) GetWindowLong (hwnd, GWL_USERDATA);
|
su = (struct sizebox_userdata *) GetWindowLong (hwnd, GWL_USERDATA);
|
|
|
switch (msg)
|
switch (msg)
|
{
|
{
|
case WM_ERASEBKGND:
|
case WM_ERASEBKGND:
|
/* The default sizebox handling doesn't seem to erase the
|
/* The default sizebox handling doesn't seem to erase the
|
background if the sizebox is not exactly the correct size, so
|
background if the sizebox is not exactly the correct size, so
|
we handle that here. */
|
we handle that here. */
|
if (Tk_Height (su->tkwin) != GetSystemMetrics (SM_CYHSCROLL)
|
if (Tk_Height (su->tkwin) != GetSystemMetrics (SM_CYHSCROLL)
|
|| Tk_Width (su->tkwin) != GetSystemMetrics (SM_CXVSCROLL))
|
|| Tk_Width (su->tkwin) != GetSystemMetrics (SM_CXVSCROLL))
|
{
|
{
|
HDC hdc = (HDC) wparam;
|
HDC hdc = (HDC) wparam;
|
RECT r;
|
RECT r;
|
HPEN hpen;
|
HPEN hpen;
|
HBRUSH hbrush;
|
HBRUSH hbrush;
|
|
|
GetClientRect (hwnd, &r);
|
GetClientRect (hwnd, &r);
|
hpen = SelectPen (hdc, GetStockPen (NULL_PEN));
|
hpen = SelectPen (hdc, GetStockPen (NULL_PEN));
|
hbrush = SelectBrush (hdc, GetSysColorBrush (COLOR_3DFACE));
|
hbrush = SelectBrush (hdc, GetSysColorBrush (COLOR_3DFACE));
|
Rectangle (hdc, r.left, r.top, r.right + 1, r.bottom + 1);
|
Rectangle (hdc, r.left, r.top, r.right + 1, r.bottom + 1);
|
hbrush = SelectBrush (hdc, hbrush);
|
hbrush = SelectBrush (hdc, hbrush);
|
DeleteBrush (hbrush);
|
DeleteBrush (hbrush);
|
SelectPen (hdc, hpen);
|
SelectPen (hdc, hpen);
|
return 1;
|
return 1;
|
}
|
}
|
break;
|
break;
|
|
|
/* We need to handle cursor handling here. We also use Tk
|
/* We need to handle cursor handling here. We also use Tk
|
cursor handling via a call to Tk_DefineCursor, but we can't
|
cursor handling via a call to Tk_DefineCursor, but we can't
|
rely on it, because it will only take effect if Tk sees a
|
rely on it, because it will only take effect if Tk sees a
|
MOUSEMOVE event which won't happen if the mouse moves
|
MOUSEMOVE event which won't happen if the mouse moves
|
directly from outside any Tk window to the sizebox. */
|
directly from outside any Tk window to the sizebox. */
|
case WM_SETCURSOR:
|
case WM_SETCURSOR:
|
SetCursor (LoadCursor (NULL, IDC_SIZENWSE));
|
SetCursor (LoadCursor (NULL, IDC_SIZENWSE));
|
return 1;
|
return 1;
|
}
|
}
|
|
|
return CallWindowProc (su->wndproc, hwnd, msg, wparam, lparam);
|
return CallWindowProc (su->wndproc, hwnd, msg, wparam, lparam);
|
}
|
}
|
|
|
/* This is called by the Tk dispatcher for various events. */
|
/* This is called by the Tk dispatcher for various events. */
|
|
|
static void
|
static void
|
sizebox_event_proc (ClientData cd, XEvent *event_ptr)
|
sizebox_event_proc (ClientData cd, XEvent *event_ptr)
|
{
|
{
|
HWND hwnd = (HWND) cd;
|
HWND hwnd = (HWND) cd;
|
struct sizebox_userdata *su;
|
struct sizebox_userdata *su;
|
|
|
if (! hwnd)
|
if (! hwnd)
|
return;
|
return;
|
|
|
if (event_ptr->type == DestroyNotify)
|
if (event_ptr->type == DestroyNotify)
|
{
|
{
|
su = (struct sizebox_userdata *) GetWindowLong (hwnd, GWL_USERDATA);
|
su = (struct sizebox_userdata *) GetWindowLong (hwnd, GWL_USERDATA);
|
SetWindowLong (hwnd, GWL_USERDATA, 0);
|
SetWindowLong (hwnd, GWL_USERDATA, 0);
|
SetWindowLong (hwnd, GWL_WNDPROC, (LONG) su->wndproc);
|
SetWindowLong (hwnd, GWL_WNDPROC, (LONG) su->wndproc);
|
Tcl_Free ((char *) su);
|
Tcl_Free ((char *) su);
|
DestroyWindow (hwnd);
|
DestroyWindow (hwnd);
|
}
|
}
|
}
|
}
|
|
|
/* Create a sizebox window. */
|
/* Create a sizebox window. */
|
|
|
static Window
|
static Window
|
sizebox_create (Tk_Window tkwin, Window parent, ClientData cd)
|
sizebox_create (Tk_Window tkwin, Window parent, ClientData cd)
|
{
|
{
|
POINT pt;
|
POINT pt;
|
Tk_Window parwin;
|
Tk_Window parwin;
|
HWND parhwnd;
|
HWND parhwnd;
|
HWND hwnd;
|
HWND hwnd;
|
struct sizebox_userdata *su;
|
struct sizebox_userdata *su;
|
Window result;
|
Window result;
|
|
|
/* We need to tell Windows that the parent of the sizebox is the
|
/* We need to tell Windows that the parent of the sizebox is the
|
toplevel which holds it. Otherwise the sizebox will try to
|
toplevel which holds it. Otherwise the sizebox will try to
|
resize the child window, which doesn't make much sense. */
|
resize the child window, which doesn't make much sense. */
|
|
|
pt.x = Tk_X (tkwin);
|
pt.x = Tk_X (tkwin);
|
pt.y = Tk_Y (tkwin);
|
pt.y = Tk_Y (tkwin);
|
ClientToScreen (TkWinGetHWND (parent), &pt);
|
ClientToScreen (TkWinGetHWND (parent), &pt);
|
|
|
parwin = (Tk_Window) TkWinGetWinPtr (parent);
|
parwin = (Tk_Window) TkWinGetWinPtr (parent);
|
while (! Tk_IsTopLevel (parwin))
|
while (! Tk_IsTopLevel (parwin))
|
parwin = Tk_Parent (parwin);
|
parwin = Tk_Parent (parwin);
|
parhwnd = TkWinGetWrapperWindow (parwin);
|
parhwnd = TkWinGetWrapperWindow (parwin);
|
|
|
ScreenToClient (parhwnd, &pt);
|
ScreenToClient (parhwnd, &pt);
|
|
|
hwnd = CreateWindow ("SCROLLBAR", NULL,
|
hwnd = CreateWindow ("SCROLLBAR", NULL,
|
WS_CHILD | WS_VISIBLE | SBS_SIZEGRIP,
|
WS_CHILD | WS_VISIBLE | SBS_SIZEGRIP,
|
pt.x, pt.y, Tk_Width (tkwin), Tk_Height (tkwin),
|
pt.x, pt.y, Tk_Width (tkwin), Tk_Height (tkwin),
|
parhwnd, NULL, Tk_GetHINSTANCE (), NULL);
|
parhwnd, NULL, Tk_GetHINSTANCE (), NULL);
|
|
|
su = (struct sizebox_userdata *) Tcl_Alloc (sizeof *su);
|
su = (struct sizebox_userdata *) Tcl_Alloc (sizeof *su);
|
su->tkwin = tkwin;
|
su->tkwin = tkwin;
|
su->wndproc = (WNDPROC) GetWindowLong (hwnd, GWL_WNDPROC);
|
su->wndproc = (WNDPROC) GetWindowLong (hwnd, GWL_WNDPROC);
|
SetWindowLong (hwnd, GWL_USERDATA, (LONG) su);
|
SetWindowLong (hwnd, GWL_USERDATA, (LONG) su);
|
SetWindowLong (hwnd, GWL_WNDPROC, (LONG) sizebox_wndproc);
|
SetWindowLong (hwnd, GWL_WNDPROC, (LONG) sizebox_wndproc);
|
|
|
SetWindowPos(hwnd, HWND_TOP, 0, 0, 0, 0,
|
SetWindowPos(hwnd, HWND_TOP, 0, 0, 0, 0,
|
SWP_NOACTIVATE | SWP_NOMOVE | SWP_NOSIZE);
|
SWP_NOACTIVATE | SWP_NOMOVE | SWP_NOSIZE);
|
|
|
result = Tk_AttachHWND (tkwin, hwnd);
|
result = Tk_AttachHWND (tkwin, hwnd);
|
|
|
Tk_CreateEventHandler (tkwin, StructureNotifyMask, sizebox_event_proc,
|
Tk_CreateEventHandler (tkwin, StructureNotifyMask, sizebox_event_proc,
|
hwnd);
|
hwnd);
|
|
|
return result;
|
return result;
|
}
|
}
|
|
|
/* The class procedure table for a sizebox widget. This is an
|
/* The class procedure table for a sizebox widget. This is an
|
internal Tk structure. */
|
internal Tk structure. */
|
|
|
static TkClassProcs sizebox_procs =
|
static TkClassProcs sizebox_procs =
|
{
|
{
|
sizebox_create, /* createProc */
|
sizebox_create, /* createProc */
|
NULL, /* geometryProc */
|
NULL, /* geometryProc */
|
NULL /* modalProc */
|
NULL /* modalProc */
|
};
|
};
|
|
|
/* The implementation of the sizebox command. */
|
/* The implementation of the sizebox command. */
|
|
|
static int
|
static int
|
sizebox_command (ClientData cd, Tcl_Interp *interp, int argc, char **argv)
|
sizebox_command (ClientData cd, Tcl_Interp *interp, int argc, char **argv)
|
{
|
{
|
Tk_Window tkmain;
|
Tk_Window tkmain;
|
Tk_Window new;
|
Tk_Window new;
|
Tk_Cursor cursor;
|
Tk_Cursor cursor;
|
|
|
if (argc < 2)
|
if (argc < 2)
|
{
|
{
|
Tcl_ResetResult (interp);
|
Tcl_ResetResult (interp);
|
Tcl_AppendStringsToObj(Tcl_GetObjResult (interp),
|
Tcl_AppendStringsToObj(Tcl_GetObjResult (interp),
|
"wrong # args: should be \"",
|
"wrong # args: should be \"",
|
argv[0], " pathname ?options?\"", (char *) NULL);
|
argv[0], " pathname ?options?\"", (char *) NULL);
|
return TCL_ERROR;
|
return TCL_ERROR;
|
}
|
}
|
|
|
tkmain = Tk_MainWindow (interp);
|
tkmain = Tk_MainWindow (interp);
|
if (tkmain == NULL)
|
if (tkmain == NULL)
|
return TCL_ERROR;
|
return TCL_ERROR;
|
|
|
new = Tk_CreateWindowFromPath (interp, tkmain, argv[1], (char *) NULL);
|
new = Tk_CreateWindowFromPath (interp, tkmain, argv[1], (char *) NULL);
|
if (new == NULL)
|
if (new == NULL)
|
return TCL_ERROR;
|
return TCL_ERROR;
|
|
|
Tk_SetClass (new, "Sizebox");
|
Tk_SetClass (new, "Sizebox");
|
|
|
/* This is a Tk internal function. */
|
/* This is a Tk internal function. */
|
TkSetClassProcs (new, &sizebox_procs, NULL);
|
TkSetClassProcs (new, &sizebox_procs, NULL);
|
|
|
/* FIXME: We should handle options here, but we currently don't have
|
/* FIXME: We should handle options here, but we currently don't have
|
any. */
|
any. */
|
|
|
Tk_GeometryRequest (new, GetSystemMetrics (SM_CXVSCROLL),
|
Tk_GeometryRequest (new, GetSystemMetrics (SM_CXVSCROLL),
|
GetSystemMetrics (SM_CYHSCROLL));
|
GetSystemMetrics (SM_CYHSCROLL));
|
|
|
cursor = Tk_GetCursor (interp, new, Tk_GetUid ("size_nw_se"));
|
cursor = Tk_GetCursor (interp, new, Tk_GetUid ("size_nw_se"));
|
if (cursor == None)
|
if (cursor == None)
|
return TCL_ERROR;
|
return TCL_ERROR;
|
Tk_DefineCursor (new, cursor);
|
Tk_DefineCursor (new, cursor);
|
|
|
Tcl_SetResult (interp, Tk_PathName (new), TCL_STATIC);
|
Tcl_SetResult (interp, Tk_PathName (new), TCL_STATIC);
|
return TCL_OK;
|
return TCL_OK;
|
}
|
}
|
|
|
/* Create the sizebox command. */
|
/* Create the sizebox command. */
|
|
|
int
|
int
|
ide_create_sizebox_command (Tcl_Interp *interp)
|
ide_create_sizebox_command (Tcl_Interp *interp)
|
{
|
{
|
if (Tcl_CreateCommand (interp, "ide_sizebox", sizebox_command, NULL,
|
if (Tcl_CreateCommand (interp, "ide_sizebox", sizebox_command, NULL,
|
NULL) == NULL)
|
NULL) == NULL)
|
return TCL_ERROR;
|
return TCL_ERROR;
|
return TCL_OK;
|
return TCL_OK;
|
}
|
}
|
|
|
#endif /* _WIN32 */
|
#endif /* _WIN32 */
|
|
|
