summaryrefslogtreecommitdiffstats
path: root/win
diff options
context:
space:
mode:
authorstanton <stanton@noemail.net>1998-09-29 00:25:04 (GMT)
committerstanton <stanton@noemail.net>1998-09-29 00:25:04 (GMT)
commitf110d4e2a4b45b23f037e22b18041093a18a028f (patch)
tree99c199f65b7d32755dc8f0ee5cc773bd922a74a6 /win
parent44fe62a9cda522475be53f14654970aaa3d4a648 (diff)
downloadtk-f110d4e2a4b45b23f037e22b18041093a18a028f.zip
tk-f110d4e2a4b45b23f037e22b18041093a18a028f.tar.gz
tk-f110d4e2a4b45b23f037e22b18041093a18a028f.tar.bz2
initial tk8.1a2 version
FossilOrigin-Name: 644396f2dabc649ad5784768cfe962017d991df1
Diffstat (limited to 'win')
-rw-r--r--win/README35
-rw-r--r--win/makefile.bc20
-rw-r--r--win/makefile.vc12
-rw-r--r--win/rc/tk.rc34
-rw-r--r--win/tkWin.h7
-rw-r--r--win/tkWin32Dll.c38
-rw-r--r--win/tkWin3d.c6
-rw-r--r--win/tkWinButton.c76
-rw-r--r--win/tkWinClipboard.c6
-rw-r--r--win/tkWinColor.c6
-rw-r--r--win/tkWinConfig.c60
-rw-r--r--win/tkWinCursor.c7
-rw-r--r--win/tkWinDefault.h5
-rw-r--r--win/tkWinDialog.c1580
-rw-r--r--win/tkWinEmbed.c9
-rw-r--r--win/tkWinFont.c2124
-rw-r--r--win/tkWinInit.c4
-rw-r--r--win/tkWinInt.h14
-rw-r--r--win/tkWinKey.c72
-rw-r--r--win/tkWinMenu.c667
-rw-r--r--win/tkWinPort.h4
-rw-r--r--win/tkWinScrlbr.c4
-rw-r--r--win/tkWinSend.c1182
-rw-r--r--win/tkWinTest.c230
-rw-r--r--win/tkWinWindow.c13
-rw-r--r--win/tkWinWm.c120
-rw-r--r--win/tkWinX.c64
-rw-r--r--win/winMain.c61
28 files changed, 5151 insertions, 1309 deletions
diff --git a/win/README b/win/README
index 17a488c..09afd7c 100644
--- a/win/README
+++ b/win/README
@@ -1,10 +1,10 @@
-Tk 8.0p2 for Windows
+Tk 8.1a2 for Windows
by Scott Stanton
Sun Microsystems Laboratories
scott.stanton@eng.sun.com
-SCCS: @(#) README 1.20 97/11/21 15:17:54
+SCCS: @(#) README 1.22 98/02/18 18:03:07
1. Introduction
---------------
@@ -17,7 +17,7 @@ contains information specific to the Windows version of Tk.
2. Distribution notes
---------------------
-Tk 8.0 for Windows is distributed in binary form in addition to the
+Tk 8.1 for Windows is distributed in binary form in addition to the
common source release. The binary distribution is a self-extracting
archive with a built-in installation script.
@@ -34,8 +34,8 @@ source distribution in order to build and use extensions.
In order to compile Tk for Windows, you need the following items:
- Tcl 8.0 Source Distribution (plus any patches)
- Tk 8.0 Source Distribution (plus any patches)
+ Tcl 8.1 Source Distribution (plus any patches)
+ Tk 8.1 Source Distribution (plus any patches)
The latest Win32 SDK header files
@@ -58,24 +58,24 @@ find them. Tk looks in one of two places for the library files:
1) The environment variable "TK_LIBRARY".
- 2) In the lib\tk8.0 directory under the Tcl installation directory
+ 2) In the lib\tk8.1 directory under the Tcl installation directory
as specified in the registry:
For Windows NT & 95:
- HKEY_LOCAL_MACHINE\SOFTWARE\Sun\Tcl\8.0
+ HKEY_LOCAL_MACHINE\SOFTWARE\Sun\Tcl\8.1
Value Name is "Root"
For Win32s:
- HKEY_CLASSES_ROOT\SOFTWARE\Sun\Tcl\8.0\
+ HKEY_CLASSES_ROOT\SOFTWARE\Sun\Tcl\8.1\
2) Relative to the directory containing the current .exe.
- Tk will look for a directory "..\lib\tk8.0" relative to the
+ Tk will look for a directory "..\lib\tk8.1" relative to the
directory containing the currently running .exe.
-Note that in order to run wish80.exe, you must ensure that tcl80.dll,
-tclpip80.dll (plus tcl1680.dll under Win32s), and tk80.dll are on your
+Note that in order to run wish81.exe, you must ensure that tcl81.dll,
+tclpip81.dll (plus tcl1681.dll under Win32s), and tk81.dll are on your
path, in the system directory, or in the directory containing
-wish80.exe.
+wish81.exe.
4. Test suite
-------------
@@ -103,12 +103,10 @@ Windows beta version of Tk:
- Color management on some displays doesn't work properly resulting in
Tk switching to monochrome mode.
- Tk seems to fail to draw anything on some Matrox Millenium cards.
-- Send and winfo interps are not currently supported
- Printing does not work for images (e.g. GIF) on a canvas.
- Tk_dialog appears in the upper left corner. This is a symptom of a
larger problem with "wm geometry" when applied to unmapped or
iconified windows.
-- Some keys don't work on international keyboards.
- Grabs do not affect native menus or the title bar.
- PPM images are using the wrong translation mode for writing to
files, resulting in CR/LF terminated PPM files.
@@ -116,9 +114,6 @@ Windows beta version of Tk:
also doesn't consistently track changes in the system colors.
If you have comments or bug reports for the Windows version of Tk,
-please direct them to:
-
-Scott Stanton
-scott.stanton@eng.sun.com
-
-or post them to the newsgroup comp.lang.tcl.
+please direct them to the comp.lang.tcl newsgroup or the wintcl
+mailing list (see http://sunscript.sun.com/win/wintcl-list.html for
+more information).
diff --git a/win/makefile.bc b/win/makefile.bc
index a77c0ed..f2bd900 100644
--- a/win/makefile.bc
+++ b/win/makefile.bc
@@ -1,11 +1,11 @@
# Borland C++ 4.5 makefile for Tk
#
-# Copyright (c) 1995-1996 by Sun Microsystems, Inc.
+# Copyright (c) 1995-1997 by Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# SCCS: @(#) makefile.bc 1.73 97/11/05 16:12:27
+# SCCS: @(#) makefile.bc 1.75 98/02/18 18:32:57
#
@@ -19,7 +19,7 @@
ROOT = ..
TMPDIR = .
TOOLS = c:\bc45
-TCLDIR = ..\..\tcl8.0
+TCLDIR = ..\..\tcl8.1a2
# uncomment the following line to compile with symbols
#DEBUG=1
@@ -105,6 +105,7 @@ TKOBJS = \
$(TMPDIR)\tkWinButton.obj \
$(TMPDIR)\tkWinClipboard.obj \
$(TMPDIR)\tkWinColor.obj \
+ $(TMPDIR)\tkWinConfig.obj \
$(TMPDIR)\tkWinCursor.obj \
$(TMPDIR)\tkWinDialog.obj \
$(TMPDIR)\tkWinDraw.obj \
@@ -119,6 +120,7 @@ TKOBJS = \
$(TMPDIR)\tkWinRegion.obj \
$(TMPDIR)\tkWinScrlbr.obj \
$(TMPDIR)\tkWinSend.obj \
+ $(TMPDIR)\tkWinTest.obj \
$(TMPDIR)\tkWinWindow.obj \
$(TMPDIR)\tkWinWm.obj \
$(TMPDIR)\tkWinX.obj \
@@ -169,6 +171,8 @@ TKOBJS = \
$(TMPDIR)\tkMenubutton.obj \
$(TMPDIR)\tkMenuDraw.obj \
$(TMPDIR)\tkMessage.obj \
+ $(TMPDIR)\tkObj.obj \
+ $(TMPDIR)\tkOldConfig.obj \
$(TMPDIR)\tkOption.obj \
$(TMPDIR)\tkPack.obj \
$(TMPDIR)\tkPlace.obj \
@@ -190,11 +194,11 @@ TKOBJS = \
$(TMPDIR)\tkVisual.obj \
$(TMPDIR)\tkWindow.obj
-TCLDLL = tcl80.dll
-TCLLIB = tcl80.lib
-TKDLL = tk80.dll
-TKLIB = tk80.lib
-WISH = wish80.exe
+TCLDLL = tcl81.dll
+TCLLIB = tcl81.lib
+TKDLL = tk81.dll
+TKLIB = tk81.lib
+WISH = wish81.exe
TKTEST = tktest.exe
#
diff --git a/win/makefile.vc b/win/makefile.vc
index 7312db0..d1b2a34 100644
--- a/win/makefile.vc
+++ b/win/makefile.vc
@@ -3,8 +3,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# Copyright (c) 1995-1996 Sun Microsystems, Inc.
-# SCCS: @(#) makefile.vc 1.64 97/10/27 17:27:20
+# Copyright (c) 1995-1997 Sun Microsystems, Inc.
+# SCCS: @(#) makefile.vc 1.67 98/02/18 18:32:52
# Does not depend on the presence of any environment variables in
# order to compile tcl; all needed information is derived from
@@ -28,7 +28,7 @@
ROOT = ..
TMPDIR = .
TOOLS32 = c:\msdev
-TCLDIR = ..\..\tcl8.0
+TCLDIR = ..\..\tcl8.1a2
# Set this to the appropriate value of /MACHINE: for your platform
MACHINE = IX86
@@ -43,7 +43,7 @@ NODEBUG=1
# Do not modify below this line
######################################################################
-VERSION = 80
+VERSION = 81
TCLDLL = tcl$(VERSION).dll
TCLLIB = tcl$(VERSION).lib
@@ -85,6 +85,7 @@ TKOBJS = \
$(TMPDIR)\tkWinButton.obj \
$(TMPDIR)\tkWinClipboard.obj \
$(TMPDIR)\tkWinColor.obj \
+ $(TMPDIR)\tkWinConfig.obj \
$(TMPDIR)\tkWinCursor.obj \
$(TMPDIR)\tkWinDialog.obj \
$(TMPDIR)\tkWinDraw.obj \
@@ -99,6 +100,7 @@ TKOBJS = \
$(TMPDIR)\tkWinRegion.obj \
$(TMPDIR)\tkWinScrlbr.obj \
$(TMPDIR)\tkWinSend.obj \
+ $(TMPDIR)\tkWinTest.obj \
$(TMPDIR)\tkWinWindow.obj \
$(TMPDIR)\tkWinWm.obj \
$(TMPDIR)\tkWinX.obj \
@@ -149,6 +151,8 @@ TKOBJS = \
$(TMPDIR)\tkMenubutton.obj \
$(TMPDIR)\tkMenuDraw.obj \
$(TMPDIR)\tkMessage.obj \
+ $(TMPDIR)\tkObj.obj \
+ $(TMPDIR)\tkOldConfig.obj \
$(TMPDIR)\tkOption.obj \
$(TMPDIR)\tkPack.obj \
$(TMPDIR)\tkPlace.obj \
diff --git a/win/rc/tk.rc b/win/rc/tk.rc
index 0d74ec3..b357dd9 100644
--- a/win/rc/tk.rc
+++ b/win/rc/tk.rc
@@ -1,8 +1,10 @@
-// SCCS: @(#) tk.rc 1.22 97/03/21 18:35:14
+// SCCS: @(#) tk.rc 1.23 97/07/24 13:55:02
//
// Version
//
+#include <windows.h>
+
#define RESOURCE_INCLUDED
#include <tk.h>
@@ -37,6 +39,36 @@ BEGIN
END
END
+#include <dlgs.h>
+FILEOPENORD DIALOG DISCARDABLE 36, 24, 218, 138
+STYLE DS_MODALFRAME | DS_3DLOOK | WS_POPUP | WS_CAPTION | WS_SYSMENU
+CAPTION "Choose Directory"
+FONT 8, "Helv"
+BEGIN
+ LTEXT "Directory &name:",-1,8,6,118,9
+ EDITTEXT edt10,8,26,144,12, WS_TABSTOP | ES_AUTOHSCROLL
+ LISTBOX lst2,8,40,144,64,LBS_SORT | LBS_OWNERDRAWFIXED |
+ LBS_HASSTRINGS | LBS_NOINTEGRALHEIGHT |
+ LBS_DISABLENOSCROLL | WS_VSCROLL | WS_TABSTOP
+ LTEXT "Dri&ves:",stc4,8,106,92,9
+ COMBOBOX cmb2,8,115,144,68,CBS_DROPDOWNLIST | CBS_OWNERDRAWFIXED |
+ CBS_AUTOHSCROLL | CBS_SORT | CBS_HASSTRINGS | WS_BORDER |
+ WS_VSCROLL | WS_TABSTOP
+ DEFPUSHBUTTON "OK",1,160,6,50,14,WS_GROUP
+ PUSHBUTTON "Cancel",2,160,24,50,14,WS_GROUP
+ PUSHBUTTON "&Help",psh15,160,42,50,14,WS_GROUP
+ CHECKBOX "&Read only",chx1,160,66,50,12,WS_GROUP
+ PUSHBUTTON "Net&work...",psh14,160,115,50,14,WS_GROUP
+
+ LTEXT "a",stc3,9,143,114,15
+ EDITTEXT edt1,7,158,135,20,NOT WS_TABSTOP
+ LISTBOX lst1,8,205,134,42,LBS_NOINTEGRALHEIGHT
+ COMBOBOX cmb1,8,253,135,21,CBS_DROPDOWNLIST | CBS_OWNERDRAWFIXED |
+ CBS_AUTOHSCROLL | CBS_SORT | CBS_HASSTRINGS | WS_BORDER |
+ WS_VSCROLL
+
+END
+
//
// Icons
//
diff --git a/win/tkWin.h b/win/tkWin.h
index c9d9360..2b10c46 100644
--- a/win/tkWin.h
+++ b/win/tkWin.h
@@ -4,12 +4,12 @@
* Declarations of public types and interfaces that are only
* available under Windows.
*
- * Copyright (c) 1996 by Sun Microsystems, Inc.
+ * Copyright (c) 1996-1997 by Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * SCCS: @(#) tkWin.h 1.6 96/08/15 13:19:41
+ * SCCS: @(#) tkWin.h 1.10 97/08/29 15:21:40
*/
#ifndef _TKWIN
@@ -44,6 +44,9 @@
EXTERN Window Tk_AttachHWND _ANSI_ARGS_((Tk_Window tkwin,
HWND hwnd));
+EXTERN int Tk_DdeObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
EXTERN HINSTANCE Tk_GetHINSTANCE _ANSI_ARGS_((void));
EXTERN HWND Tk_GetHWND _ANSI_ARGS_((Window window));
EXTERN Tk_Window Tk_HWNDToWindow _ANSI_ARGS_((HWND hwnd));
diff --git a/win/tkWin32Dll.c b/win/tkWin32Dll.c
index 969e687..6f69a29 100644
--- a/win/tkWin32Dll.c
+++ b/win/tkWin32Dll.c
@@ -8,12 +8,13 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * SCCS: @(#) tkWin32Dll.c 1.9 96/08/06 15:59:08
+ * SCCS: @(#) tkWin32Dll.c 1.14 97/08/06 18:22:18
*/
-#include "tkPort.h"
#include "tkWinInt.h"
+static int tkPlatformId;
+
/*
* The following declaration is for the VC++ DLL entry point.
*/
@@ -70,6 +71,8 @@ DllMain(hInstance, reason, reserved)
DWORD reason;
LPVOID reserved;
{
+ OSVERSIONINFO os;
+
/*
* If we are attaching to the DLL from a new process, tell Tk about
* the hInstance to use. If we are detaching then clean up any
@@ -77,9 +80,40 @@ DllMain(hInstance, reason, reserved)
*/
if (reason == DLL_PROCESS_ATTACH) {
+ os.dwOSVersionInfoSize = sizeof(os);
+ GetVersionEx(&os);
+ tkPlatformId = os.dwPlatformId;
+
TkWinXInit(hInstance);
} else if (reason == DLL_PROCESS_DETACH) {
TkWinXCleanup(hInstance);
}
return(TRUE);
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkWinGetPlatformId --
+ *
+ * Determines whether running under NT, 95, or Win32s, to allow
+ * runtime conditional code.
+ *
+ * Results:
+ * The return value is one of:
+ * VER_PLATFORM_WIN32s Win32s on Windows 3.1.
+ * VER_PLATFORM_WIN32_WINDOWS Win32 on Windows 95.
+ * VER_PLATFORM_WIN32_NT Win32 on Windows NT
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkWinGetPlatformId()
+{
+ return tkPlatformId;
+}
+
diff --git a/win/tkWin3d.c b/win/tkWin3d.c
index 3ee9907..16e7c0e 100644
--- a/win/tkWin3d.c
+++ b/win/tkWin3d.c
@@ -9,11 +9,11 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * SCCS: @(#) tkWin3d.c 1.6 97/08/12 14:28:54
+ * SCCS: @(#) tkWin3d.c 1.7 97/08/22 12:13:12
*/
-#include <tk3d.h>
-#include <tkWinInt.h>
+#include "tkWinInt.h"
+#include "tk3d.h"
/*
* This structure is used to keep track of the extra colors used by
diff --git a/win/tkWinButton.c b/win/tkWinButton.c
index 47a74e6..1aaa029 100644
--- a/win/tkWinButton.c
+++ b/win/tkWinButton.c
@@ -4,12 +4,12 @@
* This file implements the Windows specific portion of the button
* widgets.
*
- * Copyright (c) 1996 by Sun Microsystems, Inc.
+ * Copyright (c) 1996-1998 by Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * SCCS: @(#) tkWinButton.c 1.12 97/09/02 13:18:27
+ * SCCS: @(#) tkWinButton.c 1.14 98/01/09 09:46:46
*/
#define OEMRESOURCE
@@ -65,12 +65,6 @@ enum {
};
/*
- * Set to non-zero if this module is initialized.
- */
-
-static int initialized = 0;
-
-/*
* Variables for the cached information about the boxes bitmap.
*/
@@ -80,11 +74,12 @@ static LPSTR boxesBits = NULL; /* Pointer to bitmap data. */
static DWORD boxHeight = 0, boxWidth = 0; /* Size of each sub-image. */
/*
- * This variable holds the default border width for a button in string
- * form for use in a Tk_ConfigSpec.
+ * The following variable holds the default border width for a button
+ * in string form for use in Tk_OptionSpecs for the various button
+ * widget classes.
*/
-static char defWidth[8];
+static char defWidth[TCL_INTEGER_SPACE];
/*
* Declarations for functions defined in this file.
@@ -99,7 +94,6 @@ static DWORD ComputeStyle _ANSI_ARGS_((WinButton* butPtr));
static Window CreateProc _ANSI_ARGS_((Tk_Window tkwin,
Window parent, ClientData instanceData));
static void InitBoxes _ANSI_ARGS_((void));
-static void UpdateButtonDefaults _ANSI_ARGS_((void));
/*
* The class procedure table for the button widgets.
@@ -177,33 +171,38 @@ InitBoxes()
/*
*----------------------------------------------------------------------
*
- * UpdateButtonDefaults --
+ * TkpButtonSetDefaults --
*
- * This function retrieves the current system defaults for
- * the button widgets.
+ * This procedure is invoked before option tables are created for
+ * buttons. It modifies some of the default values to match the
+ * current values defined for this platform.
*
* Results:
- * None.
+ * Some of the default values in *specPtr are modified.
*
* Side effects:
- * Updates the configuration defaults for buttons.
+ * Updates some of.
*
*----------------------------------------------------------------------
*/
void
-UpdateButtonDefaults()
+TkpButtonSetDefaults(specPtr)
+ Tk_OptionSpec *specPtr; /* Points to an array of option specs,
+ * terminated by one with type
+ * TK_OPTION_END. */
{
- Tk_ConfigSpec *specPtr;
- int width = GetSystemMetrics(SM_CXEDGE);
+ int width;
- if (width == 0) {
- width = 1;
+ if (defWidth[0] == 0) {
+ width = GetSystemMetrics(SM_CXEDGE);
+ if (width == 0) {
+ width = 1;
+ }
+ sprintf(defWidth, "%d", width);
}
- sprintf(defWidth, "%d", width);
- for (specPtr = tkpButtonConfigSpecs; specPtr->type != TK_CONFIG_END;
- specPtr++) {
- if (specPtr->offset == Tk_Offset(TkButton, borderWidth)) {
+ for ( ; specPtr->type != TK_OPTION_END; specPtr++) {
+ if (specPtr->internalOffset == Tk_Offset(TkButton, borderWidth)) {
specPtr->defValue = defWidth;
}
}
@@ -231,11 +230,6 @@ TkpCreateButton(tkwin)
{
WinButton *butPtr;
- if (!initialized) {
- UpdateButtonDefaults();
- initialized = 1;
- }
-
butPtr = (WinButton *)ckalloc(sizeof(WinButton));
butPtr->hwnd = NULL;
return (TkButton *) butPtr;
@@ -361,16 +355,16 @@ TkpDisplayButton(clientData)
}
border = butPtr->normalBorder;
- if ((butPtr->state == tkDisabledUid) && (butPtr->disabledFg != NULL)) {
+ if ((butPtr->state == STATE_DISABLED) && (butPtr->disabledFg != NULL)) {
gc = butPtr->disabledGC;
- } else if ((butPtr->state == tkActiveUid)
+ } else if ((butPtr->state == STATE_ACTIVE)
&& !Tk_StrictMotif(butPtr->tkwin)) {
gc = butPtr->activeTextGC;
border = butPtr->activeBorder;
} else {
gc = butPtr->normalTextGC;
}
- if ((butPtr->flags & SELECTED) && (butPtr->state != tkActiveUid)
+ if ((butPtr->flags & SELECTED) && (butPtr->state != STATE_ACTIVE)
&& (butPtr->selectBorder != NULL) && !butPtr->indicatorOn) {
border = butPtr->selectBorder;
}
@@ -391,7 +385,7 @@ TkpDisplayButton(clientData)
*/
if (butPtr->type == TYPE_BUTTON) {
- defaultWidth = ((butPtr->defaultState == tkActiveUid)
+ defaultWidth = ((butPtr->defaultState == DEFAULT_ACTIVE)
? butPtr->highlightWidth : 0);
offset = 1;
} else {
@@ -507,7 +501,7 @@ TkpDisplayButton(clientData)
y -= butPtr->indicatorDiameter / 2;
xSrc = (butPtr->flags & SELECTED) ? boxWidth : 0;
- if (butPtr->state == tkActiveUid) {
+ if (butPtr->state == STATE_ACTIVE) {
xSrc += boxWidth*2;
}
ySrc = (butPtr->type == TYPE_RADIO_BUTTON) ? 0 : boxHeight;
@@ -530,7 +524,7 @@ TkpDisplayButton(clientData)
border, TK_3D_LIGHT2));
boxesPalette[PAL_BOTTOM_OUTER] = FlipColor(TkWinGetBorderPixels(tkwin,
border, TK_3D_LIGHT_GC));
- if (butPtr->state == tkDisabledUid) {
+ if (butPtr->state == STATE_DISABLED) {
boxesPalette[PAL_INTERIOR] = FlipColor(TkWinGetBorderPixels(tkwin,
border, TK_3D_LIGHT2));
} else if (butPtr->selectBorder != NULL) {
@@ -556,7 +550,7 @@ TkpDisplayButton(clientData)
* must temporarily modify the GC.
*/
- if ((butPtr->state == tkDisabledUid)
+ if ((butPtr->state == STATE_DISABLED)
&& ((butPtr->disabledFg == NULL) || (butPtr->image != NULL))) {
if ((butPtr->flags & SELECTED) && !butPtr->indicatorOn
&& (butPtr->selectBorder != NULL)) {
@@ -666,8 +660,8 @@ TkpComputeButtonGeometry(butPtr)
} else {
Tk_FreeTextLayout(butPtr->textLayout);
butPtr->textLayout = Tk_ComputeTextLayout(butPtr->tkfont,
- butPtr->text, -1, butPtr->wrapLength, butPtr->justify, 0,
- &butPtr->textWidth, &butPtr->textHeight);
+ Tcl_GetString(butPtr->textPtr), -1, butPtr->wrapLength,
+ butPtr->justify, 0, &butPtr->textWidth, &butPtr->textHeight);
width = butPtr->textWidth;
height = butPtr->textHeight;
@@ -788,7 +782,7 @@ ButtonProc(hwnd, message, wParam, lParam)
case BN_CLICKED: {
int code;
Tcl_Interp *interp = butPtr->info.interp;
- if (butPtr->info.state != tkDisabledUid) {
+ if (butPtr->info.state != STATE_DISABLED) {
Tcl_Preserve((ClientData)interp);
code = TkInvokeButton((TkButton*)butPtr);
if (code != TCL_OK && code != TCL_CONTINUE
diff --git a/win/tkWinClipboard.c b/win/tkWinClipboard.c
index 9d4237a..5d630d9 100644
--- a/win/tkWinClipboard.c
+++ b/win/tkWinClipboard.c
@@ -3,12 +3,12 @@
*
* This file contains functions for managing the clipboard.
*
- * Copyright (c) 1995 Sun Microsystems, Inc.
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * SCCS: @(#) tkWinClipboard.c 1.8 97/05/20 17:01:13
+ * SCCS: @(#) tkWinClipboard.c 1.9 97/11/07 21:25:49
*/
#include "tkWinInt.h"
@@ -27,7 +27,7 @@
* Results:
* The return value is a standard Tcl return value.
* If an error occurs (such as no selection exists)
- * then an error message is left in interp->result.
+ * then an error message is left in the interp's result.
*
* Side effects:
* None.
diff --git a/win/tkWinColor.c b/win/tkWinColor.c
index 2cc3d09..db38a7d 100644
--- a/win/tkWinColor.c
+++ b/win/tkWinColor.c
@@ -9,11 +9,11 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * SCCS: @(#) tkWinColor.c 1.20 97/10/27 16:39:23
+ * SCCS: @(#) tkWinColor.c 1.21 97/10/29 10:37:34
*/
-#include <tkColor.h>
-#include <tkWinInt.h>
+#include "tkWinInt.h"
+#include "tkColor.h"
/*
* The following structure is used to keep track of each color that is
diff --git a/win/tkWinConfig.c b/win/tkWinConfig.c
new file mode 100644
index 0000000..feb77bd
--- /dev/null
+++ b/win/tkWinConfig.c
@@ -0,0 +1,60 @@
+/*
+ * tkWinConfig.c --
+ *
+ * This module implements the Windows system defaults for
+ * the configuration package.
+ *
+ * Copyright (c) 1997 by Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkWinConfig.c 1.4 98/01/21 00:23:32
+ */
+
+#include "tk.h"
+#include "tkInt.h"
+#include "tkWinInt.h"
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpGetSystemDefault --
+ *
+ * Given a dbName and className for a configuration option,
+ * return a string representation of the option.
+ *
+ * Results:
+ * Returns a Tk_Uid that is the string identifier that identifies
+ * this option. Returns NULL if there are no system defaults
+ * that match this pair.
+ *
+ * Side effects:
+ * None, once the package is initialized.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TkpGetSystemDefault(
+ Tk_Window tkwin, /* A window to use. */
+ char *dbName, /* The option database name. */
+ char *className) /* The name of the option class. */
+{
+ Tcl_Obj *valueObjPtr;
+ Tk_Uid classUid;
+
+ if (tkwin == NULL) {
+ return NULL;
+ }
+
+ valueObjPtr = NULL;
+ classUid = Tk_Class(tkwin);
+
+ if (strcmp(classUid, "Menu") == 0) {
+ valueObjPtr = TkWinGetMenuSystemDefault(tkwin, dbName, className);
+ }
+
+ return valueObjPtr;
+}
diff --git a/win/tkWinCursor.c b/win/tkWinCursor.c
index bf81d8f..85010e6 100644
--- a/win/tkWinCursor.c
+++ b/win/tkWinCursor.c
@@ -8,7 +8,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * SCCS: @(#) tkWinCursor.c 1.10 97/09/02 13:21:01
+ * SCCS: @(#) tkWinCursor.c 1.11 97/11/12 17:50:45
*/
#include "tkWinInt.h"
@@ -152,7 +152,7 @@ TkCreateCursorFromData(tkwin, source, mask, width, height, xHot, yHot,
/*
*----------------------------------------------------------------------
*
- * TkFreeCursor --
+ * TkpFreeCursor --
*
* This procedure is called to release a cursor allocated by
* TkGetCursorByName.
@@ -167,11 +167,10 @@ TkCreateCursorFromData(tkwin, source, mask, width, height, xHot, yHot,
*/
void
-TkFreeCursor(cursorPtr)
+TkpFreeCursor(cursorPtr)
TkCursor *cursorPtr;
{
TkWinCursor *winCursorPtr = (TkWinCursor *) cursorPtr;
- ckfree((char *) winCursorPtr);
}
/*
diff --git a/win/tkWinDefault.h b/win/tkWinDefault.h
index c82f3c8..ecd00d2 100644
--- a/win/tkWinDefault.h
+++ b/win/tkWinDefault.h
@@ -9,7 +9,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * SCCS: @(#) tkWinDefault.h 1.34 97/10/09 17:45:20
+ * SCCS: @(#) tkWinDefault.h 1.35 98/01/09 09:46:28
*/
#ifndef _TKWINDEFAULT
@@ -65,7 +65,8 @@
#define DEF_CHKRAD_FG TEXT_FG
#define DEF_BUTTON_FONT CTL_FONT
#define DEF_BUTTON_HEIGHT "0"
-#define DEF_BUTTON_HIGHLIGHT_BG NORMAL_BG
+#define DEF_BUTTON_HIGHLIGHT_BG_COLOR DEF_BUTTON_BG_COLOR
+#define DEF_BUTTON_HIGHLIGHT_BG_MONO DEF_BUTTON_BG_MONO
#define DEF_BUTTON_HIGHLIGHT HIGHLIGHT
#define DEF_LABEL_HIGHLIGHT_WIDTH "0"
#define DEF_BUTTON_HIGHLIGHT_WIDTH "1"
diff --git a/win/tkWinDialog.c b/win/tkWinDialog.c
index 7d01edb..11f2056 100644
--- a/win/tkWinDialog.c
+++ b/win/tkWinDialog.c
@@ -8,10 +8,10 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * SCCS: @(#) tkWinDialog.c 1.10 97/10/21 11:29:18
+ * SCCS: @(#) tkWinDialog.c 1.11 97/10/29 10:41:59
*
*/
-
+
#include "tkWinInt.h"
#include "tkFileFilter.h"
@@ -19,138 +19,140 @@
#include <dlgs.h> /* includes common dialog template defines */
#include <cderr.h> /* includes the common dialog error codes */
-#if ((TK_MAJOR_VERSION == 4) && (TK_MINOR_VERSION <= 2))
/*
- * The following function is implemented on tk4.3 and after only
+ * The following variable flags whether we should output debugging
+ * infomation while displaying a builtin dialog.
*/
-#define Tk_GetHWND TkWinGetHWND
-#endif
-#define SAVE_FILE 0
-#define OPEN_FILE 1
+static int debugFlag = 0;
+static Tcl_Interp *debugInterp = NULL;
-/*----------------------------------------------------------------------
- * MsgTypeInfo --
- *
- * This structure stores the type of available message box in an
- * easy-to-process format. Used by th Tk_MessageBox() function
- *----------------------------------------------------------------------
+/*
+ * The following variable holds a registered windows event used for
+ * communicating between the DirectoryChooser dialog and its hook proc.
+ */
+
+static UINT WM_LBSELCHANGED = 0;
+
+/*
+ * The following structures are used by Tk_MessageBox() to parse
+ * arguments and return results.
*/
-typedef struct MsgTypeInfo {
- char * name;
- int type;
- int numButtons;
- char * btnNames[3];
-} MsgTypeInfo;
-
-#define NUM_TYPES 6
-
-static MsgTypeInfo
-msgTypeInfo[NUM_TYPES] = {
- {"abortretryignore", MB_ABORTRETRYIGNORE, 3, {"abort", "retry", "ignore"}},
- {"ok", MB_OK, 1, {"ok" }},
- {"okcancel", MB_OKCANCEL, 2, {"ok", "cancel" }},
- {"retrycancel", MB_RETRYCANCEL, 2, {"retry", "cancel" }},
- {"yesno", MB_YESNO, 2, {"yes", "no" }},
- {"yesnocancel", MB_YESNOCANCEL, 3, {"yes", "no", "cancel"}}
+
+static const TkStateMap iconMap[] = {
+ {MB_ICONERROR, "error"},
+ {MB_ICONINFORMATION, "info"},
+ {MB_ICONQUESTION, "question"},
+ {MB_ICONWARNING, "warning"},
+ {-1, NULL}
+};
+
+static const TkStateMap typeMap[] = {
+ {MB_ABORTRETRYIGNORE, "abortretryignore"},
+ {MB_OK, "ok"},
+ {MB_OKCANCEL, "okcancel"},
+ {MB_RETRYCANCEL, "retrycancel"},
+ {MB_YESNO, "yesno"},
+ {MB_YESNOCANCEL, "yesnocancel"},
+ {-1, NULL}
+};
+
+static const TkStateMap buttonMap[] = {
+ {IDABORT, "abort"},
+ {IDRETRY, "retry"},
+ {IDIGNORE, "ignore"},
+ {IDOK, "ok"},
+ {IDCANCEL, "cancel"},
+ {IDNO, "no"},
+ {IDYES, "yes"},
+ {-1, NULL}
};
+static const int buttonFlagMap[] = {
+ MB_DEFBUTTON1, MB_DEFBUTTON2, MB_DEFBUTTON3, MB_DEFBUTTON4
+};
+
+static const struct {int type; int btnIds[3];} allowedTypes[] = {
+ {MB_ABORTRETRYIGNORE, {IDABORT, IDRETRY, IDIGNORE}},
+ {MB_OK, {IDOK, -1, -1 }},
+ {MB_OKCANCEL, {IDOK, IDCANCEL, -1 }},
+ {MB_RETRYCANCEL, {IDRETRY, IDCANCEL, -1 }},
+ {MB_YESNO, {IDYES, IDNO, -1 }},
+ {MB_YESNOCANCEL, {IDYES, IDNO, IDCANCEL}}
+};
+
+#define NUM_TYPES (sizeof(allowedTypes) / sizeof(allowedTypes[0]))
+
/*
- * The following structure is used in the GetOpenFileName() and
- * GetSaveFileName() calls.
+ * The following structure is used to pass information between the directory
+ * chooser procedure, Tk_ChooseDirectoryObjCmd(), and its dialog hook proc.
*/
-typedef struct _OpenFileData {
- Tcl_Interp * interp;
- TCHAR szFile[MAX_PATH+1];
-} OpenFileData;
+
+typedef struct ChooseDir {
+ Tcl_Interp *interp; /* Interp, used only if debug is turned on,
+ * for setting the "tk_dialog" variable. */
+ int lastCtrl; /* Used by hook proc to keep track of last
+ * control that had input focus, so when OK
+ * is pressed we know whether to browse a
+ * new directory or return. */
+ int lastIdx; /* Last item that was selected in directory
+ * browser listbox. */
+ TCHAR path[MAX_PATH]; /* On return from choose directory dialog,
+ * holds the selected path. Cannot return
+ * selected path in ofnPtr->lpstrFile because
+ * the default dialog proc stores a '\0' in
+ * it, since, of course, no _file_ was
+ * selected. */
+} ChooseDir;
/*
- * The following structure is used in the ChooseColor() call.
+ * Definitions of procedures used only in this file.
*/
-typedef struct _ChooseColorData {
- Tcl_Interp * interp;
- char * title; /* Title of the color dialog */
-} ChooseColorData;
-
-
-static int GetFileName _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv,
- int isOpen));
-static UINT CALLBACK ColorDlgHookProc _ANSI_ARGS_((HWND hDlg, UINT uMsg,
- WPARAM wParam, LPARAM lParam));
-static int MakeFilter _ANSI_ARGS_((Tcl_Interp *interp,
- OPENFILENAME *ofnPtr, char * string));
-static int ParseFileDlgArgs _ANSI_ARGS_((Tcl_Interp * interp,
- OPENFILENAME *ofnPtr, int argc, char ** argv,
- int isOpen));
-static int ProcessCDError _ANSI_ARGS_((Tcl_Interp * interp,
- DWORD dwErrorCode, HWND hWnd));
+
+static UINT APIENTRY ChooseDirectoryHookProc(HWND hdlg, UINT uMsg,
+ WPARAM wParam, LPARAM lParam);
+static UINT CALLBACK ColorDlgHookProc(HWND hDlg, UINT uMsg, WPARAM wParam,
+ LPARAM lParam);
+static int GetFileName(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[], int isOpen);
+static int MakeFilter(Tcl_Interp *interp, char *string,
+ Tcl_DString *dsPtr);
+static UINT APIENTRY OFNHookProc(HWND hdlg, UINT uMsg, WPARAM wParam,
+ LPARAM lParam);
+static void SetTkDialog(ClientData clientData);
+static int TrySetDirectory(HWND hwnd, const TCHAR *dir);
/*
- *----------------------------------------------------------------------
+ *-------------------------------------------------------------------------
*
- * EvalArgv --
+ * TkWinDialogDebug --
*
- * Invokes the Tcl procedure with the arguments. argv[0] is set by
- * the caller of this function. It may be different than cmdName.
- * The TCL command will see argv[0], not cmdName, as its name if it
- * invokes [lindex [info level 0] 0]
+ * Function to turn on/off debugging support for common dialogs under
+ * windows. The variable "tk_debug" is set to the identifier of the
+ * dialog window when the modal dialog window pops up and it is safe to
+ * send messages to the dialog.
*
* Results:
- * TCL_ERROR if the command does not exist and cannot be autoloaded.
- * Otherwise, return the result of the evaluation of the command.
+ * None.
*
* Side effects:
- * The command may be autoloaded.
+ * This variable only makes sense if just one dialog is up at a time.
*
- *----------------------------------------------------------------------
+ *-------------------------------------------------------------------------
*/
-static int
-EvalArgv(interp, cmdName, argc, argv)
- Tcl_Interp *interp; /* Current interpreter. */
- char * cmdName; /* Name of the TCL command to call */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+void
+TkWinDialogDebug(
+ int debug)
{
- Tcl_CmdInfo cmdInfo;
-
- if (!Tcl_GetCommandInfo(interp, cmdName, &cmdInfo)) {
- char * cmdArgv[2];
-
- /*
- * This comand is not in the interpreter yet -- looks like we
- * have to auto-load it
- */
- if (!Tcl_GetCommandInfo(interp, "auto_load", &cmdInfo)) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "cannot execute command \"auto_load\"",
- NULL);
- return TCL_ERROR;
- }
-
- cmdArgv[0] = "auto_load";
- cmdArgv[1] = cmdName;
-
- if ((*cmdInfo.proc)(cmdInfo.clientData, interp, 2, cmdArgv)!= TCL_OK){
- return TCL_ERROR;
- }
-
- if (!Tcl_GetCommandInfo(interp, cmdName, &cmdInfo)) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "cannot auto-load command \"",
- cmdName, "\"",NULL);
- return TCL_ERROR;
- }
- }
-
- return (*cmdInfo.proc)(cmdInfo.clientData, interp, argc, argv);
+ debugFlag = debug;
}
/*
- *----------------------------------------------------------------------
+ *-------------------------------------------------------------------------
*
- * Tk_ChooseColorCmd --
+ * Tk_ChooseColorObjCmd --
*
* This procedure implements the color dialog box for the Windows
* platform. See the user documentation for details on what it
@@ -164,106 +166,105 @@ EvalArgv(interp, cmdName, argc, argv)
* This window is not destroyed and will be reused the next time the
* application invokes the "tk_chooseColor" command.
*
- *----------------------------------------------------------------------
+ *-------------------------------------------------------------------------
*/
int
-Tk_ChooseColorCmd(clientData, interp, argc, argv)
+Tk_ChooseColorObjCmd(clientData, interp, objc, objv)
ClientData clientData; /* Main window associated with interpreter. */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- Tk_Window parent = Tk_MainWindow(interp);
- ChooseColorData custData;
- int oldMode;
+ Tk_Window tkwin, parent;
+ int i, oldMode, winCode;
CHOOSECOLOR chooseColor;
- char * colorStr = NULL;
- int i;
- int winCode, tclCode;
- XColor * colorPtr = NULL;
static inited = 0;
- static long dwCustColors[16];
+ static COLORREF dwCustColors[16];
static long oldColor; /* the color selected last time */
-
- custData.title = NULL;
-
- if (!inited) {
+ static char *optionStrings[] = {
+ "-initialcolor", "-parent", "-title", NULL
+ };
+ enum options {
+ COLOR_INITIAL, COLOR_PARENT, COLOR_TITLE
+ };
+
+ if (inited == 0) {
/*
* dwCustColors stores the custom color which the user can
- * modify. We store these colors in a fixed array so that the next
+ * modify. We store these colors in a static array so that the next
* time the color dialog pops up, the same set of custom colors
* remain in the dialog.
*/
- for (i=0; i<16; i++) {
- dwCustColors[i] = (RGB(255-i*10, i, i*10)) ;
+ for (i = 0; i < 16; i++) {
+ dwCustColors[i] = RGB(255-i * 10, i, i * 10);
}
- oldColor = RGB(0xa0,0xa0,0xa0);
+ oldColor = RGB(0xa0, 0xa0, 0xa0);
inited = 1;
}
- /*
- * 1. Parse the arguments
- */
-
- chooseColor.lStructSize = sizeof(CHOOSECOLOR) ;
- chooseColor.hwndOwner = 0; /* filled in below */
- chooseColor.hInstance = 0;
- chooseColor.rgbResult = oldColor;
- chooseColor.lpCustColors = (LPDWORD) dwCustColors ;
- chooseColor.Flags = CC_RGBINIT | CC_FULLOPEN | CC_ENABLEHOOK;
- chooseColor.lCustData = (LPARAM)&custData;
- chooseColor.lpfnHook = ColorDlgHookProc;
- chooseColor.lpTemplateName = NULL;
-
- for (i=1; i<argc; i+=2) {
- int v = i+1;
- int len = strlen(argv[i]);
-
- if (strncmp(argv[i], "-initialcolor", len)==0) {
- if (v==argc) {goto arg_missing;}
-
- colorStr = argv[v];
+ tkwin = (Tk_Window) clientData;
+
+ parent = tkwin;
+ chooseColor.lStructSize = sizeof(CHOOSECOLOR) ;
+ chooseColor.hwndOwner = 0;
+ chooseColor.hInstance = 0;
+ chooseColor.rgbResult = oldColor;
+ chooseColor.lpCustColors = dwCustColors ;
+ chooseColor.Flags = CC_RGBINIT | CC_FULLOPEN | CC_ENABLEHOOK;
+ chooseColor.lCustData = (LPARAM) NULL;
+ chooseColor.lpfnHook = ColorDlgHookProc;
+ chooseColor.lpTemplateName = (LPTSTR) interp;
+
+ for (i = 1; i < objc; i += 2) {
+ int index;
+ char *string;
+ Tcl_Obj *optionPtr, *valuePtr;
+
+ optionPtr = objv[i];
+ valuePtr = objv[i + 1];
+
+ if (Tcl_GetIndexFromObj(interp, optionPtr, optionStrings, "option",
+ TCL_EXACT, &index) != TCL_OK) {
+ return TCL_ERROR;
}
- else if (strncmp(argv[i], "-parent", len)==0) {
- if (v==argc) {goto arg_missing;}
-
- parent=Tk_NameToWindow(interp, argv[v], Tk_MainWindow(interp));
- if (parent == NULL) {
- return TCL_ERROR;
- }
+ if (i + 1 == objc) {
+ string = Tcl_GetStringFromObj(optionPtr, NULL);
+ Tcl_AppendResult(interp, "value for \"", string, "\" missing",
+ (char *) NULL);
+ return TCL_ERROR;
}
- else if (strncmp(argv[i], "-title", len)==0) {
- if (v==argc) {goto arg_missing;}
- custData.title = argv[v];
- }
- else {
- Tcl_AppendResult(interp, "unknown option \"",
- argv[i], "\", must be -initialcolor, -parent or -title",
- NULL);
- return TCL_ERROR;
+ string = Tcl_GetStringFromObj(valuePtr, NULL);
+ switch ((enum options) index) {
+ case COLOR_INITIAL: {
+ XColor *colorPtr;
+
+ colorPtr = Tk_GetColor(interp, tkwin, string);
+ if (colorPtr == NULL) {
+ return TCL_ERROR;
+ }
+ chooseColor.rgbResult = RGB(colorPtr->red / 0x100,
+ colorPtr->green / 0x100, colorPtr->blue / 0x100);
+ break;
+ }
+ case COLOR_PARENT: {
+ parent = Tk_NameToWindow(interp, string, tkwin);
+ if (parent == NULL) {
+ return TCL_ERROR;
+ }
+ break;
+ }
+ case COLOR_TITLE: {
+ chooseColor.lCustData = (LPARAM) string;
+ break;
+ }
}
}
- if (Tk_WindowId(parent) == None) {
- Tk_MakeWindowExist(parent);
- }
+ Tk_MakeWindowExist(parent);
chooseColor.hwndOwner = Tk_GetHWND(Tk_WindowId(parent));
- if (colorStr != NULL) {
- colorPtr = Tk_GetColor(interp, Tk_MainWindow(interp), colorStr);
- if (!colorPtr) {
- return TCL_ERROR;
- }
- chooseColor.rgbResult = RGB((colorPtr->red/0x100),
- (colorPtr->green/0x100), (colorPtr->blue/0x100));
- }
-
- /*
- * 2. Popup the dialog
- */
-
oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
winCode = ChooseColor(&chooseColor);
(void) Tcl_SetServiceMode(oldMode);
@@ -278,6 +279,7 @@ Tk_ChooseColorCmd(clientData, interp, argc, argv)
/*
* 3. Process the result of the dialog
*/
+
if (winCode) {
/*
* User has selected a color
@@ -285,75 +287,64 @@ Tk_ChooseColorCmd(clientData, interp, argc, argv)
char result[100];
sprintf(result, "#%02x%02x%02x",
- GetRValue(chooseColor.rgbResult),
- GetGValue(chooseColor.rgbResult),
- GetBValue(chooseColor.rgbResult));
+ GetRValue(chooseColor.rgbResult),
+ GetGValue(chooseColor.rgbResult),
+ GetBValue(chooseColor.rgbResult));
Tcl_AppendResult(interp, result, NULL);
- tclCode = TCL_OK;
-
oldColor = chooseColor.rgbResult;
- } else {
- /*
- * User probably pressed Cancel, or an error occurred
- */
- tclCode = ProcessCDError(interp, CommDlgExtendedError(),
- chooseColor.hwndOwner);
- }
-
- if (colorPtr) {
- Tk_FreeColor(colorPtr);
}
-
- return tclCode;
-
- arg_missing:
- Tcl_AppendResult(interp, "value for \"", argv[argc-1], "\" missing",
- NULL);
- return TCL_ERROR;
+ return TCL_OK;
}
/*
- *----------------------------------------------------------------------
+ *-------------------------------------------------------------------------
*
* ColorDlgHookProc --
*
- * Gets called during the execution of the color dialog. It processes
- * the "interesting" messages that Windows send to the dialog.
+ * Provides special handling of messages for the Color common dialog
+ * box. Used to set the title when the dialog first appears.
*
* Results:
- * TRUE if the message has been processed, FALSE otherwise.
+ * The return value is 0 if the default dialog box procedure should
+ * handle the message, non-zero otherwise.
*
* Side effects:
- * Changes the title of the dialog window when it is popped up.
+ * Changes the title of the dialog window.
*
*----------------------------------------------------------------------
*/
-static UINT
-CALLBACK ColorDlgHookProc(hDlg, uMsg, wParam, lParam)
- HWND hDlg; /* Handle to the color dialog */
- UINT uMsg; /* Type of message */
- WPARAM wParam; /* word param, interpretation depends on uMsg*/
- LPARAM lParam; /* long param, interpretation depends on uMsg*/
+static UINT CALLBACK
+ColorDlgHookProc(hDlg, uMsg, wParam, lParam)
+ HWND hDlg; /* Handle to the color dialog. */
+ UINT uMsg; /* Type of message. */
+ WPARAM wParam; /* First message parameter. */
+ LPARAM lParam; /* Second message parameter. */
{
- CHOOSECOLOR * ccPtr;
- ChooseColorData * pCustData;
-
switch (uMsg) {
- case WM_INITDIALOG:
- /* Save the pointer to CHOOSECOLOR so that we can use it later */
- SetWindowLong(hDlg, DWL_USER, lParam);
-
- /* Set the title string of the dialog */
- ccPtr = (CHOOSECOLOR*)lParam;
- pCustData = (ChooseColorData*)(ccPtr->lCustData);
- if (pCustData->title && *(pCustData->title)) {
- SetWindowText(hDlg, (LPCSTR)pCustData->title);
- }
+ case WM_INITDIALOG: {
+ const char *title;
+ CHOOSECOLOR *ccPtr;
+ Tcl_DString ds;
- return TRUE;
- }
+ /*
+ * Set the title string of the dialog.
+ */
+ ccPtr = (CHOOSECOLOR *) lParam;
+ title = (const char *) ccPtr->lCustData;
+ if ((title != NULL) && (title[0] != '\0')) {
+ Tcl_UtfToExternalDString(NULL, title, -1, &ds);
+ SetWindowText(hDlg, (TCHAR *) Tcl_DStringValue(&ds));
+ Tcl_DStringFree(&ds);
+ }
+ if (debugFlag) {
+ debugInterp = (Tcl_Interp *) ccPtr->lpTemplateName;
+ Tcl_DoWhenIdle(SetTkDialog, (ClientData) hDlg);
+ }
+ return TRUE;
+ }
+ }
return FALSE;
}
@@ -371,21 +362,18 @@ CALLBACK ColorDlgHookProc(hDlg, uMsg, wParam, lParam)
*
* Side effects:
* A dialog window is created the first this procedure is called.
- * This window is not destroyed and will be reused the next time
- * the application invokes the "tk_getOpenFile" or
- * "tk_getSaveFile" command.
*
*----------------------------------------------------------------------
*/
int
-Tk_GetOpenFileCmd(clientData, interp, argc, argv)
+Tk_GetOpenFileObjCmd(clientData, interp, objc, objv)
ClientData clientData; /* Main window associated with interpreter. */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- return GetFileName(clientData, interp, argc, argv, OPEN_FILE);
+ return GetFileName(clientData, interp, objc, objv, 1);
}
/*
@@ -406,13 +394,13 @@ Tk_GetOpenFileCmd(clientData, interp, argc, argv)
*/
int
-Tk_GetSaveFileCmd(clientData, interp, argc, argv)
+Tk_GetSaveFileObjCmd(clientData, interp, objc, objv)
ClientData clientData; /* Main window associated with interpreter. */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- return GetFileName(clientData, interp, argc, argv, SAVE_FILE);
+ return GetFileName(clientData, interp, objc, objv, 0);
}
/*
@@ -432,41 +420,195 @@ Tk_GetSaveFileCmd(clientData, interp, argc, argv)
*/
static int
-GetFileName(clientData, interp, argc, argv, isOpen)
+GetFileName(clientData, interp, objc, objv, open)
ClientData clientData; /* Main window associated with interpreter. */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
- int isOpen; /* true if we should call GetOpenFileName(),
- * false if we should call GetSaveFileName() */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+ int open; /* 1 to call GetOpenFileName(), 0 to
+ * call GetSaveFileName(). */
{
- OPENFILENAME openFileName, *ofnPtr;
- int tclCode, winCode, oldMode;
- OpenFileData *custData;
- char buffer[MAX_PATH+1];
-
- ofnPtr = &openFileName;
+ OPENFILENAME ofn;
+ TCHAR file[MAX_PATH], savePath[MAX_PATH];
+ int result, winCode, oldMode, i;
+ char *extension, *filter, *title;
+ Tk_Window tkwin;
+ Tcl_DString utfFilterString, utfDirString;
+ Tcl_DString extString, filterString, dirString, titleString;
+ static char *optionStrings[] = {
+ "-defaultextension", "-filetypes", "-initialdir", "-initialfile",
+ "-parent", "-title", NULL
+ };
+ enum options {
+ FILE_DEFAULT, FILE_TYPES, FILE_INITDIR, FILE_INITFILE,
+ FILE_PARENT, FILE_TITLE
+ };
+
+ result = TCL_ERROR;
+ file[0] = '\0';
/*
- * 1. Parse the arguments.
+ * Parse the arguments.
*/
- if (ParseFileDlgArgs(interp, ofnPtr, argc, argv, isOpen) != TCL_OK) {
- return TCL_ERROR;
+
+ extension = NULL;
+ filter = NULL;
+ Tcl_DStringInit(&utfFilterString);
+ Tcl_DStringInit(&utfDirString);
+ tkwin = (Tk_Window) clientData;
+ title = NULL;
+
+ for (i = 1; i < objc; i += 2) {
+ int index;
+ char *string;
+ Tcl_Obj *optionPtr, *valuePtr;
+
+ optionPtr = objv[i];
+ valuePtr = objv[i + 1];
+
+ if (Tcl_GetIndexFromObj(interp, optionPtr, optionStrings, "option",
+ 0, &index) != TCL_OK) {
+ goto end;
+ }
+ if (i + 1 == objc) {
+ string = Tcl_GetStringFromObj(optionPtr, NULL);
+ Tcl_AppendResult(interp, "value for \"", string, "\" missing",
+ (char *) NULL);
+ goto end;
+ }
+
+ string = Tcl_GetStringFromObj(valuePtr, NULL);
+ switch ((enum options) index) {
+ case FILE_DEFAULT: {
+ if (string[0] == '.') {
+ string++;
+ }
+ extension = string;
+ break;
+ }
+ case FILE_TYPES: {
+ Tcl_DStringFree(&utfFilterString);
+ if (MakeFilter(interp, string, &utfFilterString) != TCL_OK) {
+ goto end;
+ }
+ filter = Tcl_DStringValue(&utfFilterString);
+ break;
+ }
+ case FILE_INITDIR: {
+ Tcl_DStringFree(&utfDirString);
+ if (Tcl_TranslateFileName(interp, string,
+ &utfDirString) == NULL) {
+ goto end;
+ }
+ break;
+ }
+ case FILE_INITFILE: {
+ Tcl_DString ds;
+
+ if (Tcl_TranslateFileName(interp, string, &ds) == NULL) {
+ goto end;
+ }
+ Tcl_UtfToExternal(NULL, NULL, Tcl_DStringValue(&ds),
+ Tcl_DStringLength(&ds), 0, NULL, (char *) file,
+ sizeof(file), NULL, NULL, NULL);
+ break;
+ }
+ case FILE_PARENT: {
+ tkwin = Tk_NameToWindow(interp, string, tkwin);
+ if (tkwin == NULL) {
+ goto end;
+ }
+ break;
+ }
+ case FILE_TITLE: {
+ title = string;
+ break;
+ }
+ }
+ }
+
+ if (filter == NULL) {
+ if (MakeFilter(interp, "", &utfFilterString) != TCL_OK) {
+ goto end;
+ }
+ }
+
+ Tk_MakeWindowExist(tkwin);
+
+ ofn.lStructSize = sizeof(ofn);
+ ofn.hwndOwner = Tk_GetHWND(Tk_WindowId(tkwin));
+ ofn.hInstance = (HINSTANCE) GetWindowLong(ofn.hwndOwner,
+ GWL_HINSTANCE);
+ ofn.lpstrFilter = NULL;
+ ofn.lpstrCustomFilter = NULL;
+ ofn.nMaxCustFilter = 0;
+ ofn.nFilterIndex = 0;
+ ofn.lpstrFile = (LPTSTR) file;
+ ofn.nMaxFile = MAX_PATH;
+ ofn.lpstrFileTitle = NULL;
+ ofn.nMaxFileTitle = 0;
+ ofn.lpstrInitialDir = NULL;
+ ofn.lpstrTitle = NULL;
+ ofn.Flags = OFN_HIDEREADONLY | OFN_PATHMUSTEXIST
+ | OFN_NOCHANGEDIR;
+ ofn.nFileOffset = 0;
+ ofn.nFileExtension = 0;
+ ofn.lpstrDefExt = NULL;
+ ofn.lpfnHook = OFNHookProc;
+ ofn.lCustData = (LPARAM) interp;
+ ofn.lpTemplateName = NULL;
+
+ if (LOBYTE(LOWORD(GetVersion())) >= 4) {
+ /*
+ * Use the "explorer" style file selection box on platforms that
+ * support it (Win95 and NT4.0 both have a major version number
+ * of 4).
+ */
+
+ ofn.Flags |= OFN_EXPLORER;
+ }
+
+ if (open != 0) {
+ ofn.Flags |= OFN_FILEMUSTEXIST;
+ } else {
+ ofn.Flags |= OFN_OVERWRITEPROMPT;
+ }
+
+ if (debugFlag != 0) {
+ ofn.Flags |= OFN_ENABLEHOOK;
+ }
+
+ if (extension != NULL) {
+ Tcl_UtfToExternalDString(NULL, extension, -1, &extString);
+ ofn.lpstrDefExt = (LPTSTR) Tcl_DStringValue(&extString);
+ }
+ Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&utfFilterString),
+ Tcl_DStringLength(&utfFilterString), &filterString);
+ ofn.lpstrFilter = (LPTSTR) Tcl_DStringValue(&filterString);
+
+ if (Tcl_DStringValue(&utfDirString)[0] != '\0') {
+ Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&utfDirString),
+ Tcl_DStringLength(&utfDirString), &dirString);
+ ofn.lpstrInitialDir = (LPTSTR) Tcl_DStringValue(&dirString);
+ }
+ if (title != NULL) {
+ Tcl_UtfToExternalDString(NULL, title, -1, &titleString);
+ ofn.lpstrTitle = (LPTSTR) Tcl_DStringValue(&titleString);
}
- custData = (OpenFileData*) ofnPtr->lCustData;
/*
- * 2. Call the common dialog function.
+ * Popup the dialog.
*/
+
+ GetCurrentDirectory(MAX_PATH, savePath);
oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
- GetCurrentDirectory(MAX_PATH+1, buffer);
- if (isOpen) {
- winCode = GetOpenFileName(ofnPtr);
+ if (open != 0) {
+ winCode = GetOpenFileName(&ofn);
} else {
- winCode = GetSaveFileName(ofnPtr);
+ winCode = GetSaveFileName(&ofn);
}
- SetCurrentDirectory(buffer);
- (void) Tcl_SetServiceMode(oldMode);
+ Tcl_SetServiceMode(oldMode);
+ SetCurrentDirectory(savePath);
/*
* Clear the interp result since anything may have happened during the
@@ -475,18 +617,16 @@ GetFileName(clientData, interp, argc, argv, isOpen)
Tcl_ResetResult(interp);
- if (ofnPtr->lpstrInitialDir != NULL) {
- ckfree((char*) ofnPtr->lpstrInitialDir);
- }
-
/*
- * 3. Process the results.
+ * Process the results.
*/
- if (winCode) {
+
+ if (winCode != 0) {
char *p;
- Tcl_ResetResult(interp);
+ Tcl_DString ds;
- for (p = custData->szFile; p && *p; p++) {
+ Tcl_ExternalToUtfDString(NULL, (char *) ofn.lpstrFile, -1, &ds);
+ for (p = Tcl_DStringValue(&ds); *p != '\0'; p++) {
/*
* Change the pathname to the Tcl "normalized" pathname, where
* back slashes are used instead of forward slashes
@@ -495,177 +635,78 @@ GetFileName(clientData, interp, argc, argv, isOpen)
*p = '/';
}
}
- Tcl_AppendResult(interp, custData->szFile, NULL);
- tclCode = TCL_OK;
- } else {
- tclCode = ProcessCDError(interp, CommDlgExtendedError(),
- ofnPtr->hwndOwner);
+ Tcl_AppendResult(interp, Tcl_DStringValue(&ds), NULL);
+ Tcl_DStringFree(&ds);
}
- if (custData) {
- ckfree((char*)custData);
+ if (ofn.lpstrTitle != NULL) {
+ Tcl_DStringFree(&titleString);
+ }
+ if (ofn.lpstrInitialDir != NULL) {
+ Tcl_DStringFree(&dirString);
}
- if (ofnPtr->lpstrFilter) {
- ckfree((char*)ofnPtr->lpstrFilter);
+ Tcl_DStringFree(&filterString);
+ if (ofn.lpstrDefExt != NULL) {
+ Tcl_DStringFree(&extString);
}
+ result = TCL_OK;
- return tclCode;
+ end:
+ Tcl_DStringFree(&utfDirString);
+ Tcl_DStringFree(&utfFilterString);
+
+ return result;
}
/*
- *----------------------------------------------------------------------
+ *-------------------------------------------------------------------------
*
- * ParseFileDlgArgs --
+ * OFNHookProc --
*
- * Parses the arguments passed to tk_getOpenFile and tk_getSaveFile.
+ * Hook procedure called only if debugging is turned on. Sets
+ * the "tk_dialog" variable when the dialog is ready to receive
+ * messages.
*
* Results:
- * A standard TCL return value.
+ * Returns 0 to allow default processing of messages to occur.
*
* Side effects:
- * The OPENFILENAME structure is initialized and modified according
- * to the arguments.
+ * None.
*
- *----------------------------------------------------------------------
+ *-------------------------------------------------------------------------
*/
-static int
-ParseFileDlgArgs(interp, ofnPtr, argc, argv, isOpen)
- Tcl_Interp * interp; /* Current interpreter. */
- OPENFILENAME *ofnPtr; /* Info about the file dialog */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
- int isOpen; /* true if we should call GetOpenFileName(),
- * false if we should call GetSaveFileName() */
+static UINT APIENTRY
+OFNHookProc(
+ HWND hdlg, // handle to child dialog window
+ UINT uMsg, // message identifier
+ WPARAM wParam, // message parameter
+ LPARAM lParam) // message parameter
{
- OpenFileData * custData;
- int i;
- Tk_Window parent = Tk_MainWindow(interp);
- int doneFilter = 0;
- int windowsMajorVersion;
- Tcl_DString buffer;
-
- custData = (OpenFileData*)ckalloc(sizeof(OpenFileData));
- custData->interp = interp;
- strcpy(custData->szFile, "");
-
- /* Fill in the OPENFILENAME structure to */
- ofnPtr->lStructSize = sizeof(OPENFILENAME);
- ofnPtr->hwndOwner = 0; /* filled in below */
- ofnPtr->lpstrFilter = NULL;
- ofnPtr->lpstrCustomFilter = NULL;
- ofnPtr->nMaxCustFilter = 0;
- ofnPtr->nFilterIndex = 0;
- ofnPtr->lpstrFile = custData->szFile;
- ofnPtr->nMaxFile = sizeof(custData->szFile);
- ofnPtr->lpstrFileTitle = NULL;
- ofnPtr->nMaxFileTitle = 0;
- ofnPtr->lpstrInitialDir = NULL;
- ofnPtr->lpstrTitle = NULL;
- ofnPtr->nFileOffset = 0;
- ofnPtr->nFileExtension = 0;
- ofnPtr->lpstrDefExt = NULL;
- ofnPtr->lpfnHook = NULL;
- ofnPtr->lCustData = (DWORD)custData;
- ofnPtr->lpTemplateName = NULL;
- ofnPtr->Flags = OFN_HIDEREADONLY | OFN_PATHMUSTEXIST;
-
- windowsMajorVersion = LOBYTE(LOWORD(GetVersion()));
- if (windowsMajorVersion >= 4) {
+ OPENFILENAME *ofnPtr;
+
+ if (uMsg == WM_INITDIALOG) {
+ SetWindowLong(hdlg, GWL_USERDATA, lParam);
+ } else if (uMsg == WM_WINDOWPOSCHANGED) {
/*
- * Use the "explorer" style file selection box on platforms that
- * support it (Win95 and NT4.0, both have a major version number
- * of 4)
+ * This message is delivered at the right time to both
+ * old-style and explorer-style hook procs to enable Tk
+ * to set the debug information. Unhooks itself so it
+ * won't set the debug information every time it gets a
+ * WM_WINDOWPOSCHANGED message.
*/
- ofnPtr->Flags |= OFN_EXPLORER;
- }
-
- if (isOpen) {
- ofnPtr->Flags |= OFN_FILEMUSTEXIST;
- } else {
- ofnPtr->Flags |= OFN_OVERWRITEPROMPT;
- }
-
- for (i=1; i<argc; i+=2) {
- int v = i+1;
- int len = strlen(argv[i]);
-
- if (strncmp(argv[i], "-defaultextension", len)==0) {
- if (v==argc) {goto arg_missing;}
-
- ofnPtr->lpstrDefExt = argv[v];
- if (ofnPtr->lpstrDefExt[0] == '.') {
- /* Windows will insert the dot for us */
- ofnPtr->lpstrDefExt ++;
+ ofnPtr = (OPENFILENAME *) GetWindowLong(hdlg, GWL_USERDATA);
+ if (ofnPtr != NULL) {
+ if (ofnPtr->Flags & OFN_EXPLORER) {
+ hdlg = GetParent(hdlg);
}
+ debugInterp = (Tcl_Interp *) ofnPtr->lCustData;
+ Tcl_DoWhenIdle(SetTkDialog, (ClientData) hdlg);
+ SetWindowLong(hdlg, GWL_USERDATA, (LPARAM) NULL);
}
- else if (strncmp(argv[i], "-filetypes", len)==0) {
- if (v==argc) {goto arg_missing;}
-
- if (MakeFilter(interp, ofnPtr, argv[v]) != TCL_OK) {
- return TCL_ERROR;
- }
- doneFilter = 1;
- }
- else if (strncmp(argv[i], "-initialdir", len)==0) {
- if (v==argc) {goto arg_missing;}
-
- if (Tcl_TranslateFileName(interp, argv[v], &buffer) == NULL) {
- return TCL_ERROR;
- }
- ofnPtr->lpstrInitialDir = ckalloc(Tcl_DStringLength(&buffer)+1);
- strcpy((char*)ofnPtr->lpstrInitialDir, Tcl_DStringValue(&buffer));
- Tcl_DStringFree(&buffer);
- }
- else if (strncmp(argv[i], "-initialfile", len)==0) {
- if (v==argc) {goto arg_missing;}
-
- if (Tcl_TranslateFileName(interp, argv[v], &buffer) == NULL) {
- return TCL_ERROR;
- }
- strcpy(ofnPtr->lpstrFile, Tcl_DStringValue(&buffer));
- Tcl_DStringFree(&buffer);
- }
- else if (strncmp(argv[i], "-parent", len)==0) {
- if (v==argc) {goto arg_missing;}
-
- parent=Tk_NameToWindow(interp, argv[v], Tk_MainWindow(interp));
- if (parent == NULL) {
- return TCL_ERROR;
- }
- }
- else if (strncmp(argv[i], "-title", len)==0) {
- if (v==argc) {goto arg_missing;}
-
- ofnPtr->lpstrTitle = argv[v];
- }
- else {
- Tcl_AppendResult(interp, "unknown option \"",
- argv[i], "\", must be -defaultextension, ",
- "-filetypes, -initialdir, -initialfile, -parent or -title",
- NULL);
- return TCL_ERROR;
- }
- }
-
- if (!doneFilter) {
- if (MakeFilter(interp, ofnPtr, "") != TCL_OK) {
- return TCL_ERROR;
- }
- }
-
- if (Tk_WindowId(parent) == None) {
- Tk_MakeWindowExist(parent);
}
- ofnPtr->hwndOwner = Tk_GetHWND(Tk_WindowId(parent));
-
- return TCL_OK;
-
- arg_missing:
- Tcl_AppendResult(interp, "value for \"", argv[argc-1], "\" missing",
- NULL);
- return TCL_ERROR;
+ return 0;
}
/*
@@ -684,10 +725,11 @@ ParseFileDlgArgs(interp, ofnPtr, argc, argv, isOpen)
*
*----------------------------------------------------------------------
*/
-static int MakeFilter(interp, ofnPtr, string)
+static int
+MakeFilter(interp, string, dsPtr)
Tcl_Interp *interp; /* Current interpreter. */
- OPENFILENAME *ofnPtr; /* Info about the file dialog */
char *string; /* String value of the -filetypes option */
+ Tcl_DString *dsPtr; /* Filled with windows filter string. */
{
char *filterStr;
char *p;
@@ -702,7 +744,7 @@ static int MakeFilter(interp, ofnPtr, string)
if (flist.filters == NULL) {
/*
- * Use "All Files (*.*) as the default filter is none is specified
+ * Use "All Files (*.*) as the default filter if none is specified
*/
char *defaultFilter = "All Files (*.*)";
@@ -790,10 +832,8 @@ static int MakeFilter(interp, ofnPtr, string)
*p = '\0';
}
- if (ofnPtr->lpstrFilter != NULL) {
- ckfree((char*)ofnPtr->lpstrFilter);
- }
- ofnPtr->lpstrFilter = filterStr;
+ Tcl_DStringAppend(dsPtr, filterStr, p - filterStr);
+ ckfree((char *) filterStr);
TkFreeFileFilters(&flist);
return TCL_OK;
@@ -802,249 +842,577 @@ static int MakeFilter(interp, ofnPtr, string)
/*
*----------------------------------------------------------------------
*
- * Tk_MessageBoxCmd --
+ * Tk_ChooseDirectoryObjCmd --
*
- * This procedure implements the MessageBox window for the
- * Windows platform. See the user documentation for details on what
- * it does.
+ * This procedure implements the "tk_chooseDirectory" dialog box
+ * for the Windows platform. See the user documentation for details
+ * on what it does.
*
* Results:
* See user documentation.
*
* Side effects:
- * None. The MessageBox window will be destroy before this procedure
- * returns.
+ * A modal dialog window is created. Tcl_SetServiceMode() is
+ * called to allow background events to be processed
*
*----------------------------------------------------------------------
*/
int
-Tk_MessageBoxCmd(clientData, interp, argc, argv)
+Tk_ChooseDirectoryObjCmd(clientData, interp, objc, objv)
ClientData clientData; /* Main window associated with interpreter. */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- int flags;
- Tk_Window parent = Tk_MainWindow(interp);
- HWND hWnd;
- char *message = "";
- char *title = "";
- int icon = MB_ICONINFORMATION;
- int type = MB_OK;
- int i, j;
- char *result;
- int code, oldMode;
- char *defaultBtn = NULL;
- int defaultBtnIdx = -1;
-
- for (i=1; i<argc; i+=2) {
- int v = i+1;
- int len = strlen(argv[i]);
-
- if (strncmp(argv[i], "-default", len)==0) {
- if (v==argc) {goto arg_missing;}
-
- defaultBtn = argv[v];
+ OPENFILENAME ofn;
+ TCHAR path[MAX_PATH], savePath[MAX_PATH];
+ ChooseDir cd;
+ int result, mustExist, code, mode, i;
+ Tk_Window tkwin;
+ char *utfTitle;
+ Tcl_DString utfDirString;
+ Tcl_DString titleString, dirString;
+ static char *optionStrings[] = {
+ "-initialdir", "-mustexist", "-parent", "-title",
+ NULL
+ };
+ enum options {
+ DIR_INITIAL, DIR_EXIST, DIR_PARENT, FILE_TITLE
+ };
+
+ if (WM_LBSELCHANGED == 0) {
+ WM_LBSELCHANGED = RegisterWindowMessage(LBSELCHSTRING);
+ }
+
+ result = TCL_ERROR;
+ path[0] = '\0';
+
+ Tcl_DStringInit(&utfDirString);
+ mustExist = 0;
+ tkwin = (Tk_Window) clientData;
+ utfTitle = NULL;
+
+ for (i = 1; i < objc; i += 2) {
+ int index;
+ char *string;
+ Tcl_Obj *optionPtr, *valuePtr;
+
+ optionPtr = objv[i];
+ valuePtr = objv[i + 1];
+
+ if (Tcl_GetIndexFromObj(interp, optionPtr, optionStrings, "option",
+ 0, &index) != TCL_OK) {
+ goto cleanup;
+ }
+ if (i + 1 == objc) {
+ string = Tcl_GetStringFromObj(optionPtr, NULL);
+ Tcl_AppendResult(interp, "value for \"", string, "\" missing",
+ (char *) NULL);
+ goto cleanup;
}
- else if (strncmp(argv[i], "-icon", len)==0) {
- if (v==argc) {goto arg_missing;}
- if (strcmp(argv[v], "error") == 0) {
- icon = MB_ICONERROR;
+ string = Tcl_GetStringFromObj(valuePtr, NULL);
+ switch ((enum options) index) {
+ case DIR_INITIAL: {
+ Tcl_DStringFree(&utfDirString);
+ if (Tcl_TranslateFileName(interp, string,
+ &utfDirString) == NULL) {
+ goto cleanup;
+ }
+ break;
}
- else if (strcmp(argv[v], "info") == 0) {
- icon = MB_ICONINFORMATION;
+ case DIR_EXIST: {
+ if (Tcl_GetBooleanFromObj(interp, valuePtr, &mustExist) != TCL_OK) {
+ goto cleanup;
+ }
+ break;
}
- else if (strcmp(argv[v], "question") == 0) {
- icon = MB_ICONQUESTION;
+ case DIR_PARENT: {
+ tkwin = Tk_NameToWindow(interp, string, tkwin);
+ if (tkwin == NULL) {
+ goto cleanup;
+ }
+ break;
}
- else if (strcmp(argv[v], "warning") == 0) {
- icon = MB_ICONWARNING;
+ case FILE_TITLE: {
+ utfTitle = string;
+ break;
}
- else {
- Tcl_AppendResult(interp, "invalid icon \"", argv[v],
- "\", must be error, info, question or warning", NULL);
- return TCL_ERROR;
+ }
+ }
+
+ Tk_MakeWindowExist(tkwin);
+
+ cd.interp = interp;
+
+ ofn.lStructSize = sizeof(ofn);
+ ofn.hwndOwner = Tk_GetHWND(Tk_WindowId(tkwin));
+ ofn.hInstance = (HINSTANCE) GetWindowLong(ofn.hwndOwner,
+ GWL_HINSTANCE);
+ ofn.lpstrFilter = NULL;
+ ofn.lpstrCustomFilter = NULL;
+ ofn.nMaxCustFilter = 0;
+ ofn.nFilterIndex = 0;
+ ofn.lpstrFile = NULL; //(TCHAR *) path;
+ ofn.nMaxFile = MAX_PATH;
+ ofn.lpstrFileTitle = NULL;
+ ofn.nMaxFileTitle = 0;
+ ofn.lpstrInitialDir = NULL;
+ ofn.lpstrTitle = NULL;
+ ofn.Flags = OFN_HIDEREADONLY
+ | OFN_ENABLEHOOK | OFN_ENABLETEMPLATE;
+ ofn.nFileOffset = 0;
+ ofn.nFileExtension = 0;
+ ofn.lpstrDefExt = NULL;
+ ofn.lCustData = (LPARAM) &cd;
+ ofn.lpfnHook = ChooseDirectoryHookProc;
+ ofn.lpTemplateName = MAKEINTRESOURCE(FILEOPENORD);
+
+ if (Tcl_DStringValue(&utfDirString)[0] != '\0') {
+ Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&utfDirString),
+ Tcl_DStringLength(&utfDirString), &dirString);
+ ofn.lpstrInitialDir = (LPTSTR) Tcl_DStringValue(&dirString);
+ }
+ if (mustExist) {
+ ofn.Flags |= OFN_PATHMUSTEXIST;
+ }
+ if (utfTitle != NULL) {
+ Tcl_UtfToExternalDString(NULL, utfTitle, -1, &titleString);
+ ofn.lpstrTitle = (LPTSTR) Tcl_DStringValue(&titleString);
+ }
+
+ /*
+ * Display dialog. The choose directory dialog doesn't preserve the
+ * current directory, so it must be saved and restored here.
+ */
+
+ GetCurrentDirectory(MAX_PATH, savePath);
+ mode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
+ code = GetOpenFileName(&ofn);
+ Tcl_SetServiceMode(mode);
+ SetCurrentDirectory(savePath);
+
+ Tcl_ResetResult(interp);
+ if (code != 0) {
+ /*
+ * Change the pathname to the Tcl "normalized" pathname, where
+ * back slashes are used instead of forward slashes
+ */
+
+ char *p;
+ Tcl_DString ds;
+
+ Tcl_ExternalToUtfDString(NULL, (char *) cd.path, -1, &ds);
+ for (p = Tcl_DStringValue(&ds); *p != '\0'; p++) {
+ if (*p == '\\') {
+ *p = '/';
}
}
- else if (strncmp(argv[i], "-message", len)==0) {
- if (v==argc) {goto arg_missing;}
+ Tcl_AppendResult(interp, Tcl_DStringValue(&ds), NULL);
+ Tcl_DStringFree(&ds);
+ }
+
+ if (ofn.lpstrTitle != NULL) {
+ Tcl_DStringFree(&titleString);
+ }
+ if (ofn.lpstrInitialDir != NULL) {
+ Tcl_DStringFree(&dirString);
+ }
+ result = TCL_OK;
- message = argv[v];
+ cleanup:
+ Tcl_DStringFree(&utfDirString);
+
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ChooseDirectoryHookProc --
+ *
+ * Hook procedure called by the ChooseDirectory dialog to modify
+ * its default behavior. The ChooseDirectory dialog is really an
+ * OpenFile dialog with certain controls rearranged and certain
+ * behaviors changed. For instance, typing a name in the
+ * ChooseDirectory dialog selects a directory, rather than
+ * selecting a file.
+ *
+ * Results:
+ * Returns 0 to allow default processing of message, or 1 to
+ * tell default dialog procedure not to process the message.
+ *
+ * Side effects:
+ * A dialog window is created the first this procedure is called.
+ * This window is not destroyed and will be reused the next time
+ * the application invokes the "tk_getOpenFile" or
+ * "tk_getSaveFile" command.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static UINT APIENTRY
+ChooseDirectoryHookProc(
+ HWND hwnd,
+ UINT message,
+ WPARAM wParam,
+ LPARAM lParam)
+{
+ OPENFILENAME *ofnPtr;
+
+ /*
+ * GWL_USERDATA keeps track of ofnPtr.
+ */
+
+ ofnPtr = (OPENFILENAME *) GetWindowLong(hwnd, GWL_USERDATA);
+
+ if (message == WM_INITDIALOG) {
+ ChooseDir *cdPtr;
+
+ SetWindowLong(hwnd, GWL_USERDATA, lParam);
+ ofnPtr = (OPENFILENAME *) lParam;
+ cdPtr = (ChooseDir *) ofnPtr->lCustData;
+ cdPtr->lastCtrl = 0;
+ cdPtr->lastIdx = 1000;
+ cdPtr->path[0] = '\0';
+
+ if (ofnPtr->lpstrInitialDir == NULL) {
+ GetCurrentDirectory(MAX_PATH, cdPtr->path);
+ } else {
+ lstrcpy(cdPtr->path, ofnPtr->lpstrInitialDir);
}
- else if (strncmp(argv[i], "-parent", len)==0) {
- if (v==argc) {goto arg_missing;}
+ SetDlgItemText(hwnd, edt10, cdPtr->path);
+ SendDlgItemMessage(hwnd, edt10, EM_SETSEL, 0, -1);
+ if (debugFlag) {
+ debugInterp = cdPtr->interp;
+ Tcl_DoWhenIdle(SetTkDialog, (ClientData) hwnd);
+ }
+ return 0;
+ }
+ if (ofnPtr == NULL) {
+ return 0;
+ }
- parent=Tk_NameToWindow(interp, argv[v], Tk_MainWindow(interp));
- if (parent == NULL) {
- return TCL_ERROR;
+ if (message == WM_LBSELCHANGED) {
+ /*
+ * Called when double-clicking on directory.
+ * If directory wasn't already open, browse that directory.
+ * If directory was already open, return selected directory.
+ */
+
+ ChooseDir *cdPtr;
+ int idCtrl, thisItem;
+
+ idCtrl = (int) wParam;
+ thisItem = LOWORD(lParam);
+ cdPtr = (ChooseDir *) ofnPtr->lCustData;
+
+ GetCurrentDirectory(MAX_PATH, cdPtr->path);
+ if (idCtrl == lst2) {
+ if ((cdPtr->lastIdx < 0) || (cdPtr->lastIdx == thisItem)) {
+ EndDialog(hwnd, IDOK);
+ return 1;
}
+ cdPtr->lastIdx = thisItem;
}
- else if (strncmp(argv[i], "-title", len)==0) {
- if (v==argc) {goto arg_missing;}
+ SetDlgItemText(hwnd, edt10, cdPtr->path);
+ SendDlgItemMessage(hwnd, edt10, EM_SETSEL, 0, -1);
+ } else if (message == WM_COMMAND) {
+ ChooseDir *cdPtr;
+ int idCtrl, notifyCode;
+
+ idCtrl = LOWORD(wParam);
+ notifyCode = HIWORD(wParam);
+ cdPtr = (ChooseDir *) ofnPtr->lCustData;
- title = argv[v];
+ if ((idCtrl != IDOK) || (notifyCode != BN_CLICKED)) {
+ /*
+ * OK Button wasn't clicked. Do the default.
+ */
+
+ if ((idCtrl == lst2) || (idCtrl == edt10)) {
+ cdPtr->lastCtrl = idCtrl;
+ }
+ return 0;
}
- else if (strncmp(argv[i], "-type", len)==0) {
- int found = 0;
- if (v==argc) {goto arg_missing;}
+ /*
+ * Dialogs also get the message that OK was clicked when Enter
+ * is pressed in some other control. Find out what window
+ * we were really in when we got the supposed "OK", because the
+ * behavior is different.
+ */
+
+ if (cdPtr->lastCtrl == edt10) {
+ /*
+ * Hit Enter or clicked OK while typing a directory name in the
+ * edit control.
+ * If it's a new name, try to go to that directory.
+ * If the name hasn't changed since last time, return selected
+ * directory.
+ */
+
+ int changed;
+ TCHAR tmp[MAX_PATH];
+
+ if (GetDlgItemText(hwnd, edt10, tmp, MAX_PATH) == 0) {
+ return 0;
+ }
+
+ changed = lstrcmp(cdPtr->path, tmp);
+ lstrcpy(cdPtr->path, tmp);
+
+ if (SetCurrentDirectory(cdPtr->path) == 0) {
+ /*
+ * Non-existent directory.
+ */
- for (j=0; j<NUM_TYPES; j++) {
- if (strcmp(argv[v], msgTypeInfo[j].name) == 0) {
- type = msgTypeInfo[j].type;
- found = 1;
- break;
+ if (ofnPtr->Flags & OFN_PATHMUSTEXIST) {
+ /*
+ * Directory must exist. Complain, then rehighlight text.
+ */
+
+ wsprintf(tmp, _T("Cannot change directory to \"%.200s\"."),
+ cdPtr->path);
+ MessageBox(hwnd, tmp, NULL, MB_OK);
+ SendDlgItemMessage(hwnd, edt10, EM_SETSEL, 0, -1);
+ return 0;
+ }
+ if (changed) {
+ /*
+ * Directory was invalid, but we want to keep displaying
+ * this name. Don't update the listbox that displays the
+ * current directory heirarchy, or it'll erase the name.
+ */
+
+ SendDlgItemMessage(hwnd, edt10, EM_SETSEL, 0, -1);
+ return 0;
}
}
- if (!found) {
- Tcl_AppendResult(interp, "invalid message box type \"",
- argv[v], "\", must be abortretryignore, ok, ",
- "okcancel, retrycancel, yesno or yesnocancel", NULL);
- return TCL_ERROR;
+ if (changed == 0) {
+ /*
+ * Name hasn't changed since the last time we hit return
+ * or double-clicked on a directory, so return this.
+ */
+
+ EndDialog(hwnd, IDOK);
+ return 1;
+ }
+
+ cdPtr->lastCtrl = IDOK;
+
+ /*
+ * The following is the magic code, determined by running
+ * Spy++ on some other directory chooser, that it takes to
+ * get this dialog to update the listbox to display the
+ * current directory.
+ */
+
+ SetDlgItemText(hwnd, edt1, cdPtr->path);
+ SendMessage(hwnd, WM_COMMAND, (WPARAM) MAKELONG(cmb2, 0x8003),
+ (LPARAM) GetDlgItem(hwnd, cmb2));
+ return 0;
+ } else if (idCtrl == lst2) {
+ /*
+ * Enter key was pressed while in listbox.
+ * If it's a new directory, allow default behavior to open dir.
+ * If the directory hasn't changed, return selected directory.
+ */
+
+ int thisItem;
+
+ thisItem = (int) SendDlgItemMessage(hwnd, lst2, LB_GETCURSEL, 0, 0);
+ if (cdPtr->lastIdx == thisItem) {
+ GetCurrentDirectory(MAX_PATH, cdPtr->path);
+ EndDialog(hwnd, IDOK);
+ return 1;
}
+ } else if (idCtrl == IDOK) {
+ /*
+ * The OK button was clicked. Return the path currently specified
+ * in the listbox.
+ *
+ * The directory has not yet been changed to the one specified in
+ * the listbox. Returning 0 allows the default dialog proc to
+ * change the directory to the one specified in the listbox and
+ * then causes it to send a WM_LBSELCHANGED back to the hook proc.
+ * When we get that message, we will record the current directory
+ * and then quit.
+ */
+
+ cdPtr->lastIdx = -1;
+ }
+ }
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_MessageBoxObjCmd --
+ *
+ * This procedure implements the MessageBox window for the
+ * Windows platform. See the user documentation for details on what
+ * it does.
+ *
+ * Results:
+ * See user documentation.
+ *
+ * Side effects:
+ * None. The MessageBox window will be destroy before this procedure
+ * returns.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_MessageBoxObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Main window associated with interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ Tk_Window tkwin, parent;
+ HWND hWnd;
+ char *message, *title;
+ int defaultBtn, icon, type;
+ int i, oldMode, flags, winCode;
+ Tcl_DString messageString, titleString;
+ static char *optionStrings[] = {
+ "-default", "-icon", "-message", "-parent",
+ "-title", "-type", NULL
+ };
+ enum options {
+ MSG_DEFAULT, MSG_ICON, MSG_MESSAGE, MSG_PARENT,
+ MSG_TITLE, MSG_TYPE
+ };
+
+ tkwin = (Tk_Window) clientData;
+
+ defaultBtn = -1;
+ icon = MB_ICONINFORMATION;
+ message = NULL;
+ parent = tkwin;
+ title = NULL;
+ type = MB_OK;
+
+ for (i = 1; i < objc; i += 2) {
+ int index;
+ char *string;
+ Tcl_Obj *optionPtr, *valuePtr;
+
+ optionPtr = objv[i];
+ valuePtr = objv[i + 1];
+
+ if (Tcl_GetIndexFromObj(interp, optionPtr, optionStrings, "option",
+ TCL_EXACT, &index) != TCL_OK) {
+ return TCL_ERROR;
}
- else {
- Tcl_AppendResult(interp, "unknown option \"",
- argv[i], "\", must be -default, -icon, ",
- "-message, -parent, -title or -type", NULL);
+ if (i + 1 == objc) {
+ string = Tcl_GetStringFromObj(optionPtr, NULL);
+ Tcl_AppendResult(interp, "value for \"", string, "\" missing",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ string = Tcl_GetStringFromObj(valuePtr, NULL);
+ switch ((enum options) index) {
+ case MSG_DEFAULT:
+ defaultBtn = TkFindStateNumObj(interp, optionPtr, buttonMap,
+ valuePtr);
+ if (defaultBtn < 0) {
+ return TCL_ERROR;
+ }
+ break;
+
+ case MSG_ICON:
+ icon = TkFindStateNumObj(interp, optionPtr, iconMap, valuePtr);
+ if (icon < 0) {
+ return TCL_ERROR;
+ }
+ break;
+
+ case MSG_MESSAGE:
+ message = string;
+ break;
+
+ case MSG_PARENT:
+ parent = Tk_NameToWindow(interp, string, tkwin);
+ if (parent == NULL) {
+ return TCL_ERROR;
+ }
+ break;
+
+ case MSG_TITLE:
+ title = string;
+ break;
+
+ case MSG_TYPE:
+ type = TkFindStateNumObj(interp, optionPtr, typeMap, valuePtr);
+ if (type < 0) {
return TCL_ERROR;
+ }
+ break;
+
}
}
- /* Make sure we have a valid hWnd to act as the parent of this message box
- */
- if (Tk_WindowId(parent) == None) {
- Tk_MakeWindowExist(parent);
- }
+ Tk_MakeWindowExist(parent);
hWnd = Tk_GetHWND(Tk_WindowId(parent));
- if (defaultBtn != NULL) {
- for (i=0; i<NUM_TYPES; i++) {
- if (type == msgTypeInfo[i].type) {
- for (j=0; j<msgTypeInfo[i].numButtons; j++) {
- if (strcmp(defaultBtn, msgTypeInfo[i].btnNames[j])==0) {
- defaultBtnIdx = j;
+ flags = 0;
+ if (defaultBtn >= 0) {
+ int defaultBtnIdx;
+
+ defaultBtnIdx = -1;
+ for (i = 0; i < NUM_TYPES; i++) {
+ if (type == allowedTypes[i].type) {
+ int j;
+
+ for (j = 0; j < 3; j++) {
+ if (allowedTypes[i].btnIds[j] == defaultBtn) {
+ defaultBtnIdx = j;
break;
}
}
if (defaultBtnIdx < 0) {
Tcl_AppendResult(interp, "invalid default button \"",
- defaultBtn, "\"", NULL);
+ TkFindStateString(buttonMap, defaultBtn),
+ "\"", NULL);
return TCL_ERROR;
}
break;
}
}
-
- switch (defaultBtnIdx) {
- case 0: flags = MB_DEFBUTTON1; break;
- case 1: flags = MB_DEFBUTTON2; break;
- case 2: flags = MB_DEFBUTTON3; break;
- case 3: flags = MB_DEFBUTTON4; break;
- }
- } else {
- flags = 0;
+ flags = buttonFlagMap[defaultBtnIdx];
}
- flags |= icon | type;
+ flags |= icon | type | MB_SYSTEMMODAL;
+
+ Tcl_UtfToExternalDString(NULL, message, -1, &messageString);
+ Tcl_UtfToExternalDString(NULL, title, -1, &titleString);
+
oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
- code = MessageBox(hWnd, message, title, flags|MB_SYSTEMMODAL);
+ winCode = MessageBox(hWnd, Tcl_DStringValue(&messageString),
+ Tcl_DStringValue(&titleString), flags);
(void) Tcl_SetServiceMode(oldMode);
- switch (code) {
- case IDABORT: result = "abort"; break;
- case IDCANCEL: result = "cancel"; break;
- case IDIGNORE: result = "ignore"; break;
- case IDNO: result = "no"; break;
- case IDOK: result = "ok"; break;
- case IDRETRY: result = "retry"; break;
- case IDYES: result = "yes"; break;
- default: result = "";
- }
-
- /*
- * When we come to here interp->result may have been changed by some
- * background scripts. Call Tcl_SetResult() to make sure that any stuff
- * lingering in interp->result will not appear in the result of
- * this command.
- */
+ Tcl_DStringFree(&messageString);
+ Tcl_DStringFree(&titleString);
- Tcl_SetResult(interp, result, TCL_STATIC);
+ Tcl_SetResult(interp, TkFindStateString(buttonMap, winCode), TCL_STATIC);
return TCL_OK;
-
- arg_missing:
- Tcl_AppendResult(interp, "value for \"", argv[argc-1], "\" missing",
- NULL);
- return TCL_ERROR;
}
-
-/*
- *----------------------------------------------------------------------
- *
- * ProcessCDError --
- *
- * This procedure gets called if a Windows-specific error message
- * has occurred during the execution of a common dialog or the
- * user has pressed the CANCEL button.
- *
- * Results:
- * If an error has indeed happened, returns a standard TCL result
- * that reports the error code in string format. If the user has
- * pressed the CANCEL button (dwErrorCode == 0), resets
- * interp->result to the empty string.
- *
- * Side effects:
- * interp->result is changed.
- *
- *----------------------------------------------------------------------
- */
-static int ProcessCDError(interp, dwErrorCode, hWnd)
- Tcl_Interp * interp; /* Current interpreter. */
- DWORD dwErrorCode; /* The Windows-specific error code */
- HWND hWnd; /* window in which the error happened*/
-{
- char *string;
- Tcl_ResetResult(interp);
+static void
+SetTkDialog(ClientData clientData)
+{
+ char buf[32];
+ HWND hwnd;
- switch(dwErrorCode) {
- case 0: /* User has hit CANCEL */
- return TCL_OK;
-
- case CDERR_DIALOGFAILURE: string="CDERR_DIALOGFAILURE"; break;
- case CDERR_STRUCTSIZE: string="CDERR_STRUCTSIZE"; break;
- case CDERR_INITIALIZATION: string="CDERR_INITIALIZATION"; break;
- case CDERR_NOTEMPLATE: string="CDERR_NOTEMPLATE"; break;
- case CDERR_NOHINSTANCE: string="CDERR_NOHINSTANCE"; break;
- case CDERR_LOADSTRFAILURE: string="CDERR_LOADSTRFAILURE"; break;
- case CDERR_FINDRESFAILURE: string="CDERR_FINDRESFAILURE"; break;
- case CDERR_LOADRESFAILURE: string="CDERR_LOADRESFAILURE"; break;
- case CDERR_LOCKRESFAILURE: string="CDERR_LOCKRESFAILURE"; break;
- case CDERR_MEMALLOCFAILURE: string="CDERR_MEMALLOCFAILURE"; break;
- case CDERR_MEMLOCKFAILURE: string="CDERR_MEMLOCKFAILURE"; break;
- case CDERR_NOHOOK: string="CDERR_NOHOOK"; break;
- case PDERR_SETUPFAILURE: string="PDERR_SETUPFAILURE"; break;
- case PDERR_PARSEFAILURE: string="PDERR_PARSEFAILURE"; break;
- case PDERR_RETDEFFAILURE: string="PDERR_RETDEFFAILURE"; break;
- case PDERR_LOADDRVFAILURE: string="PDERR_LOADDRVFAILURE"; break;
- case PDERR_GETDEVMODEFAIL: string="PDERR_GETDEVMODEFAIL"; break;
- case PDERR_INITFAILURE: string="PDERR_INITFAILURE"; break;
- case PDERR_NODEVICES: string="PDERR_NODEVICES"; break;
- case PDERR_NODEFAULTPRN: string="PDERR_NODEFAULTPRN"; break;
- case PDERR_DNDMMISMATCH: string="PDERR_DNDMMISMATCH"; break;
- case PDERR_CREATEICFAILURE: string="PDERR_CREATEICFAILURE"; break;
- case PDERR_PRINTERNOTFOUND: string="PDERR_PRINTERNOTFOUND"; break;
- case CFERR_NOFONTS: string="CFERR_NOFONTS"; break;
- case FNERR_SUBCLASSFAILURE: string="FNERR_SUBCLASSFAILURE"; break;
- case FNERR_INVALIDFILENAME: string="FNERR_INVALIDFILENAME"; break;
- case FNERR_BUFFERTOOSMALL: string="FNERR_BUFFERTOOSMALL"; break;
-
- default:
- string="unknown error";
- }
+ hwnd = (HWND) clientData;
- Tcl_AppendResult(interp, "Win32 internal error: ", string, NULL);
- return TCL_ERROR;
+ sprintf(buf, "0x%08x", hwnd);
+ Tcl_SetVar(debugInterp, "tk_dialog", buf, TCL_GLOBAL_ONLY);
}
diff --git a/win/tkWinEmbed.c b/win/tkWinEmbed.c
index 0dc4036..1e66219 100644
--- a/win/tkWinEmbed.c
+++ b/win/tkWinEmbed.c
@@ -6,12 +6,12 @@
* one application can use as its main window an internal window from
* another application).
*
- * Copyright (c) 1996 Sun Microsystems, Inc.
+ * Copyright (c) 1996-1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * SCCS: @(#) tkWinEmbed.c 1.20 97/11/05 17:47:09;
+ * SCCS: @(#) tkWinEmbed.c 1.21 97/11/07 21:59:08;
*/
#include "tkWinInt.h"
@@ -126,7 +126,7 @@ TkpTestembedCmd(clientData, interp, argc, argv)
* The return value is normally TCL_OK. If an error occurred (such as
* if the argument does not identify a legal Windows window handle),
* the return value is TCL_ERROR and an error message is left in the
- * interp->result if interp is not NULL.
+ * the interp's result if interp is not NULL.
*
* Side effects:
* None.
@@ -159,7 +159,8 @@ TkpUseWindow(interp, tkwin, string)
/*
* Check if the window is a valid handle. If it is invalid, return
- * TCL_ERROR and potentially leave an error message in interp->result.
+ * TCL_ERROR and potentially leave an error message in the interp's
+ * result.
*/
if (!IsWindow(hwnd)) {
diff --git a/win/tkWinFont.c b/win/tkWinFont.c
index c1d5161..d8e1647 100644
--- a/win/tkWinFont.c
+++ b/win/tkWinFont.c
@@ -10,28 +10,157 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * SCCS: @(#) tkWinFont.c 1.20 97/05/14 15:45:30
+ * SCCS: @(#) tkWinFont.c 1.29 98/02/04 15:55:35
*/
#include "tkWinInt.h"
#include "tkFont.h"
/*
- * The following structure represents Windows' implementation of a font.
+ * The following structure represents a font family. It is assumed that
+ * all screen fonts constructed from the same "font family" share certain
+ * properties; all screen fonts with the same "font family" point to a
+ * shared instance of this structure. The most important shared property
+ * is the character existence metrics, used to determine if a screen font
+ * can display a given Unicode character.
+ *
+ * Under Windows, a "font family" is uniquely identified by its face name.
*/
+#define FONTMAP_SHIFT 10
+
+#define FONTMAP_PAGES (1 << (sizeof(Tcl_UniChar)*8 - FONTMAP_SHIFT))
+#define FONTMAP_BITSPERPAGE (1 << FONTMAP_SHIFT)
+
+typedef struct FontFamily {
+ struct FontFamily *nextPtr; /* Next in list of all known font families. */
+ int refCount; /* How many SubFonts are referring to this
+ * FontFamily. When the refCount drops to
+ * zero, this FontFamily may be freed. */
+ /*
+ * Key.
+ */
+
+ Tk_Uid faceName; /* Face name key for this FontFamily. */
+
+ /*
+ * Derived properties.
+ */
+
+ Tcl_Encoding encoding; /* Encoding for this font family. */
+ int isSymbolFont; /* Non-zero if this is a symbol font. */
+ int isWideFont; /* 1 if this is a double-byte font, 0
+ * otherwise. */
+ BOOL (WINAPI *textOutProc)(HDC, int, int, TCHAR *, int);
+ /* The procedure to use to draw text after
+ * it has been converted from UTF-8 to the
+ * encoding of this font. */
+ BOOL (WINAPI *getTextExtentPointProc)(HDC, TCHAR *, int, LPSIZE);
+ /* The procedure to use to measure text after
+ * it has been converted from UTF-8 to the
+ * encoding of this font. */
+
+ char *fontMap[FONTMAP_PAGES];
+ /* Two-level sparse table used to determine
+ * quickly if the specified character exists.
+ * As characters are encountered, more pages
+ * in this table are dynamically added. The
+ * contents of each page is a bitmask
+ * consisting of FONTMAP_BITSPERPAGE bits,
+ * representing whether this font can be used
+ * to display the given character at the
+ * corresponding bit position. The high bits
+ * of the character are used to pick which
+ * page of the table is used. */
+
+ /*
+ * Cached Truetype font info.
+ */
+
+ int segCount; /* The length of the following arrays. */
+ USHORT *startCount; /* Truetype information about the font, */
+ USHORT *endCount; /* indicating which characters this font
+ * can display (malloced). The format of
+ * this information is (relatively) compact,
+ * but would take longer to search than
+ * indexing into the fontMap[][] table. */
+} FontFamily;
+
+/*
+ * The following structure encapsulates an individual screen font. A font
+ * object is made up of however many SubFonts are necessary to display a
+ * stream of multilingual characters.
+ */
+
+typedef struct SubFont {
+ char **fontMap; /* Pointer to font map from the FontFamily,
+ * cached here to save a dereference. */
+ HFONT hFont; /* The specific screen font that will be
+ * used when displaying/measuring chars
+ * belonging to the FontFamily. */
+ FontFamily *familyPtr; /* The FontFamily for this SubFont. */
+} SubFont;
+
+/*
+ * The following structure represents Windows' implementation of a font
+ * object.
+ */
+
+#define SUBFONT_SPACE 3
+#define BASE_CHARS 128
+
typedef struct WinFont {
TkFont font; /* Stuff used by generic font package. Must
* be first in structure. */
- HFONT hFont; /* Windows information about font. */
+ SubFont staticSubFonts[SUBFONT_SPACE];
+ /* Builtin space for a limited number of
+ * SubFonts. */
+ int numSubFonts; /* Length of following array. */
+ SubFont *subFontArray; /* Array of SubFonts that have been loaded
+ * in order to draw/measure all the characters
+ * encountered by this font so far. All fonts
+ * start off with one SubFont initialized by
+ * AllocFont() from the original set of font
+ * attributes. Usually points to
+ * staticSubFonts, but may point to malloced
+ * space if there are lots of SubFonts. */
+
HWND hwnd; /* Toplevel window of application that owns
- * this font, used for getting HDC. */
- int widths[256]; /* Widths of first 256 chars in this font. */
+ * this font, used for getting HDC for
+ * offscreen measurements. */
+ int pixelSize; /* Original pixel size used when font was
+ * constructed. */
+ int widths[BASE_CHARS]; /* Widths of first 128 chars in the base
+ * font, for handling common case. The base
+ * font is always used to draw characters
+ * between 0x0000 and 0x007f. */
} WinFont;
/*
- * The following structure is used as to map between the Tcl strings
- * that represent the system fonts and the numbers used by Windows.
+ * The following structure is passed as the LPARAM when calling the font
+ * enumeration procedure to determine if a font can support the given
+ * character.
+ */
+
+typedef struct CanUse {
+ HDC hdc;
+ WinFont *fontPtr;
+ Tcl_DString *nameTriedPtr;
+ int ch;
+ SubFont *subFontPtr;
+} CanUse;
+
+/*
+ * The list of font families that are currently loaded. As screen fonts
+ * are loaded, this list grows to hold information about what characters
+ * exist in each font family.
+ */
+
+static FontFamily *fontFamilyList = NULL;
+
+/*
+ * The following structure is used to map between the Tcl strings that
+ * represent the system fonts and the numbers used by Windows.
*/
static TkStateMap systemMap[] = {
@@ -44,16 +173,95 @@ static TkStateMap systemMap[] = {
{-1, NULL}
};
-#define ABS(x) (((x) < 0) ? -(x) : (x))
+/*
+ * Information cached about the system at startup time.
+ */
+
+static int platformId;
+static Tcl_Encoding unicodeEncoding;
+static Tcl_Encoding systemEncoding;
+
+/*
+ * Procedures used only in this file.
+ */
+
+static FontFamily * AllocFontFamily(HDC hdc, HFONT hFont, int base);
+static SubFont * CanUseFallback(HDC hdc, WinFont *fontPtr,
+ char *fallbackName, int ch);
+static SubFont * CanUseFallbackWithAliases(HDC hdc, WinFont *fontPtr,
+ char *faceName, int ch, Tcl_DString *nameTriedPtr);
+static int FamilyExists(HDC hdc, CONST char *faceName);
+static char * FamilyOrAliasExists(HDC hdc, CONST char *faceName);
+static SubFont * FindSubFontForChar(WinFont *fontPtr, int ch);
+static void FontMapInsert(SubFont *subFontPtr, int ch);
+static void FontMapLoadPage(SubFont *subFontPtr, int row);
+static int FontMapLookup(SubFont *subFontPtr, int ch);
+static void FreeFontFamily(FontFamily *familyPtr);
+static HFONT GetScreenFont(CONST TkFontAttributes *faPtr,
+ CONST char *faceName, int pixelSize);
+static void InitFont(Tk_Window tkwin, HFONT hFont,
+ int overstrike, WinFont *tkFontPtr);
+static void InitSubFont(HDC hdc, HFONT hFont, int base,
+ SubFont *subFontPtr);
+static int LoadFontRanges(HDC hdc, HFONT hFont,
+ USHORT **startCount, USHORT **endCount,
+ int *symbolPtr);
+static void MultiFontTextOut(HDC hdc, WinFont *fontPtr,
+ CONST char *source, int numBytes, int x, int y);
+static void ReleaseFont(WinFont *fontPtr);
+static void ReleaseSubFont(SubFont *subFontPtr);
+static int SeenName(CONST char *name, Tcl_DString *dsPtr);
+static void SwapLong(PULONG p);
+static void SwapShort(USHORT *p);
+static int CALLBACK WinFontCanUseProc(ENUMLOGFONT *lfPtr,
+ NEWTEXTMETRIC *tmPtr, int fontType,
+ LPARAM lParam);
+static int CALLBACK WinFontExistProc(ENUMLOGFONT *lfPtr,
+ NEWTEXTMETRIC *tmPtr, int fontType,
+ LPARAM lParam);
+static int CALLBACK WinFontFamilyEnumProc(ENUMLOGFONT *lfPtr,
+ NEWTEXTMETRIC *tmPtr, int fontType,
+ LPARAM lParam);
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * TkpFontPkgInit --
+ *
+ * This procedure is called when an application is created. It
+ * initializes all the structures that are used by the
+ * platform-dependant code on a per application basis.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ *
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+void
+TkpFontPkgInit(
+ TkMainInfo *mainPtr) /* The application being created. */
+{
+ OSVERSIONINFO os;
-static TkFont * AllocFont _ANSI_ARGS_((TkFont *tkFontPtr,
- Tk_Window tkwin, HFONT hFont));
-static char * GetProperty _ANSI_ARGS_((CONST TkFontAttributes *faPtr,
- CONST char *option));
-static int CALLBACK WinFontFamilyEnumProc _ANSI_ARGS_((ENUMLOGFONT *elfPtr,
- NEWTEXTMETRIC *ntmPtr, int fontType,
- LPARAM lParam));
+ os.dwOSVersionInfoSize = sizeof(os);
+ GetVersionEx(&os);
+ platformId = os.dwPlatformId;
+ unicodeEncoding = Tcl_GetEncoding(NULL, "unicode");
+ if (platformId == VER_PLATFORM_WIN32_NT) {
+ /*
+ * If running NT, then we will be calling some Unicode functions
+ * explictly. So, even if the Tcl system encoding isn't Unicode,
+ * make sure we convert to/from the Unicode char set.
+ */
+ systemEncoding = unicodeEncoding;
+ }
+}
/*
*---------------------------------------------------------------------------
@@ -76,29 +284,29 @@ static int CALLBACK WinFontFamilyEnumProc _ANSI_ARGS_((ENUMLOGFONT *elfPtr,
* the contents of the generic TkFont before calling TkpDeleteFont().
*
* Side effects:
- * None.
+ * Memory allocated.
*
*---------------------------------------------------------------------------
*/
TkFont *
-TkpGetNativeFont(tkwin, name)
- Tk_Window tkwin; /* For display where font will be used. */
- CONST char *name; /* Platform-specific font name. */
+TkpGetNativeFont(
+ Tk_Window tkwin, /* For display where font will be used. */
+ CONST char *name) /* Platform-specific font name. */
{
int object;
- HFONT hFont;
-
+ WinFont *fontPtr;
+
object = TkFindStateNum(NULL, NULL, systemMap, name);
if (object < 0) {
return NULL;
}
- hFont = GetStockObject(object);
- if (hFont == NULL) {
- panic("TkpGetNativeFont: can't allocate stock font");
- }
- return AllocFont(NULL, tkwin, hFont);
+ tkwin = (Tk_Window) ((TkWindow *) tkwin)->mainPtr->winPtr;
+ fontPtr = (WinFont *) ckalloc(sizeof(WinFont));
+ InitFont(tkwin, GetStockObject(object), 0, fontPtr);
+
+ return (TkFont *) fontPtr;
}
/*
@@ -125,80 +333,86 @@ TkpGetNativeFont(tkwin, name)
* the contents of the generic TkFont before calling TkpDeleteFont().
*
* Side effects:
- * None.
+ * Memory allocated.
*
*---------------------------------------------------------------------------
*/
+
TkFont *
-TkpGetFontFromAttributes(tkFontPtr, tkwin, faPtr)
- TkFont *tkFontPtr; /* If non-NULL, store the information in
+TkpGetFontFromAttributes(
+ TkFont *tkFontPtr, /* If non-NULL, store the information in
* this existing TkFont structure, rather than
* allocating a new structure to hold the
* font; the existing contents of the font
* will be released. If NULL, a new TkFont
* structure is allocated. */
- Tk_Window tkwin; /* For display where font will be used. */
- CONST TkFontAttributes *faPtr; /* Set of attributes to match. */
+ Tk_Window tkwin, /* For display where font will be used. */
+ CONST TkFontAttributes *faPtr)
+ /* Set of attributes to match. */
{
- LOGFONT lf;
+ int i, j;
+ HDC hdc;
+ HWND hwnd;
HFONT hFont;
Window window;
- HWND hwnd;
- HDC hdc;
+ WinFont *fontPtr;
+ char ***fontFallbacks;
+ char *faceName, *fallback, *actualName;
- window = Tk_WindowId(((TkWindow *) tkwin)->mainPtr->winPtr);
- hwnd = (window == None) ? NULL : TkWinGetHWND(window);
-
- hdc = GetDC(hwnd);
- lf.lfHeight = -faPtr->pointsize;
- if (lf.lfHeight < 0) {
- lf.lfHeight = MulDiv(lf.lfHeight,
- 254 * WidthOfScreen(Tk_Screen(tkwin)),
- 720 * WidthMMOfScreen(Tk_Screen(tkwin)));
- }
- lf.lfWidth = 0;
- lf.lfEscapement = 0;
- lf.lfOrientation = 0;
- lf.lfWeight = (faPtr->weight == TK_FW_NORMAL) ? FW_NORMAL : FW_BOLD;
- lf.lfItalic = faPtr->slant;
- lf.lfUnderline = faPtr->underline;
- lf.lfStrikeOut = faPtr->overstrike;
- lf.lfCharSet = DEFAULT_CHARSET;
- lf.lfOutPrecision = OUT_DEFAULT_PRECIS;
- lf.lfClipPrecision = CLIP_DEFAULT_PRECIS;
- lf.lfQuality = DEFAULT_QUALITY;
- lf.lfPitchAndFamily = DEFAULT_PITCH | FF_DONTCARE;
- if (faPtr->family == NULL) {
- lf.lfFaceName[0] = '\0';
- } else {
- lstrcpyn(lf.lfFaceName, faPtr->family, sizeof(lf.lfFaceName));
- }
- ReleaseDC(hwnd, hdc);
+ tkwin = (Tk_Window) ((TkWindow *) tkwin)->mainPtr->winPtr;
+ window = Tk_WindowId(tkwin);
+ hwnd = (window == None) ? NULL : TkWinGetHWND(window);
+ hdc = GetDC(hwnd);
/*
- * Replace the standard X and Mac family names with the names that
- * Windows likes.
+ * Algorithm to get the closest font name to the one requested.
+ *
+ * try fontname
+ * try all aliases for fontname
+ * foreach fallback for fontname
+ * try the fallback
+ * try all aliases for the fallback
*/
- if ((stricmp(lf.lfFaceName, "Times") == 0)
- || (stricmp(lf.lfFaceName, "New York") == 0)) {
- strcpy(lf.lfFaceName, "Times New Roman");
- } else if ((stricmp(lf.lfFaceName, "Courier") == 0)
- || (stricmp(lf.lfFaceName, "Monaco") == 0)) {
- strcpy(lf.lfFaceName, "Courier New");
- } else if ((stricmp(lf.lfFaceName, "Helvetica") == 0)
- || (stricmp(lf.lfFaceName, "Geneva") == 0)) {
- strcpy(lf.lfFaceName, "Arial");
- }
-
- hFont = CreateFontIndirect(&lf);
- if (hFont == NULL) {
- hFont = GetStockObject(SYSTEM_FONT);
- if (hFont == NULL) {
- panic("TkpGetFontFromAttributes: cannot get system font");
+ faceName = faPtr->family;
+ if (faceName != NULL) {
+ actualName = FamilyOrAliasExists(hdc, faceName);
+ if (actualName != NULL) {
+ faceName = actualName;
+ goto found;
}
+ fontFallbacks = TkFontGetFallbacks();
+ for (i = 0; fontFallbacks[i] != NULL; i++) {
+ for (j = 0; (fallback = fontFallbacks[i][j]) != NULL; j++) {
+ if (strcasecmp(faceName, fallback) == 0) {
+ break;
+ }
+ }
+ if (fallback != NULL) {
+ for (j = 0; (fallback = fontFallbacks[i][j]) != NULL; j++) {
+ actualName = FamilyOrAliasExists(hdc, fallback);
+ if (actualName != NULL) {
+ faceName = actualName;
+ goto found;
+ }
+ }
+ }
+ }
+ }
+
+ found:
+ ReleaseDC(hwnd, hdc);
+
+ hFont = GetScreenFont(faPtr, faceName, TkFontGetPixels(tkwin, faPtr->size));
+ if (tkFontPtr == NULL) {
+ fontPtr = (WinFont *) ckalloc(sizeof(WinFont));
+ } else {
+ fontPtr = (WinFont *) tkFontPtr;
+ ReleaseFont(fontPtr);
}
- return AllocFont(tkFontPtr, tkwin, hFont);
+ InitFont(tkwin, hFont, faPtr->overstrike, fontPtr);
+
+ return (TkFont *) fontPtr;
}
/*
@@ -221,26 +435,25 @@ TkpGetFontFromAttributes(tkFontPtr, tkwin, faPtr)
*/
void
-TkpDeleteFont(tkFontPtr)
- TkFont *tkFontPtr; /* Token of font to be deleted. */
+TkpDeleteFont(
+ TkFont *tkFontPtr) /* Token of font to be deleted. */
{
WinFont *fontPtr;
fontPtr = (WinFont *) tkFontPtr;
- DeleteObject(fontPtr->hFont);
- ckfree((char *) fontPtr);
+ ReleaseFont(fontPtr);
}
/*
*---------------------------------------------------------------------------
*
- * TkpGetFontFamilies, WinFontEnumFamilyProc --
+ * TkpGetFontFamilies, WinFontFamilyEnumProc --
*
* Return information about the font families that are available
* on the display of the given window.
*
* Results:
- * interp->result is modified to hold a list of all the available
+ * Modifies interp's result object to hold a list of all the available
* font families.
*
* Side effects:
@@ -250,40 +463,103 @@ TkpDeleteFont(tkFontPtr)
*/
void
-TkpGetFontFamilies(interp, tkwin)
- Tcl_Interp *interp; /* Interp to hold result. */
- Tk_Window tkwin; /* For display to query. */
+TkpGetFontFamilies(
+ Tcl_Interp *interp, /* Interp to hold result. */
+ Tk_Window tkwin) /* For display to query. */
{
- Window window;
- HWND hwnd;
HDC hdc;
+ HWND hwnd;
+ Window window;
+
+ window = Tk_WindowId(tkwin);
+ hwnd = (window == None) ? NULL : TkWinGetHWND(window);
+ hdc = GetDC(hwnd);
- window = Tk_WindowId(tkwin);
- hwnd = (window == (Window) NULL) ? NULL : TkWinGetHWND(window);
+ /*
+ * On any version NT, there may fonts with international names.
+ * Use the NT-only Unicode version of EnumFontFamilies to get the
+ * font names. If we used the ANSI version on a non-internationalized
+ * version of NT, we would get font names with '?' replacing all
+ * the international characters.
+ *
+ * On a non-internationalized verson of 95, fonts with international
+ * names are not allowed, so the ANSI version of EnumFontFamilies will
+ * work. On an internationalized version of 95, there may be fonts with
+ * international names; the ANSI version will work, fetching the
+ * name in the system code page. Can't use the Unicode version of
+ * EnumFontFamilies because it only exists under NT.
+ */
- hdc = GetDC(hwnd);
- EnumFontFamilies(hdc, NULL, (FONTENUMPROC) WinFontFamilyEnumProc,
- (LPARAM) interp);
+ if (platformId == VER_PLATFORM_WIN32_NT) {
+ EnumFontFamiliesW(hdc, NULL, (FONTENUMPROCW) WinFontFamilyEnumProc,
+ (LPARAM) interp);
+ } else {
+ EnumFontFamiliesA(hdc, NULL, (FONTENUMPROCA) WinFontFamilyEnumProc,
+ (LPARAM) interp);
+ }
ReleaseDC(hwnd, hdc);
}
-/* ARGSUSED */
-
static int CALLBACK
-WinFontFamilyEnumProc(elfPtr, ntmPtr, fontType, lParam)
- ENUMLOGFONT *elfPtr; /* Logical-font data. */
- NEWTEXTMETRIC *ntmPtr; /* Physical-font data (not used). */
- int fontType; /* Type of font (not used). */
- LPARAM lParam; /* Interp to hold result. */
+WinFontFamilyEnumProc(
+ ENUMLOGFONT *lfPtr, /* Logical-font data. */
+ NEWTEXTMETRIC *tmPtr, /* Physical-font data (not used). */
+ int fontType, /* Type of font (not used). */
+ LPARAM lParam) /* Result object to hold result. */
{
+ char *faceName;
+ Tcl_DString faceString;
+ Tcl_Obj *strPtr;
Tcl_Interp *interp;
interp = (Tcl_Interp *) lParam;
- Tcl_AppendElement(interp, elfPtr->elfLogFont.lfFaceName);
+ faceName = lfPtr->elfLogFont.lfFaceName;
+ Tcl_ExternalToUtfDString(systemEncoding, faceName, -1, &faceString);
+ strPtr = Tcl_NewStringObj(Tcl_DStringValue(&faceString),
+ Tcl_DStringLength(&faceString));
+ Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), strPtr);
+ Tcl_DStringFree(&faceString);
return 1;
}
/*
+ *-------------------------------------------------------------------------
+ *
+ * TkpGetSubFonts --
+ *
+ * A function used by the testing package for querying the actual
+ * screen fonts that make up a font object.
+ *
+ * Results:
+ * Modifies interp's result object to hold a list containing the
+ * names of the screen fonts that make up the given font object.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+void
+TkpGetSubFonts(
+ Tcl_Interp *interp, /* Interp to hold result. */
+ Tk_Font tkfont) /* Font object to query. */
+{
+ int i;
+ WinFont *fontPtr;
+ FontFamily *familyPtr;
+ Tcl_Obj *resultPtr, *strPtr;
+
+ resultPtr = Tcl_GetObjResult(interp);
+ fontPtr = (WinFont *) tkfont;
+ for (i = 0; i < fontPtr->numSubFonts; i++) {
+ familyPtr = fontPtr->subFontArray[i].familyPtr;
+ strPtr = Tcl_NewStringObj(familyPtr->faceName, -1);
+ Tcl_ListObjAppendElement(NULL, resultPtr, strPtr);
+ }
+}
+
+/*
*---------------------------------------------------------------------------
*
* Tk_MeasureChars --
@@ -304,83 +580,154 @@ WinFontFamilyEnumProc(elfPtr, ntmPtr, fontType, lParam)
*
*---------------------------------------------------------------------------
*/
+
int
-Tk_MeasureChars(tkfont, source, numChars, maxLength, flags, lengthPtr)
- Tk_Font tkfont; /* Font in which characters will be drawn. */
- CONST char *source; /* Characters to be displayed. Need not be
+Tk_MeasureChars(
+ Tk_Font tkfont, /* Font in which characters will be drawn. */
+ CONST char *source, /* UTF-8 string to be displayed. Need not be
* '\0' terminated. */
- int numChars; /* Maximum number of characters to consider
+ int numBytes, /* Maximum number of bytes to consider
* from source string. */
- int maxLength; /* If > 0, maxLength specifies the longest
- * permissible line length; don't consider any
- * character that would cross this
- * x-position. If <= 0, then line length is
- * unbounded and the flags argument is
+ int maxLength, /* If >= 0, maxLength specifies the longest
+ * permissible line length in pixels; don't
+ * consider any character that would cross
+ * this x-position. If < 0, then line length
+ * is unbounded and the flags argument is
* ignored. */
- int flags; /* Various flag bits OR-ed together:
+ int flags, /* Various flag bits OR-ed together:
* TK_PARTIAL_OK means include the last char
* which only partially fit on this line.
* TK_WHOLE_WORDS means stop on a word
* boundary, if possible.
* TK_AT_LEAST_ONE means return at least one
* character even if no characters fit. */
- int *lengthPtr; /* Filled with x-location just after the
+ int *lengthPtr) /* Filled with x-location just after the
* terminating character. */
{
- WinFont *fontPtr;
HDC hdc;
- HFONT hFont;
- int curX, curIdx;
+ HFONT oldFont;
+ WinFont *fontPtr;
+ int curX, curByte;
+ SubFont *lastSubFontPtr;
/*
- * On the authority of the Gates Empire, Windows does not use kerning
+ * According to Microsoft tech support, Windows does not use kerning
* or fractional character widths when displaying text on the screen.
* So that means we can safely measure individual characters or spans
- * of characters and add up the widths w/o any "off-by-one pixel"
+ * of characters and add up the widths w/o any "off-by-one-pixel"
* errors.
*/
fontPtr = (WinFont *) tkfont;
hdc = GetDC(fontPtr->hwnd);
- hFont = SelectObject(hdc, fontPtr->hFont);
+ lastSubFontPtr = &fontPtr->subFontArray[0];
+ oldFont = SelectObject(hdc, lastSubFontPtr->hFont);
- if (numChars == 0) {
+ if (numBytes == 0) {
curX = 0;
- curIdx = 0;
- } else if (maxLength <= 0) {
+ curByte = 0;
+ } else if (maxLength < 0) {
+ Tcl_UniChar ch;
SIZE size;
+ FontFamily *familyPtr;
+ Tcl_DString runString;
+ SubFont *thisSubFontPtr;
+ CONST char *p, *end, *next;
- GetTextExtentPoint(hdc, source, numChars, &size);
- curX = size.cx;
- curIdx = numChars;
+ /*
+ * A three step process:
+ * 1. Find a contiguous range of characters that can all be
+ * represented by a single screen font.
+ * 2. Convert those chars to the encoding of that font.
+ * 3. Measure converted chars.
+ */
+
+ curX = 0;
+ end = source + numBytes;
+ for (p = source; p < end; ) {
+ next = p + Tcl_UtfToUniChar(p, &ch);
+ thisSubFontPtr = FindSubFontForChar(fontPtr, ch);
+ if (thisSubFontPtr != lastSubFontPtr) {
+ familyPtr = lastSubFontPtr->familyPtr;
+ Tcl_UtfToExternalDString(familyPtr->encoding, source,
+ p - source, &runString);
+ (*familyPtr->getTextExtentPointProc)(hdc,
+ Tcl_DStringValue(&runString),
+ Tcl_DStringLength(&runString) >> familyPtr->isWideFont,
+ &size);
+ curX += size.cx;
+ Tcl_DStringFree(&runString);
+ lastSubFontPtr = thisSubFontPtr;
+ source = p;
+
+ SelectObject(hdc, lastSubFontPtr->hFont);
+ }
+ p = next;
+ }
+ familyPtr = lastSubFontPtr->familyPtr;
+ Tcl_UtfToExternalDString(familyPtr->encoding, source, p - source,
+ &runString);
+ (*familyPtr->getTextExtentPointProc)(hdc, Tcl_DStringValue(&runString),
+ Tcl_DStringLength(&runString) >> familyPtr->isWideFont,
+ &size);
+ curX += size.cx;
+ Tcl_DStringFree(&runString);
+ curByte = numBytes;
} else {
- int newX, termX, sawNonSpace;
- CONST char *term, *end, *p;
- int ch;
+ Tcl_UniChar ch;
+ SIZE size;
+ char buf[16];
+ FontFamily *familyPtr;
+ SubFont *thisSubFontPtr;
+ CONST char *term, *end, *p, *next;
+ int newX, termX, sawNonSpace, srcRead, dstWrote;
+
+ /*
+ * How many chars will fit in the space allotted?
+ * This first version may be inefficient because it measures
+ * every character individually. There is a function call that
+ * can measure multiple characters at once and return the
+ * offset of each of them, but it only works on NT, even though
+ * the documentation claims it works for 95.
+ */
- ch = UCHAR(*source);
+ next = source + Tcl_UtfToUniChar(source, &ch);
newX = curX = termX = 0;
term = source;
- end = source + numChars;
+ end = source + numBytes;
- sawNonSpace = !isspace(ch);
+ sawNonSpace = (ch > 255) || !isspace(ch);
for (p = source; ; ) {
- newX += fontPtr->widths[ch];
+ if (ch < BASE_CHARS) {
+ newX += fontPtr->widths[ch];
+ } else {
+ thisSubFontPtr = FindSubFontForChar(fontPtr, ch);
+ if (thisSubFontPtr != lastSubFontPtr) {
+ SelectObject(hdc, thisSubFontPtr->hFont);
+ lastSubFontPtr = thisSubFontPtr;
+ }
+ familyPtr = lastSubFontPtr->familyPtr;
+ Tcl_UtfToExternal(NULL, familyPtr->encoding, p, next - p,
+ 0, NULL, buf, sizeof(buf), &srcRead, &dstWrote, NULL);
+ (*familyPtr->getTextExtentPointProc)(hdc, buf,
+ dstWrote >> familyPtr->isWideFont, &size);
+ newX += size.cx;
+ }
if (newX > maxLength) {
break;
}
curX = newX;
- p++;
+ p = next;
if (p >= end) {
term = end;
termX = curX;
break;
}
- ch = UCHAR(*p);
- if (isspace(ch)) {
+ next += Tcl_UtfToUniChar(next, &ch);
+ if ((ch < 256) && isspace(ch)) {
if (sawNonSpace) {
term = p;
termX = curX;
@@ -404,13 +751,13 @@ Tk_MeasureChars(tkfont, source, numChars, maxLength, flags, lengthPtr)
*/
curX = newX;
- p++;
+ p += Tcl_UtfToUniChar(p, &ch);
}
if ((flags & TK_AT_LEAST_ONE) && (term == source) && (p < end)) {
term = p;
termX = curX;
if (term == source) {
- term++;
+ term += Tcl_UtfToUniChar(term, &ch);
termX = newX;
}
} else if ((p >= end) || !(flags & TK_WHOLE_WORDS)) {
@@ -419,14 +766,14 @@ Tk_MeasureChars(tkfont, source, numChars, maxLength, flags, lengthPtr)
}
curX = termX;
- curIdx = term - source;
+ curByte = term - source;
}
- SelectObject(hdc, hFont);
+ SelectObject(hdc, oldFont);
ReleaseDC(fontPtr->hwnd, hdc);
*lengthPtr = curX;
- return curIdx;
+ return curByte;
}
/*
@@ -446,27 +793,26 @@ Tk_MeasureChars(tkfont, source, numChars, maxLength, flags, lengthPtr)
*/
void
-Tk_DrawChars(display, drawable, gc, tkfont, source, numChars, x, y)
- Display *display; /* Display on which to draw. */
- Drawable drawable; /* Window or pixmap in which to draw. */
- GC gc; /* Graphics context for drawing characters. */
- Tk_Font tkfont; /* Font in which characters will be drawn;
+Tk_DrawChars(
+ Display *display, /* Display on which to draw. */
+ Drawable drawable, /* Window or pixmap in which to draw. */
+ GC gc, /* Graphics context for drawing characters. */
+ Tk_Font tkfont, /* Font in which characters will be drawn;
* must be the same as font used in GC. */
- CONST char *source; /* Characters to be displayed. Need not be
+ CONST char *source, /* UTF-8 string to be displayed. Need not be
* '\0' terminated. All Tk meta-characters
* (tabs, control characters, and newlines)
* should be stripped out of the string that
* is passed to this function. If they are
* not stripped out, they will be displayed as
* regular printing characters. */
- int numChars; /* Number of characters in string. */
- int x, y; /* Coordinates at which to place origin of
+ int numBytes, /* Number of bytes in string. */
+ int x, int y) /* Coordinates at which to place origin of
* string when drawing. */
{
HDC dc;
- HFONT hFont;
- TkWinDCState state;
WinFont *fontPtr;
+ TkWinDCState state;
fontPtr = (WinFont *) gc->font;
display->request++;
@@ -503,18 +849,16 @@ Tk_DrawChars(display, drawable, gc, tkfont, source, numChars, x, y)
SetBrushOrgEx(dc, gc->ts_x_origin, gc->ts_y_origin, NULL);
oldBrush = SelectObject(dc, stipple);
- SetTextAlign(dcMem, TA_LEFT | TA_TOP);
+ SetTextAlign(dcMem, TA_LEFT | TA_BASELINE);
SetTextColor(dcMem, gc->foreground);
SetBkMode(dcMem, TRANSPARENT);
SetBkColor(dcMem, RGB(0, 0, 0));
- hFont = SelectObject(dcMem, fontPtr->hFont);
-
/*
* Compute the bounding box and create a compatible bitmap.
*/
- GetTextExtentPoint(dcMem, source, numChars, &size);
+ GetTextExtentPoint(dcMem, source, numBytes, &size);
GetTextMetrics(dcMem, &tm);
size.cx -= tm.tmOverhang;
bitmap = CreateCompatibleBitmap(dc, size.cx, size.cy);
@@ -529,11 +873,11 @@ Tk_DrawChars(display, drawable, gc, tkfont, source, numChars, x, y)
*/
PatBlt(dcMem, 0, 0, size.cx, size.cy, BLACKNESS);
- TextOut(dcMem, 0, 0, source, numChars);
+ MultiFontTextOut(dc, fontPtr, source, numBytes, x, y);
BitBlt(dc, x, y - tm.tmAscent, size.cx, size.cy, dcMem,
0, 0, 0xEA02E9);
PatBlt(dcMem, 0, 0, size.cx, size.cy, WHITENESS);
- TextOut(dcMem, 0, 0, source, numChars);
+ MultiFontTextOut(dc, fontPtr, source, numBytes, x, y);
BitBlt(dc, x, y - tm.tmAscent, size.cx, size.cy, dcMem,
0, 0, 0x8A0E06);
@@ -541,7 +885,6 @@ Tk_DrawChars(display, drawable, gc, tkfont, source, numChars, x, y)
* Destroy the temporary bitmap and restore the device context.
*/
- SelectObject(dcMem, hFont);
SelectObject(dcMem, oldBitmap);
DeleteObject(bitmap);
DeleteDC(dcMem);
@@ -551,93 +894,1454 @@ Tk_DrawChars(display, drawable, gc, tkfont, source, numChars, x, y)
SetTextAlign(dc, TA_LEFT | TA_BASELINE);
SetTextColor(dc, gc->foreground);
SetBkMode(dc, TRANSPARENT);
- hFont = SelectObject(dc, fontPtr->hFont);
- TextOut(dc, x, y, source, numChars);
- SelectObject(dc, hFont);
+ MultiFontTextOut(dc, fontPtr, source, numBytes, x, y);
}
TkWinReleaseDrawableDC(drawable, dc, &state);
}
/*
- *---------------------------------------------------------------------------
+ *-------------------------------------------------------------------------
*
- * AllocFont --
+ * MultiFontTextOut --
*
- * Helper for TkpGetNativeFont() and TkpGetFontFromAttributes().
- * Allocates and intializes the memory for a new TkFont that
- * wraps the platform-specific data.
+ * Helper function for Tk_DrawChars. Draws characters, using the
+ * various screen fonts in fontPtr to draw multilingual characters.
+ * Note: No bidirectional support.
*
* Results:
- * Returns pointer to newly constructed TkFont.
+ * None.
+ *
+ * Side effects:
+ * Information gets drawn on the screen.
+ * Contents of fontPtr may be modified if more subfonts were loaded
+ * in order to draw all the multilingual characters in the given
+ * string.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static void
+MultiFontTextOut(
+ HDC hdc, /* HDC to draw into. */
+ WinFont *fontPtr, /* Contains set of fonts to use when drawing
+ * following string. */
+ CONST char *source, /* Potentially multilingual UTF-8 string. */
+ int numBytes, /* Length of string in bytes. */
+ int x, int y) /* Coordinates at which to place origin *
+ * of string when drawing. */
+{
+ Tcl_UniChar ch;
+ SIZE size;
+ HFONT oldFont;
+ FontFamily *familyPtr;
+ Tcl_DString runString;
+ CONST char *p, *end, *next;
+ SubFont *lastSubFontPtr, *thisSubFontPtr;
+
+ lastSubFontPtr = &fontPtr->subFontArray[0];
+ oldFont = SelectObject(hdc, lastSubFontPtr->hFont);
+
+ end = source + numBytes;
+ for (p = source; p < end; ) {
+ next = p + Tcl_UtfToUniChar(p, &ch);
+ thisSubFontPtr = FindSubFontForChar(fontPtr, ch);
+ if (thisSubFontPtr != lastSubFontPtr) {
+ if (p > source) {
+ familyPtr = lastSubFontPtr->familyPtr;
+ Tcl_UtfToExternalDString(familyPtr->encoding, source,
+ p - source, &runString);
+ (*familyPtr->textOutProc)(hdc, x, y,
+ Tcl_DStringValue(&runString),
+ Tcl_DStringLength(&runString) >> familyPtr->isWideFont);
+ (*familyPtr->getTextExtentPointProc)(hdc,
+ Tcl_DStringValue(&runString),
+ Tcl_DStringLength(&runString) >> familyPtr->isWideFont,
+ &size);
+ x += size.cx;
+ Tcl_DStringFree(&runString);
+ }
+ lastSubFontPtr = thisSubFontPtr;
+ source = p;
+ SelectObject(hdc, lastSubFontPtr->hFont);
+ }
+ p = next;
+ }
+ if (p > source) {
+ familyPtr = lastSubFontPtr->familyPtr;
+ Tcl_UtfToExternalDString(familyPtr->encoding, source, p - source,
+ &runString);
+ (*familyPtr->textOutProc)(hdc, x, y, Tcl_DStringValue(&runString),
+ Tcl_DStringLength(&runString) >> familyPtr->isWideFont);
+ Tcl_DStringFree(&runString);
+ }
+ SelectObject(hdc, oldFont);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * InitFont --
+ *
+ * Helper for TkpGetNativeFont() and TkpGetFontFromAttributes().
+ * Initializes the memory for a new WinFont that wraps the
+ * platform-specific data.
*
* The caller is responsible for initializing the fields of the
- * TkFont that are used exclusively by the generic TkFont code, and
+ * WinFont that are used exclusively by the generic TkFont code, and
* for releasing those fields before calling TkpDeleteFont().
*
+ * Results:
+ * Fills the WinFont structure.
+ *
* Side effects:
* Memory allocated.
*
*---------------------------------------------------------------------------
*/
-static TkFont *
-AllocFont(tkFontPtr, tkwin, hFont)
- TkFont *tkFontPtr; /* If non-NULL, store the information in
- * this existing TkFont structure, rather than
- * allocating a new structure to hold the
- * font; the existing contents of the font
- * will be released. If NULL, a new TkFont
- * structure is allocated. */
- Tk_Window tkwin; /* For display where font will be used. */
- HFONT hFont; /* Windows information about font. */
+static void
+InitFont(
+ Tk_Window tkwin, /* Main window of interp in which font will
+ * be used, for getting HDC. */
+ HFONT hFont, /* Windows token for font. */
+ int overstrike, /* The overstrike attribute of logfont used
+ * to allocate this font. For some reason,
+ * the TEXTMETRICs may contain incorrect info
+ * in the tmStruckOut field. */
+ WinFont *fontPtr) /* Filled with information constructed from
+ * the above arguments. */
{
- HWND hwnd;
- WinFont *fontPtr;
HDC hdc;
+ HWND hwnd;
+ HFONT oldFont;
TEXTMETRIC tm;
Window window;
- char buf[LF_FACESIZE];
+ TkFontMetrics *fmPtr;
+ Tcl_Encoding encoding;
+ Tcl_DString faceString;
TkFontAttributes *faPtr;
+ char buf[LF_FACESIZE * sizeof(WCHAR)];
+
+ window = Tk_WindowId(tkwin);
+ hwnd = (window == None) ? NULL : TkWinGetHWND(window);
+ hdc = GetDC(hwnd);
+ oldFont = SelectObject(hdc, hFont);
+
+ GetTextMetrics(hdc, &tm);
- if (tkFontPtr != NULL) {
- fontPtr = (WinFont *) tkFontPtr;
- DeleteObject(fontPtr->hFont);
+ /*
+ * On any version NT, there may fonts with international names.
+ * Use the NT-only Unicode version of GetTextFace to get the font's
+ * name. If we used the ANSI version on a non-internationalized
+ * version of NT, we would get a font name with '?' replacing all
+ * the international characters.
+ *
+ * On a non-internationalized verson of 95, fonts with international
+ * names are not allowed, so the ANSI version of GetTextFace will work.
+ * On an internationalized version of 95, there may be fonts with
+ * international names; the ANSI version will work, fetching the
+ * name in the international system code page. Can't use the Unicode
+ * version of GetTextFace because it only exists under NT.
+ */
+
+ if (platformId == VER_PLATFORM_WIN32_NT) {
+ GetTextFaceW(hdc, LF_FACESIZE, (WCHAR *) buf);
} else {
- fontPtr = (WinFont *) ckalloc(sizeof(WinFont));
+ GetTextFaceA(hdc, LF_FACESIZE, (char *) buf);
}
-
- window = Tk_WindowId(((TkWindow *) tkwin)->mainPtr->winPtr);
- hwnd = (window == None) ? NULL : TkWinGetHWND(window);
-
- hdc = GetDC(hwnd);
- hFont = SelectObject(hdc, hFont);
- GetTextFace(hdc, sizeof(buf), buf);
- GetTextMetrics(hdc, &tm);
- GetCharWidth(hdc, 0, 255, fontPtr->widths);
+ Tcl_ExternalToUtfDString(systemEncoding, buf, -1, &faceString);
fontPtr->font.fid = (Font) fontPtr;
- faPtr = &fontPtr->font.fa;
- faPtr->family = Tk_GetUid(buf);
- faPtr->pointsize = MulDiv(tm.tmHeight - tm.tmInternalLeading,
- 720 * WidthMMOfScreen(Tk_Screen(tkwin)),
- 254 * WidthOfScreen(Tk_Screen(tkwin)));
+ faPtr = &fontPtr->font.fa;
+ faPtr->family = Tk_GetUid(Tcl_DStringValue(&faceString));
+ faPtr->size = TkFontGetPoints(tkwin, -(tm.tmHeight - tm.tmInternalLeading));
faPtr->weight = (tm.tmWeight > FW_MEDIUM) ? TK_FW_BOLD : TK_FW_NORMAL;
faPtr->slant = (tm.tmItalic != 0) ? TK_FS_ITALIC : TK_FS_ROMAN;
faPtr->underline = (tm.tmUnderlined != 0) ? 1 : 0;
- faPtr->overstrike = (tm.tmStruckOut != 0) ? 1 : 0;
+ faPtr->overstrike = overstrike;
+
+ fmPtr = &fontPtr->font.fm;
+ fmPtr->ascent = tm.tmAscent;
+ fmPtr->descent = tm.tmDescent;
+ fmPtr->maxWidth = tm.tmMaxCharWidth;
+ fmPtr->fixed = !(tm.tmPitchAndFamily & TMPF_FIXED_PITCH);
- fontPtr->font.fm.ascent = tm.tmAscent;
- fontPtr->font.fm.descent = tm.tmDescent;
- fontPtr->font.fm.maxWidth = tm.tmMaxCharWidth;
- fontPtr->font.fm.fixed = !(tm.tmPitchAndFamily & TMPF_FIXED_PITCH);
+ fontPtr->hwnd = hwnd;
+ fontPtr->pixelSize = tm.tmHeight - tm.tmInternalLeading;
- hFont = SelectObject(hdc, hFont);
+ fontPtr->numSubFonts = 1;
+ fontPtr->subFontArray = fontPtr->staticSubFonts;
+ InitSubFont(hdc, hFont, 1, &fontPtr->subFontArray[0]);
+
+ encoding = fontPtr->subFontArray[0].familyPtr->encoding;
+ if (encoding == unicodeEncoding) {
+ GetCharWidthW(hdc, 0, BASE_CHARS - 1, fontPtr->widths);
+ } else {
+ GetCharWidthA(hdc, 0, BASE_CHARS - 1, fontPtr->widths);
+ }
+ Tcl_DStringFree(&faceString);
+
+ SelectObject(hdc, oldFont);
ReleaseDC(hwnd, hdc);
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ReleaseFont --
+ *
+ * Called to release the windows-specific contents of a TkFont.
+ * The caller is responsible for freeing the memory used by the
+ * font itself.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory is freed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+ReleaseFont(
+ WinFont *fontPtr) /* The font to delete. */
+{
+ int i;
- fontPtr->hFont = hFont;
- fontPtr->hwnd = hwnd;
+ for (i = 0; i < fontPtr->numSubFonts; i++) {
+ ReleaseSubFont(&fontPtr->subFontArray[i]);
+ }
+ if (fontPtr->subFontArray != fontPtr->staticSubFonts) {
+ ckfree((char *) fontPtr->subFontArray);
+ }
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * InitSubFont --
+ *
+ * Wrap a screen font and load the FontFamily that represents
+ * it. Used to prepare a SubFont so that characters can be mapped
+ * from UTF-8 to the charset of the font.
+ *
+ * Results:
+ * The subFontPtr is filled with information about the font.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
- return (TkFont *) fontPtr;
+static void
+InitSubFont(
+ HDC hdc, /* HDC in which font can be selected. */
+ HFONT hFont, /* The screen font. */
+ int base, /* Non-zero if this SubFont is being used
+ * as the base font for a font object. */
+ SubFont *subFontPtr) /* Filled with SubFont constructed from
+ * above attributes. */
+{
+ subFontPtr->hFont = hFont;
+ subFontPtr->familyPtr = AllocFontFamily(hdc, hFont, base);
+ subFontPtr->fontMap = subFontPtr->familyPtr->fontMap;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ReleaseSubFont --
+ *
+ * Called to release the contents of a SubFont. The caller is
+ * responsible for freeing the memory used by the SubFont itself.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory and resources are freed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+ReleaseSubFont(
+ SubFont *subFontPtr) /* The SubFont to delete. */
+{
+ DeleteObject(subFontPtr->hFont);
+ FreeFontFamily(subFontPtr->familyPtr);
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * AllocFontFamily --
+ *
+ * Find the FontFamily structure associated with the given font
+ * name. The information should be stored by the caller in a
+ * SubFont and used when determining if that SubFont supports a
+ * character.
+ *
+ * Cannot use the string name used to construct the font as the
+ * key, because the capitalization may not be canonical. Therefore
+ * use the face name actually retrieved from the font metrics as
+ * the key.
+ *
+ * Results:
+ * A pointer to a FontFamily. The reference count in the FontFamily
+ * is automatically incremented. When the SubFont is released, the
+ * reference count is decremented. When no SubFont is using this
+ * FontFamily, it may be deleted.
+ *
+ * Side effects:
+ * A new FontFamily structure will be allocated if this font family
+ * has not been seen. TrueType character existence metrics are
+ * loaded into the FontFamily structure.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static FontFamily *
+AllocFontFamily(
+ HDC hdc, /* HDC in which font can be selected. */
+ HFONT hFont, /* Screen font whose FontFamily is to be
+ * returned. */
+ int base) /* Non-zero if this font family is to be
+ * used in the base font of a font object. */
+{
+ Tk_Uid faceName;
+ FontFamily *familyPtr;
+ Tcl_DString faceString;
+ Tcl_Encoding encoding;
+ char buf[LF_FACESIZE * sizeof(WCHAR)];
+
+ hFont = SelectObject(hdc, hFont);
+ if (platformId == VER_PLATFORM_WIN32_NT) {
+ GetTextFaceW(hdc, LF_FACESIZE, (WCHAR *) buf);
+ } else {
+ GetTextFaceA(hdc, LF_FACESIZE, (char *) buf);
+ }
+ Tcl_ExternalToUtfDString(systemEncoding, buf, -1, &faceString);
+ faceName = Tk_GetUid(Tcl_DStringValue(&faceString));
+ Tcl_DStringFree(&faceString);
+ hFont = SelectObject(hdc, hFont);
+
+ familyPtr = fontFamilyList;
+ for ( ; familyPtr != NULL; familyPtr = familyPtr->nextPtr) {
+ if (familyPtr->faceName == faceName) {
+ familyPtr->refCount++;
+ return familyPtr;
+ }
+ }
+
+ familyPtr = (FontFamily *) ckalloc(sizeof(FontFamily));
+ memset(familyPtr, 0, sizeof(FontFamily));
+ familyPtr->nextPtr = fontFamilyList;
+ fontFamilyList = familyPtr;
+
+ /*
+ * Set key for this FontFamily.
+ */
+
+ familyPtr->faceName = faceName;
+
+ /*
+ * An initial refCount of 2 means that FontFamily information will
+ * persist even when the SubFont that loaded the FontFamily is released.
+ * Change it to 1 to cause FontFamilies to be unloaded when not in use.
+ */
+
+ familyPtr->refCount = 2;
+
+ familyPtr->segCount = LoadFontRanges(hdc, hFont, &familyPtr->startCount,
+ &familyPtr->endCount, &familyPtr->isSymbolFont);
+
+ encoding = NULL;
+ if (familyPtr->isSymbolFont != 0) {
+ /*
+ * Symbol fonts are handled specially. For instance, Unicode 0393
+ * (GREEK CAPITAL GAMMA) must be mapped to Symbol character 0047
+ * (GREEK CAPITAL GAMMA), because the Symbol font doesn't have a
+ * GREEK CAPITAL GAMMA at location 0393. If Tk interpreted the
+ * Symbol font using the Unicode encoding, it would decide that
+ * the Symbol font has no GREEK CAPITAL GAMMA, because the Symbol
+ * encoding (of course) reports that character 0393 doesn't exist.
+ *
+ * With non-symbol Windows fonts, such as Times New Roman, if the
+ * font has a GREEK CAPITAL GAMMA, it will be found in the correct
+ * Unicode location (0393); the GREEK CAPITAL GAMMA will not be off
+ * hiding at some other location.
+ */
+
+ encoding = Tcl_GetEncoding(NULL, faceName);
+ }
+
+ if (encoding == NULL) {
+ encoding = Tcl_GetEncoding(NULL, "unicode");
+ familyPtr->textOutProc =
+ (BOOL (WINAPI *)(HDC, int, int, TCHAR *, int)) TextOutW;
+ familyPtr->getTextExtentPointProc =
+ (BOOL (WINAPI *)(HDC, TCHAR *, int, LPSIZE)) GetTextExtentPointW;
+ familyPtr->isWideFont = 1;
+ } else {
+ familyPtr->textOutProc =
+ (BOOL (WINAPI *)(HDC, int, int, TCHAR *, int)) TextOutA;
+ familyPtr->getTextExtentPointProc =
+ (BOOL (WINAPI *)(HDC, TCHAR *, int, LPSIZE)) GetTextExtentPointA;
+ familyPtr->isWideFont = 0;
+ }
+
+ familyPtr->encoding = encoding;
+
+ return familyPtr;
}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * FreeFontFamily --
+ *
+ * Called to free a FontFamily when the SubFont is finished using it.
+ * Frees the contents of the FontFamily and the memory used by the
+ * FontFamily itself.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static void
+FreeFontFamily(
+ FontFamily *familyPtr) /* The FontFamily to delete. */
+{
+ int i;
+ FontFamily **familyPtrPtr;
+
+ if (familyPtr == NULL) {
+ return;
+ }
+ familyPtr->refCount--;
+ if (familyPtr->refCount > 0) {
+ return;
+ }
+ for (i = 0; i < FONTMAP_PAGES; i++) {
+ if (familyPtr->fontMap[i] != NULL) {
+ ckfree(familyPtr->fontMap[i]);
+ }
+ }
+ if (familyPtr->startCount != NULL) {
+ ckfree((char *) familyPtr->startCount);
+ }
+ if (familyPtr->endCount != NULL) {
+ ckfree((char *) familyPtr->endCount);
+ }
+ if (familyPtr->encoding != unicodeEncoding) {
+ Tcl_FreeEncoding(familyPtr->encoding);
+ }
+
+ /*
+ * Delete from list.
+ */
+
+ for (familyPtrPtr = &fontFamilyList; ; ) {
+ if (*familyPtrPtr == familyPtr) {
+ *familyPtrPtr = familyPtr->nextPtr;
+ break;
+ }
+ familyPtrPtr = &(*familyPtrPtr)->nextPtr;
+ }
+
+ ckfree((char *) familyPtr);
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * FindSubFontForChar --
+ *
+ * Determine which screen font is necessary to use to display the
+ * given character. If the font object does not have a screen font
+ * that can display the character, another screen font may be loaded
+ * into the font object, following a set of preferred fallback rules.
+ *
+ * Results:
+ * The return value is the SubFont to use to display the given
+ * character.
+ *
+ * Side effects:
+ * The contents of fontPtr are modified to cache the results
+ * of the lookup and remember any SubFonts that were dynamically
+ * loaded.
+ *
+ *-------------------------------------------------------------------------
+ */
+static SubFont *
+FindSubFontForChar(
+ WinFont *fontPtr, /* The font object with which the character
+ * will be displayed. */
+ int ch) /* The Unicode character to be displayed. */
+{
+ HDC hdc;
+ int i, j, k;
+ CanUse canUse;
+ char **aliases, **anyFallbacks;
+ char ***fontFallbacks;
+ char *fallbackName;
+ SubFont *subFontPtr;
+ Tcl_DString ds;
+
+ if (ch < BASE_CHARS) {
+ return &fontPtr->subFontArray[0];
+ }
+
+ for (i = 0; i < fontPtr->numSubFonts; i++) {
+ if (FontMapLookup(&fontPtr->subFontArray[i], ch)) {
+ return &fontPtr->subFontArray[i];
+ }
+ }
+
+ /*
+ * Keep track of all face names that we check, so we don't check some
+ * name multiple times if it can be reached by multiple paths.
+ */
+
+ Tcl_DStringInit(&ds);
+ hdc = GetDC(fontPtr->hwnd);
+
+ aliases = TkFontGetAliasList(fontPtr->font.fa.family);
+
+ fontFallbacks = TkFontGetFallbacks();
+ for (i = 0; fontFallbacks[i] != NULL; i++) {
+ for (j = 0; fontFallbacks[i][j] != NULL; j++) {
+ fallbackName = fontFallbacks[i][j];
+ if (strcasecmp(fallbackName, fontPtr->font.fa.family) == 0) {
+ /*
+ * If the base font has a fallback...
+ */
+
+ goto tryfallbacks;
+ } else if (aliases != NULL) {
+ /*
+ * Or if an alias for the base font has a fallback...
+ */
+
+ for (k = 0; aliases[k] != NULL; k++) {
+ if (strcasecmp(aliases[k], fallbackName) == 0) {
+ goto tryfallbacks;
+ }
+ }
+ }
+ }
+ continue;
+
+ /*
+ * ...then see if we can use one of the fallbacks, or an
+ * alias for one of the fallbacks.
+ */
+
+ tryfallbacks:
+ for (j = 0; fontFallbacks[i][j] != NULL; j++) {
+ fallbackName = fontFallbacks[i][j];
+ subFontPtr = CanUseFallbackWithAliases(hdc, fontPtr, fallbackName,
+ ch, &ds);
+ if (subFontPtr != NULL) {
+ goto end;
+ }
+ }
+ }
+
+ /*
+ * See if we can use something from the global fallback list.
+ */
+
+ anyFallbacks = TkFontGetGlobalClass();
+ for (i = 0; anyFallbacks[i] != NULL; i++) {
+ fallbackName = anyFallbacks[i];
+ subFontPtr = CanUseFallbackWithAliases(hdc, fontPtr, fallbackName,
+ ch, &ds);
+ if (subFontPtr != NULL) {
+ goto end;
+ }
+ }
+
+ /*
+ * Try all face names available in the whole system until we
+ * find one that can be used.
+ */
+
+ canUse.hdc = hdc;
+ canUse.fontPtr = fontPtr;
+ canUse.nameTriedPtr = &ds;
+ canUse.ch = ch;
+ canUse.subFontPtr = NULL;
+ if (platformId == VER_PLATFORM_WIN32_NT) {
+ EnumFontFamiliesW(hdc, NULL, (FONTENUMPROCW) WinFontCanUseProc,
+ (LPARAM) &canUse);
+ } else {
+ EnumFontFamiliesA(hdc, NULL, (FONTENUMPROCA) WinFontCanUseProc,
+ (LPARAM) &canUse);
+ }
+ subFontPtr = canUse.subFontPtr;
+
+ end:
+ Tcl_DStringFree(&ds);
+
+ if (subFontPtr == NULL) {
+ /*
+ * No font can display this character. We will use the base font
+ * and have it display the "unknown" character.
+ */
+
+ subFontPtr = &fontPtr->subFontArray[0];
+ FontMapInsert(subFontPtr, ch);
+ }
+ ReleaseDC(fontPtr->hwnd, hdc);
+ return subFontPtr;
+}
+
+static int CALLBACK
+WinFontCanUseProc(
+ ENUMLOGFONT *lfPtr, /* Logical-font data. */
+ NEWTEXTMETRIC *tmPtr, /* Physical-font data (not used). */
+ int fontType, /* Type of font (not used). */
+ LPARAM lParam) /* Result object to hold result. */
+{
+ int ch;
+ HDC hdc;
+ WinFont *fontPtr;
+ CanUse *canUsePtr;
+ char *fallbackName;
+ SubFont *subFontPtr;
+ Tcl_DString faceString;
+ Tcl_DString *nameTriedPtr;
+
+ canUsePtr = (CanUse *) lParam;
+ ch = canUsePtr->ch;
+ hdc = canUsePtr->hdc;
+ fontPtr = canUsePtr->fontPtr;
+ nameTriedPtr = canUsePtr->nameTriedPtr;
+
+ fallbackName = lfPtr->elfLogFont.lfFaceName;
+ Tcl_ExternalToUtfDString(systemEncoding, fallbackName, -1, &faceString);
+ fallbackName = Tcl_DStringValue(&faceString);
+
+ if (SeenName(fallbackName, nameTriedPtr) == 0) {
+ subFontPtr = CanUseFallback(hdc, fontPtr, fallbackName, ch);
+ if (subFontPtr != NULL) {
+ canUsePtr->subFontPtr = subFontPtr;
+ Tcl_DStringFree(&faceString);
+ return 0;
+ }
+ }
+ Tcl_DStringFree(&faceString);
+ return 1;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * FontMapLookup --
+ *
+ * See if the screen font can display the given character.
+ *
+ * Results:
+ * The return value is 0 if the screen font cannot display the
+ * character, non-zero otherwise.
+ *
+ * Side effects:
+ * New pages are added to the font mapping cache whenever the
+ * character belongs to a page that hasn't been seen before.
+ * When a page is loaded, information about all the characters on
+ * that page is stored, not just for the single character in
+ * question.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+FontMapLookup(
+ SubFont *subFontPtr, /* Contains font mapping cache to be queried
+ * and possibly updated. */
+ int ch) /* Character to be tested. */
+{
+ int row, bitOffset;
+
+ row = ch >> FONTMAP_SHIFT;
+ if (subFontPtr->fontMap[row] == NULL) {
+ FontMapLoadPage(subFontPtr, row);
+ }
+ bitOffset = ch & (FONTMAP_BITSPERPAGE - 1);
+ return (subFontPtr->fontMap[row][bitOffset >> 3] >> (bitOffset & 7)) & 1;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * FontMapInsert --
+ *
+ * Tell the font mapping cache that the given screen font should be
+ * used to display the specified character. This is called when no
+ * font on the system can be be found that can display that
+ * character; we lie to the font and tell it that it can display
+ * the character, otherwise we would end up re-searching the entire
+ * fallback hierarchy every time that character was seen.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * New pages are added to the font mapping cache whenever the
+ * character belongs to a page that hasn't been seen before.
+ * When a page is loaded, information about all the characters on
+ * that page is stored, not just for the single character in
+ * question.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static void
+FontMapInsert(
+ SubFont *subFontPtr, /* Contains font mapping cache to be
+ * updated. */
+ int ch) /* Character to be added to cache. */
+{
+ int row, bitOffset;
+
+ row = ch >> FONTMAP_SHIFT;
+ if (subFontPtr->fontMap[row] == NULL) {
+ FontMapLoadPage(subFontPtr, row);
+ }
+ bitOffset = ch & (FONTMAP_BITSPERPAGE - 1);
+ subFontPtr->fontMap[row][bitOffset >> 3] |= 1 << (bitOffset & 7);
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * FontMapLoadPage --
+ *
+ * Load information about all the characters on a given page.
+ * This information consists of one bit per character that indicates
+ * whether the associated HFONT can (1) or cannot (0) display the
+ * characters on the page.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Mempry allocated.
+ *
+ *-------------------------------------------------------------------------
+ */
+static void
+FontMapLoadPage(
+ SubFont *subFontPtr, /* Contains font mapping cache to be
+ * updated. */
+ int row) /* Index of the page to be loaded into
+ * the cache. */
+{
+ FontFamily *familyPtr;
+ Tcl_Encoding encoding;
+ char src[TCL_UTF_MAX], buf[16];
+ USHORT *startCount, *endCount;
+ int i, j, bitOffset, end, segCount;
+
+ subFontPtr->fontMap[row] = (char *) ckalloc(FONTMAP_BITSPERPAGE / 8);
+ memset(subFontPtr->fontMap[row], 0, FONTMAP_BITSPERPAGE / 8);
+
+ familyPtr = subFontPtr->familyPtr;
+ encoding = familyPtr->encoding;
+
+ if (familyPtr->encoding == unicodeEncoding) {
+ /*
+ * Font is Unicode. Few fonts are going to have all characters, so
+ * examine the TrueType character existence metrics to determine
+ * what characters actually exist in this font.
+ */
+
+ segCount = familyPtr->segCount;
+ startCount = familyPtr->startCount;
+ endCount = familyPtr->endCount;
+
+ j = 0;
+ end = (row + 1) << FONTMAP_SHIFT;
+ for (i = row << FONTMAP_SHIFT; i < end; i++) {
+ for ( ; j < segCount; j++) {
+ if (endCount[j] >= i) {
+ if (startCount[j] <= i) {
+ bitOffset = i & (FONTMAP_BITSPERPAGE - 1);
+ subFontPtr->fontMap[row][bitOffset >> 3] |= 1 << (bitOffset & 7);
+ }
+ break;
+ }
+ }
+ }
+ } else if (familyPtr->isSymbolFont) {
+ /*
+ * Assume that a symbol font with a known encoding has all the
+ * characters that its encoding claims it supports.
+ *
+ * The test for "encoding == unicodeEncoding"
+ * must occur before this case, to catch all symbol fonts (such
+ * as {Comic Sans MS} or Wingdings) for which we don't have
+ * encoding information; those symbol fonts are treated as if
+ * they were in the Unicode encoding and their symbolic
+ * character existence metrics are treated as if they were Unicode
+ * character existence metrics. This way, although we don't know
+ * the proper Unicode -> symbol font mapping, we can install the
+ * symbol font as the base font and access its glyphs.
+ */
+
+ end = (row + 1) << FONTMAP_SHIFT;
+ for (i = row << FONTMAP_SHIFT; i < end; i++) {
+ if (Tcl_UtfToExternal(NULL, encoding, src,
+ Tcl_UniCharToUtf(i, src), TCL_ENCODING_STOPONERROR, NULL,
+ buf, sizeof(buf), NULL, NULL, NULL) != TCL_OK) {
+ continue;
+ }
+ bitOffset = i & (FONTMAP_BITSPERPAGE - 1);
+ subFontPtr->fontMap[row][bitOffset >> 3] |= 1 << (bitOffset & 7);
+ }
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * CanUseFallbackWithAliases --
+ *
+ * Helper function for FindSubFontForChar. Determine if the
+ * specified face name (or an alias of the specified face name)
+ * can be used to construct a screen font that can display the
+ * given character.
+ *
+ * Results:
+ * See CanUseFallback().
+ *
+ * Side effects:
+ * If the name and/or one of its aliases was rejected, the
+ * rejected string is recorded in nameTriedPtr so that it won't
+ * be tried again.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static SubFont *
+CanUseFallbackWithAliases(
+ HDC hdc, /* HDC in which font can be selected. */
+ WinFont *fontPtr, /* The font object that will own the new
+ * screen font. */
+ char *faceName, /* Desired face name for new screen font. */
+ int ch, /* The Unicode character that the new
+ * screen font must be able to display. */
+ Tcl_DString *nameTriedPtr) /* Records face names that have already
+ * been tried. It is possible for the same
+ * face name to be queried multiple times when
+ * trying to find a suitable screen font. */
+{
+ int i;
+ char **aliases;
+ SubFont *subFontPtr;
+
+ if (SeenName(faceName, nameTriedPtr) == 0) {
+ subFontPtr = CanUseFallback(hdc, fontPtr, faceName, ch);
+ if (subFontPtr != NULL) {
+ return subFontPtr;
+ }
+ }
+ aliases = TkFontGetAliasList(faceName);
+ if (aliases != NULL) {
+ for (i = 0; aliases[i] != NULL; i++) {
+ if (SeenName(aliases[i], nameTriedPtr) == 0) {
+ subFontPtr = CanUseFallback(hdc, fontPtr, aliases[i], ch);
+ if (subFontPtr != NULL) {
+ return subFontPtr;
+ }
+ }
+ }
+ }
+ return NULL;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * SeenName --
+ *
+ * Used to determine we have already tried and rejected the given
+ * face name when looking for a screen font that can support some
+ * Unicode character.
+ *
+ * Results:
+ * The return value is 0 if this face name has not already been seen,
+ * non-zero otherwise.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+SeenName(
+ CONST char *name, /* The name to check. */
+ Tcl_DString *dsPtr) /* Contains names that have already been
+ * seen. */
+{
+ CONST char *seen, *end;
+
+ seen = Tcl_DStringValue(dsPtr);
+ end = seen + Tcl_DStringLength(dsPtr);
+ while (seen < end) {
+ if (strcasecmp(seen, name) == 0) {
+ return 1;
+ }
+ seen += strlen(seen) + 1;
+ }
+ Tcl_DStringAppend(dsPtr, (char *) name, (int) (strlen(name) + 1));
+ return 0;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * CanUseFallback --
+ *
+ * If the specified screen font has not already been loaded into
+ * the font object, determine if it can display the given character.
+ *
+ * Results:
+ * The return value is a pointer to a newly allocated SubFont, owned
+ * by the font object. This SubFont can be used to display the given
+ * character. The SubFont represents the screen font with the base set
+ * of font attributes from the font object, but using the specified
+ * font name. NULL is returned if the font object already holds
+ * a reference to the specified physical font or if the specified
+ * physical font cannot display the given character.
+ *
+ * Side effects:
+ * The font object's subFontArray is updated to contain a reference
+ * to the newly allocated SubFont.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static SubFont *
+CanUseFallback(
+ HDC hdc, /* HDC in which font can be selected. */
+ WinFont *fontPtr, /* The font object that will own the new
+ * screen font. */
+ char *faceName, /* Desired face name for new screen font. */
+ int ch) /* The Unicode character that the new
+ * screen font must be able to display. */
+{
+ int i;
+ HFONT hFont;
+ SubFont subFont;
+
+ if (FamilyExists(hdc, faceName) == 0) {
+ return NULL;
+ }
+
+ /*
+ * Skip all fonts we've already used.
+ */
+
+ for (i = 0; i < fontPtr->numSubFonts; i++) {
+ if (faceName == fontPtr->subFontArray[i].familyPtr->faceName) {
+ return NULL;
+ }
+ }
+
+ /*
+ * Load this font and see if it has the desired character.
+ */
+
+ hFont = GetScreenFont(&fontPtr->font.fa, faceName, fontPtr->pixelSize);
+ InitSubFont(hdc, hFont, 0, &subFont);
+ if (((ch < 256) && (subFont.familyPtr->isSymbolFont))
+ || (FontMapLookup(&subFont, ch) == 0)) {
+ /*
+ * Don't use a symbol font as a fallback font for characters below
+ * 256.
+ */
+
+ ReleaseSubFont(&subFont);
+ return NULL;
+ }
+
+ if (fontPtr->numSubFonts >= SUBFONT_SPACE) {
+ SubFont *newPtr;
+
+ newPtr = (SubFont *) ckalloc(sizeof(SubFont)
+ * (fontPtr->numSubFonts + 1));
+ memcpy((char *) newPtr, fontPtr->subFontArray,
+ fontPtr->numSubFonts * sizeof(SubFont));
+ if (fontPtr->subFontArray != fontPtr->staticSubFonts) {
+ ckfree((char *) fontPtr->subFontArray);
+ }
+ fontPtr->subFontArray = newPtr;
+ }
+ fontPtr->subFontArray[fontPtr->numSubFonts] = subFont;
+ fontPtr->numSubFonts++;
+ return &fontPtr->subFontArray[fontPtr->numSubFonts - 1];
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * GetScreenFont --
+ *
+ * Given the name and other attributes, construct an HFONT.
+ * This is where all the alias and fallback substitution bottoms
+ * out.
+ *
+ * Results:
+ * The screen font that corresponds to the attributes.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static HFONT
+GetScreenFont(
+ CONST TkFontAttributes *faPtr,
+ /* Desired font attributes for new HFONT. */
+ CONST char *faceName, /* Overrides font family specified in font
+ * attributes. */
+ int pixelSize) /* Overrides size specified in font
+ * attributes. */
+{
+ Tcl_DString ds;
+ HFONT hFont;
+ LOGFONTW lf;
+
+ lf.lfHeight = -pixelSize;
+ lf.lfWidth = 0;
+ lf.lfEscapement = 0;
+ lf.lfOrientation = 0;
+ lf.lfWeight = (faPtr->weight == TK_FW_NORMAL) ? FW_NORMAL : FW_BOLD;
+ lf.lfItalic = faPtr->slant;
+ lf.lfUnderline = faPtr->underline;
+ lf.lfStrikeOut = faPtr->overstrike;
+ lf.lfCharSet = DEFAULT_CHARSET;
+ lf.lfOutPrecision = OUT_TT_PRECIS;
+ lf.lfClipPrecision = CLIP_DEFAULT_PRECIS;
+ lf.lfQuality = DEFAULT_QUALITY;
+ lf.lfPitchAndFamily = DEFAULT_PITCH | FF_DONTCARE;
+
+ Tcl_UtfToExternalDString(systemEncoding, faceName, -1, &ds);
+
+ if (platformId == VER_PLATFORM_WIN32_NT) {
+ Tcl_UniChar *src, *dst;
+ src = (Tcl_UniChar *) Tcl_DStringValue(&ds);
+ dst = (Tcl_UniChar *) lf.lfFaceName;
+ while (*src != '\0') {
+ *dst++ = *src++;
+ }
+ *dst = '\0';
+ hFont = CreateFontIndirectW(&lf);
+ } else {
+ strcpy((char *) lf.lfFaceName, Tcl_DStringValue(&ds));
+ hFont = CreateFontIndirectA((LOGFONTA *) &lf);
+ }
+ Tcl_DStringFree(&ds);
+ return hFont;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * FamilyExists, FamilyOrAliasExists, WinFontExistsProc --
+ *
+ * Determines if any physical screen font exists on the system with
+ * the given family name. If the family exists, then it should be
+ * possible to construct some physical screen font with that family
+ * name.
+ *
+ * Results:
+ * The return value is 0 if the specified font family does not exist,
+ * non-zero otherwise.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+FamilyExists(
+ HDC hdc, /* HDC in which font family will be used. */
+ CONST char *faceName) /* Font family to query. */
+{
+ int result;
+ Tcl_DString faceString;
+
+ /*
+ * Just immediately rule out the following fonts, because they look so
+ * ugly on windows. The caller's fallback mechanism will cause the
+ * corresponding appropriate TrueType fonts to be selected.
+ */
+
+ if (strcasecmp(faceName, "Courier") == 0) {
+ return 0;
+ }
+ if (strcasecmp(faceName, "Times") == 0) {
+ return 0;
+ }
+ if (strcasecmp(faceName, "Helvetica") == 0) {
+ return 0;
+ }
+
+ Tcl_UtfToExternalDString(systemEncoding, faceName, -1, &faceString);
+
+ /*
+ * If the family exists, WinFontExistProc() will be called and
+ * EnumFontFamilies() will return whatever WinFontExistProc() returns.
+ * If the family doesn't exist, EnumFontFamilies() will just return a
+ * non-zero value.
+ */
+
+ if (platformId == VER_PLATFORM_WIN32_NT) {
+ result = EnumFontFamiliesW(hdc, (WCHAR *) Tcl_DStringValue(&faceString),
+ (FONTENUMPROCW) WinFontExistProc, 0);
+ } else {
+ result = EnumFontFamiliesA(hdc, (char *) Tcl_DStringValue(&faceString),
+ (FONTENUMPROCA) WinFontExistProc, 0);
+ }
+ Tcl_DStringFree(&faceString);
+ return (result == 0);
+}
+
+static char *
+FamilyOrAliasExists(
+ HDC hdc,
+ CONST char *faceName)
+{
+ char **aliases;
+ int i;
+
+ if (FamilyExists(hdc, faceName) != 0) {
+ return (char *) faceName;
+ }
+ aliases = TkFontGetAliasList(faceName);
+ if (aliases != NULL) {
+ for (i = 0; aliases[i] != NULL; i++) {
+ if (FamilyExists(hdc, aliases[i]) != 0) {
+ return aliases[i];
+ }
+ }
+ }
+ return NULL;
+}
+
+static int CALLBACK
+WinFontExistProc(
+ ENUMLOGFONT *lfPtr, /* Logical-font data. */
+ NEWTEXTMETRIC *tmPtr, /* Physical-font data (not used). */
+ int fontType, /* Type of font (not used). */
+ LPARAM lParam) /* EnumFontData to hold result. */
+{
+ return 0;
+}
+
+/*
+ * The following data structures are used when querying a TrueType font file
+ * to determine which characters the font supports.
+ */
+
+#pragma pack(1) /* Structures are byte aligned in file. */
+
+#define CMAPHEX 0x636d6170 /* Key for character map resource. */
+
+typedef struct CMAPTABLE {
+ USHORT version; /* Table version number (0). */
+ USHORT numTables; /* Number of encoding tables following. */
+} CMAPTABLE;
+
+typedef struct ENCODINGTABLE {
+ USHORT platform; /* Platform for which data is targeted.
+ * 3 means data is for Windows. */
+ USHORT encoding; /* How characters in font are encoded.
+ * 1 means that the following subtable is
+ * keyed based on Unicode. */
+ ULONG offset; /* Byte offset from beginning of CMAPTABLE
+ * to the subtable for this encoding. */
+} ENCODINGTABLE;
+
+typedef struct ANYTABLE {
+ USHORT format; /* Format number. */
+ USHORT length; /* The actual length in bytes of this
+ * subtable. */
+ USHORT version; /* Version number (starts at 0). */
+} ANYTABLE;
+
+typedef struct BYTETABLE {
+ USHORT format; /* Format number is set to 0. */
+ USHORT length; /* The actual length in bytes of this
+ * subtable. */
+ USHORT version; /* Version number (starts at 0). */
+ BYTE glyphIdArray[256]; /* Array that maps up to 256 single-byte char
+ * codes to glyph indices. */
+} BYTETABLE;
+
+typedef struct SUBHEADER {
+ USHORT firstCode; /* First valid low byte for subHeader. */
+ USHORT entryCount; /* Number valid low bytes for subHeader. */
+ SHORT idDelta; /* Constant adder to get base glyph index. */
+ USHORT idRangeOffset; /* Byte offset from here to appropriate
+ * glyphIndexArray. */
+} SUBHEADER;
+
+typedef struct HIBYTETABLE {
+ USHORT format; /* Format number is set to 2. */
+ USHORT length; /* The actual length in bytes of this
+ * subtable. */
+ USHORT version; /* Version number (starts at 0). */
+ USHORT subHeaderKeys[256]; /* Maps high bytes to subHeaders: value is
+ * subHeader index * 8. */
+#if 0
+ SUBHEADER subHeaders[]; /* Variable-length array of SUBHEADERs. */
+ USHORT glyphIndexArray[]; /* Variable-length array containing subarrays
+ * used for mapping the low byte of 2-byte
+ * characters. */
+#endif
+} HIBYTETABLE;
+
+typedef struct SEGMENTTABLE {
+ USHORT format; /* Format number is set to 4. */
+ USHORT length; /* The actual length in bytes of this
+ * subtable. */
+ USHORT version; /* Version number (starts at 0). */
+ USHORT segCountX2; /* 2 x segCount. */
+ USHORT searchRange; /* 2 x (2**floor(log2(segCount))). */
+ USHORT entrySelector; /* log2(searchRange/2). */
+ USHORT rangeShift; /* 2 x segCount - searchRange. */
+#if 0
+ USHORT endCount[segCount] /* End characterCode for each segment. */
+ USHORT reservedPad; /* Set to 0. */
+ USHORT startCount[segCount];/* Start character code for each segment. */
+ USHORT idDelta[segCount]; /* Delta for all character in segment. */
+ USHORT idRangeOffset[segCount]; /* Offsets into glyphIdArray or 0. */
+ USHORT glyphIdArray[] /* Glyph index array. */
+#endif
+} SEGMENTTABLE;
+
+typedef struct TRIMMEDTABLE {
+ USHORT format; /* Format number is set to 6. */
+ USHORT length; /* The actual length in bytes of this
+ * subtable. */
+ USHORT version; /* Version number (starts at 0). */
+ USHORT firstCode; /* First character code of subrange. */
+ USHORT entryCount; /* Number of character codes in subrange. */
+#if 0
+ USHORT glyphIdArray[]; /* Array of glyph index values for
+ character codes in the range. */
+#endif
+} TRIMMEDTABLE;
+
+typedef union SUBTABLE {
+ ANYTABLE any;
+ BYTETABLE byte;
+ HIBYTETABLE hiByte;
+ SEGMENTTABLE segment;
+ TRIMMEDTABLE trimmed;
+} SUBTABLE;
+
+#pragma pack()
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * LoadFontRanges --
+ *
+ * Given an HFONT, get the information about the characters that
+ * this font can display.
+ *
+ * Results:
+ * If the font has no Unicode character information, the return value
+ * is 0 and *startCountPtr and *endCountPtr are filled with NULL.
+ * Otherwise, *startCountPtr and *endCountPtr are set to pointers to
+ * arrays of TrueType character existence information and the return
+ * value is the length of the arrays (the two arrays are always the
+ * same length as each other).
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+LoadFontRanges(
+ HDC hdc, /* HDC into which font can be selected. */
+ HFONT hFont, /* HFONT to query. */
+ USHORT **startCountPtr, /* Filled with malloced pointer to
+ * character range information. */
+ USHORT **endCountPtr, /* Filled with malloced pointer to
+ * character range information. */
+ int *symbolPtr)
+ {
+ int n, i, swapped, offset, cbData, segCount;
+ DWORD cmapKey;
+ USHORT *startCount, *endCount;
+ CMAPTABLE cmapTable;
+ ENCODINGTABLE encTable;
+ SUBTABLE subTable;
+ char *s;
+
+ segCount = 0;
+ startCount = NULL;
+ endCount = NULL;
+ *symbolPtr = 0;
+
+ hFont = SelectObject(hdc, hFont);
+
+ i = 0;
+ s = (char *) &i;
+ *s = '\1';
+ swapped = 0;
+
+ if (i == 1) {
+ swapped = 1;
+ }
+
+ cmapKey = CMAPHEX;
+ if (swapped) {
+ SwapLong(&cmapKey);
+ }
+
+ n = GetFontData(hdc, cmapKey, 0, &cmapTable, sizeof(cmapTable));
+ if (n != GDI_ERROR) {
+ if (swapped) {
+ SwapShort(&cmapTable.numTables);
+ }
+ for (i = 0; i < cmapTable.numTables; i++) {
+ offset = sizeof(cmapTable) + i * sizeof(encTable);
+ GetFontData(hdc, cmapKey, offset, &encTable, sizeof(encTable));
+ if (swapped) {
+ SwapShort(&encTable.platform);
+ SwapShort(&encTable.encoding);
+ SwapLong(&encTable.offset);
+ }
+ if (encTable.platform != 3) {
+ /*
+ * Not Microsoft encoding.
+ */
+
+ continue;
+ }
+ if (encTable.encoding == 0) {
+ *symbolPtr = 1;
+ } else if (encTable.encoding != 1) {
+ continue;
+ }
+
+ GetFontData(hdc, cmapKey, encTable.offset, &subTable,
+ sizeof(subTable));
+ if (swapped) {
+ SwapShort(&subTable.any.format);
+ }
+ if (subTable.any.format == 4) {
+ if (swapped) {
+ SwapShort(&subTable.segment.segCountX2);
+ }
+ segCount = subTable.segment.segCountX2 / 2;
+ cbData = segCount * sizeof(USHORT);
+
+ startCount = (USHORT *) ckalloc(cbData);
+ endCount = (USHORT *) ckalloc(cbData);
+
+ offset = encTable.offset + sizeof(subTable.segment);
+ GetFontData(hdc, cmapKey, offset, endCount, cbData);
+ offset += cbData + sizeof(USHORT);
+ GetFontData(hdc, cmapKey, offset, startCount, cbData);
+ if (swapped) {
+ for (i = 0; i < segCount; i++) {
+ SwapShort(&endCount[i]);
+ SwapShort(&startCount[i]);
+ }
+ }
+ if (*symbolPtr != 0) {
+ /*
+ * Empirically determined: When a symbol font is
+ * loaded, the character existence metrics obtained
+ * from the system are mildly wrong. If the real range
+ * of the symbol font is from 0020 to 00FE, then the
+ * metrics are reported as F020 to F0FE. When we load
+ * a symbol font, we must fix the character existence
+ * metrics.
+ */
+
+ for (i = 0; i < segCount; i++) {
+ if ((startCount[i] & 0xff00) == 0xf000) {
+ startCount[i] &= 0xff;
+ }
+ if ((endCount[i] & 0xff00) == 0xf000) {
+ endCount[i] &= 0xff;
+ }
+ }
+ }
+ }
+ }
+ }
+ SelectObject(hdc, hFont);
+
+ *startCountPtr = startCount;
+ *endCountPtr = endCount;
+ return segCount;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * SwapShort, SwapLong --
+ *
+ * Helper functions to convert the data loaded from TrueType font
+ * files to Intel byte ordering.
+ *
+ * Results:
+ * Bytes of input value are swapped and stored back in argument.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static void
+SwapShort(PUSHORT p)
+{
+ *p = (SHORT)(HIBYTE(*p) + (LOBYTE(*p) << 8));
+}
+
+static void
+SwapLong(PULONG p)
+{
+ ULONG temp;
+
+ temp = (LONG) ((BYTE) *p);
+ temp <<= 8;
+ *p >>=8;
+
+ temp += (LONG) ((BYTE) *p);
+ temp <<= 8;
+ *p >>=8;
+
+ temp += (LONG) ((BYTE) *p);
+ temp <<= 8;
+ *p >>=8;
+
+ temp += (LONG) ((BYTE) *p);
+ *p = temp;
+}
diff --git a/win/tkWinInit.c b/win/tkWinInit.c
index 400f693..b311bae 100644
--- a/win/tkWinInit.c
+++ b/win/tkWinInit.c
@@ -9,7 +9,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * SCCS: @(#) tkWinInit.c 1.29 97/07/24 14:46:35
+ * SCCS: @(#) tkWinInit.c 1.30 97/11/07 21:25:45
*/
#include "tkWinInt.h"
@@ -31,7 +31,7 @@
*
* Results:
* A standard Tcl completion code (TCL_OK or TCL_ERROR). Also
- * leaves information in interp->result.
+ * leaves information in the interp's result.
*
* Side effects:
* Sets "tk_library" Tcl variable, runs "tk.tcl" script.
diff --git a/win/tkWinInt.h b/win/tkWinInt.h
index f3bca19..8198b6b 100644
--- a/win/tkWinInt.h
+++ b/win/tkWinInt.h
@@ -5,12 +5,12 @@
* Windows-specific parts of Tk, but aren't used by the rest of
* Tk.
*
- * Copyright (c) 1995 Sun Microsystems, Inc.
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * SCCS: @(#) tkWinInt.h 1.34 97/09/02 13:06:20
+ * SCCS: @(#) tkWinInt.h 1.36 97/10/02 17:30:22
*/
#ifndef _TKWININT
@@ -28,6 +28,11 @@
#include "tkWin.h"
#endif
+#ifndef _TKPORT
+#include "tkPort.h"
+#endif
+
+
/*
* Define constants missing from older Win32 SDK header files.
*/
@@ -150,6 +155,7 @@ extern LRESULT CALLBACK TkWinChildProc _ANSI_ARGS_((HWND hwnd, UINT message,
WPARAM wParam, LPARAM lParam));
extern void TkWinClipboardRender _ANSI_ARGS_((TkDisplay *dispPtr,
UINT format));
+extern void TkWinDialogDebug _ANSI_ARGS_((int debug));
extern LRESULT TkWinEmbeddedEventProc _ANSI_ARGS_((HWND hwnd,
UINT message, WPARAM wParam, LPARAM lParam));
extern void TkWinFillRect _ANSI_ARGS_((HDC dc, int x, int y,
@@ -158,7 +164,10 @@ extern COLORREF TkWinGetBorderPixels _ANSI_ARGS_((Tk_Window tkwin,
Tk_3DBorder border, int which));
extern HDC TkWinGetDrawableDC _ANSI_ARGS_((Display *display,
Drawable d, TkWinDCState* state));
+extern Tcl_Obj * TkWinGetMenuSystemDefault _ANSI_ARGS_((Tk_Window tkwin,
+ char *dbName, char *className));
extern int TkWinGetModifierState _ANSI_ARGS_((void));
+extern int TkWinGetPlatformId();
extern HPALETTE TkWinGetSystemPalette _ANSI_ARGS_((void));
extern HWND TkWinGetWrapperWindow _ANSI_ARGS_((Tk_Window tkwin));
extern int TkWinHandleMenuEvent _ANSI_ARGS_((HWND *phwnd,
@@ -190,5 +199,6 @@ extern void TkWinWmStoreEmbedAssociation _ANSI_ARGS_((
extern void TkWinXCleanup _ANSI_ARGS_((HINSTANCE hInstance));
extern void TkWinXInit _ANSI_ARGS_((HINSTANCE hInstance));
+
#endif /* _TKWININT */
diff --git a/win/tkWinKey.c b/win/tkWinKey.c
index 3589143..bc74c43 100644
--- a/win/tkWinKey.c
+++ b/win/tkWinKey.c
@@ -9,7 +9,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * SCCS: @(#) tkWinKey.c 1.9 97/06/20 15:12:39
+ * SCCS: @(#) tkWinKey.c 1.11 98/01/13 20:26:49
*/
#include "tkWinInt.h"
@@ -79,71 +79,59 @@ static Keys keymap[] = {
/*
*----------------------------------------------------------------------
*
- * XLookupString --
+ * TkpGetString --
*
- * Retrieve the string equivalent for the given keyboard event.
+ * Retrieve the UTF string equivalent for the given keyboard event.
*
* Results:
- * Returns the number of characters stored in buffer_return.
+ * Returns the UTF string.
*
* Side effects:
- * Retrieves the characters stored in the event and inserts them
- * into buffer_return.
+ * None.
*
*----------------------------------------------------------------------
*/
-int
-XLookupString(event_struct, buffer_return, bytes_buffer, keysym_return,
- status_in_out)
- XKeyEvent* event_struct;
- char* buffer_return;
- int bytes_buffer;
- KeySym* keysym_return;
- XComposeStatus* status_in_out;
+char *
+TkpGetString(winPtr, eventPtr, dsPtr)
+ TkWindow *winPtr; /* Window where event occurred: needed to
+ * get input context. */
+ XEvent *eventPtr; /* X keyboard event. */
+ Tcl_DString *dsPtr; /* Uninitialized or empty string to hold
+ * result. */
{
- int i, limit;
+ int index;
+ KeySym keysym;
+ XKeyEvent* keyEv = &eventPtr->xkey;
- if (event_struct->send_event != -1) {
+ Tcl_DStringInit(dsPtr);
+ if (eventPtr->xkey.send_event != -1) {
/*
* This is an event generated from generic code. It has no
* nchars or trans_chars members.
*/
- int index;
- KeySym keysym;
-
index = 0;
- if (event_struct->state & ShiftMask) {
+ if (eventPtr->xkey.state & ShiftMask) {
index |= 1;
}
- if (event_struct->state & Mod1Mask) {
+ if (eventPtr->xkey.state & Mod1Mask) {
index |= 2;
}
- keysym = XKeycodeToKeysym(event_struct->display,
- event_struct->keycode, index);
+ keysym = XKeycodeToKeysym(eventPtr->xkey.display,
+ eventPtr->xkey.keycode, index);
if (((keysym != NoSymbol) && (keysym > 0) && (keysym < 256))
|| (keysym == XK_Return)
|| (keysym == XK_Tab)) {
- buffer_return[0] = (char) keysym;
- return 1;
+ char buf[TCL_UTF_MAX];
+ int len = Tcl_UniCharToUtf((Tcl_UniChar) keysym, buf);
+ Tcl_DStringAppend(dsPtr, buf, len);
}
- return 0;
- }
- if ((event_struct->nchars <= 0) || (buffer_return == NULL)) {
- return 0;
- }
- limit = (event_struct->nchars < bytes_buffer) ? event_struct->nchars :
- bytes_buffer;
-
- for (i = 0; i < limit; i++) {
- buffer_return[i] = event_struct->trans_chars[i];
- }
-
- if (keysym_return != NULL) {
- *keysym_return = NoSymbol;
+ } else if (eventPtr->xkey.nbytes > 0) {
+ Tcl_ExternalToUtfDString(NULL, eventPtr->xkey.trans_chars,
+ eventPtr->xkey.nbytes, dsPtr);
}
- return i;
+ return Tcl_DStringValue(dsPtr);
}
/*
@@ -189,8 +177,8 @@ XKeycodeToKeysym(display, keycode, index)
* for alphanumeric characters map onto Latin-1, we just return it.
*/
- if (result == 1 && buf[0] >= 0x20) {
- return (KeySym) buf[0];
+ if (result == 1 && UCHAR(buf[0]) >= 0x20) {
+ return (KeySym) UCHAR(buf[0]);
}
/*
diff --git a/win/tkWinMenu.c b/win/tkWinMenu.c
index 00e24b7..44f53fc 100644
--- a/win/tkWinMenu.c
+++ b/win/tkWinMenu.c
@@ -1,20 +1,21 @@
/*
* tkWinMenu.c --
*
- * This module implements the Mac-platform specific features of menus.
+ * This module implements the Windows-platform specific features of menus.
*
- * Copyright (c) 1996-1997 by Sun Microsystems, Inc.
+ * Copyright (c) 1996-1998 by Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * SCCS: @(#) tkWinMenu.c 1.102 97/10/28 13:56:58
+ * SCCS: @(#) tkWinMenu.c 1.110 98/01/26 19:43:53
*/
#define OEMRESOURCE
-#include <string.h>
-#include "tkMenu.h"
#include "tkWinInt.h"
+#include "tkMenu.h"
+
+#include <string.h>
/*
* The class of the window for popup menus.
@@ -74,7 +75,7 @@ static Tcl_HashTable winMenuTable;
* The following are default menu value strings.
*/
-static char borderString[5]; /* The string indicating how big the border is */
+static int defaultBorderWidth; /* The windows default border width. */
static Tcl_DString menuFontDString;
/* A buffer to store the default menu font
* string. */
@@ -122,7 +123,7 @@ static void DrawWindowsSystemBitmap _ANSI_ARGS_((
GC gc, CONST RECT *rectPtr, int bitmapID,
int alignFlags));
static void FreeID _ANSI_ARGS_((int commandID));
-static char * GetEntryText _ANSI_ARGS_((TkMenuEntry *mePtr));
+static TCHAR * GetEntryText _ANSI_ARGS_((TkMenuEntry *mePtr));
static void GetMenuAccelGeometry _ANSI_ARGS_((TkMenu *menuPtr,
TkMenuEntry *mePtr, Tk_Font tkfont,
CONST Tk_FontMetrics *fmPtr, int *widthPtr,
@@ -154,6 +155,7 @@ static void ReconfigureWindowsMenu _ANSI_ARGS_((
ClientData clientData));
static void RecursivelyClearActiveMenu _ANSI_ARGS_((
TkMenu *menuPtr));
+static void SetDefaults _ANSI_ARGS_((int firstTime));
static LRESULT CALLBACK TkWinMenuProc _ANSI_ARGS_((HWND hwnd,
UINT message, WPARAM wParam,
LPARAM lParam));
@@ -315,6 +317,7 @@ TkpDestroyMenu(menuPtr)
TkMenu *menuPtr; /* The common menu structure */
{
HMENU winMenuHdl = (HMENU) menuPtr->platformData;
+ char *searchName;
if (menuPtr->menuFlags & MENU_RECONFIGURE_PENDING) {
Tcl_CancelIdleCall(ReconfigureWindowsMenu, (ClientData) menuPtr);
@@ -330,7 +333,9 @@ TkpDestroyMenu(menuPtr)
for (searchEntryPtr = menuPtr->menuRefPtr->parentEntryPtr;
searchEntryPtr != NULL;
searchEntryPtr = searchEntryPtr->nextCascadePtr) {
- if (strcmp(searchEntryPtr->name,
+ searchName = Tcl_GetStringFromObj(searchEntryPtr->namePtr,
+ NULL);
+ if (strcmp(searchName,
menuName) == 0) {
Tk_Window parentTopLevelPtr = searchEntryPtr
->menuPtr->parentTopLevelPtr;
@@ -410,18 +415,22 @@ GetEntryText(mePtr)
if (mePtr->type == TEAROFF_ENTRY) {
itemText = ckalloc(sizeof("(Tear-off)"));
strcpy(itemText, "(Tear-off)");
- } else if (mePtr->imageString != NULL) {
+ } else if (mePtr->imagePtr != NULL) {
itemText = ckalloc(sizeof("(Image)"));
strcpy(itemText, "(Image)");
- } else if (mePtr->bitmap != None) {
+ } else if (mePtr->bitmapPtr != NULL) {
itemText = ckalloc(sizeof("(Pixmap)"));
strcpy(itemText, "(Pixmap)");
- } else if (mePtr->label == NULL || mePtr->labelLength == 0) {
+ } else if (mePtr->labelPtr == NULL || mePtr->labelLength == 0) {
itemText = ckalloc(sizeof("( )"));
strcpy(itemText, "( )");
} else {
int size = mePtr->labelLength + 1;
int i, j;
+ char *label = (mePtr->labelPtr == NULL) ? ""
+ : Tcl_GetStringFromObj(mePtr->labelPtr, NULL);
+ char *accel = (mePtr->accelPtr == NULL) ? ""
+ : Tcl_GetStringFromObj(mePtr->accelPtr, NULL);
/*
* We have to construct the string with an ampersand
@@ -431,14 +440,14 @@ GetEntryText(mePtr)
*/
for (i = 0; i < mePtr->labelLength; i++) {
- if (mePtr->label[i] == '&') {
+ if (label[i] == '&') {
size++;
}
}
if (mePtr->underline >= 0) {
size++;
- if (mePtr->label[mePtr->underline] == '&') {
+ if (label[mePtr->underline] == '&') {
size++;
}
}
@@ -448,7 +457,7 @@ GetEntryText(mePtr)
}
for (i = 0; i < mePtr->accelLength; i++) {
- if (mePtr->accel[i] == '&') {
+ if (accel[i] == '&') {
size++;
}
}
@@ -459,13 +468,13 @@ GetEntryText(mePtr)
itemText[0] = 0;
} else {
for (i = 0, j = 0; i < mePtr->labelLength; i++, j++) {
- if (mePtr->label[i] == '&') {
+ if (label[i] == '&') {
itemText[j++] = '&';
}
if (i == mePtr->underline) {
itemText[j++] = '&';
}
- itemText[j] = mePtr->label[i];
+ itemText[j] = label[i];
}
itemText[j] = '\0';
}
@@ -474,10 +483,10 @@ GetEntryText(mePtr)
strcat(itemText, "\t");
for (i = 0, j = strlen(itemText); i < mePtr->accelLength;
i++, j++) {
- if (mePtr->accel[i] == '&') {
+ if (accel[i] == '&') {
itemText[j++] = '&';
}
- itemText[j] = mePtr->accel[i];
+ itemText[j] = accel[i];
}
itemText[j] = '\0';
}
@@ -509,8 +518,8 @@ ReconfigureWindowsMenu(
TkMenu *menuPtr = (TkMenu *) clientData;
TkMenuEntry *mePtr;
HMENU winMenuHdl = (HMENU) menuPtr->platformData;
- char *itemText = NULL;
- LPCTSTR lpNewItem;
+ TCHAR *itemText = NULL;
+ const TCHAR *lpNewItem;
UINT flags;
UINT itemID;
int i, count, systemMenu = 0, base;
@@ -552,6 +561,8 @@ ReconfigureWindowsMenu(
if (mePtr->type == SEPARATOR_ENTRY) {
flags |= MF_SEPARATOR;
} else {
+ int columnBreak, state;
+
itemText = GetEntryText(mePtr);
if ((menuPtr->menuType == MENUBAR)
|| (menuPtr->menuFlags & MENU_SYSTEM_MENU)) {
@@ -565,7 +576,9 @@ ReconfigureWindowsMenu(
* Set enabling and disabling correctly.
*/
- if (mePtr->state == tkDisabledUid) {
+ Tcl_GetIndexFromObj(NULL, mePtr->statePtr, tkMenuStateStrings,
+ NULL, 0, &state);
+ if (state == ENTRY_DISABLED) {
flags |= MF_DISABLED;
}
@@ -579,7 +592,9 @@ ReconfigureWindowsMenu(
flags |= MF_CHECKED;
}
- if (mePtr->columnBreak) {
+ Tcl_GetBooleanFromObj(NULL, mePtr->columnBreakPtr,
+ &columnBreak);
+ if (columnBreak) {
flags |= MF_MENUBREAK;
}
@@ -603,10 +618,6 @@ ReconfigureWindowsMenu(
char *systemMenuName = ckalloc(strlen(
Tk_PathName(menuPtr->masterMenuPtr->tkwin))
+ strlen(".system") + 1);
-
- strcpy(systemMenuName,
- Tk_PathName(menuPtr->masterMenuPtr->tkwin));
- strcat(systemMenuName, ".system");
menuRefPtr = TkFindMenuReferences(menuPtr->interp,
systemMenuName);
if ((menuRefPtr != NULL)
@@ -904,6 +915,7 @@ TkWinHandleMenuEvent(phwnd, pMessage, pwParam, plParam, plResult)
if (mePtr != NULL) {
TkMenuReferences *menuRefPtr;
TkMenuEntry *parentEntryPtr;
+ int code;
/*
* We have to set the parent of this menu to be active
@@ -914,28 +926,40 @@ TkWinHandleMenuEvent(phwnd, pMessage, pwParam, plParam, plResult)
menuPtr = mePtr->menuPtr;
menuRefPtr = TkFindMenuReferences(menuPtr->interp,
Tk_PathName(menuPtr->tkwin));
- if ((menuRefPtr != NULL) && (menuRefPtr->parentEntryPtr
- != NULL)) {
- for (parentEntryPtr = menuRefPtr->parentEntryPtr;
- strcmp(parentEntryPtr->name,
- Tk_PathName(menuPtr->tkwin)) != 0;
- parentEntryPtr = parentEntryPtr->nextCascadePtr) {
-
- /*
- * Empty loop body.
- */
+ if ((menuRefPtr != NULL)
+ && (menuRefPtr->parentEntryPtr != NULL)) {
+ char *name;
+ int state;
+ for (parentEntryPtr = menuRefPtr->parentEntryPtr;
+ ;
+ parentEntryPtr =
+ parentEntryPtr->nextCascadePtr) {
+ name = Tcl_GetStringFromObj(
+ parentEntryPtr->namePtr, NULL);
+ if (strcmp(name, Tk_PathName(menuPtr->tkwin))
+ == 0) {
+ break;
+ }
}
- if (parentEntryPtr->menuPtr
- ->entries[parentEntryPtr->index]->state
- != tkDisabledUid) {
+ Tcl_GetIndexFromObj(NULL, parentEntryPtr->menuPtr
+ ->entries[parentEntryPtr->index]
+ ->statePtr, tkMenuStateStrings, NULL,
+ 0, &state);
+ if (state != ENTRY_DISABLED) {
TkActivateMenuEntry(parentEntryPtr->menuPtr,
parentEntryPtr->index);
}
}
- TkInvokeMenu(mePtr->menuPtr->interp,
+ code = TkInvokeMenu(mePtr->menuPtr->interp,
menuPtr, mePtr->index);
+ if (code != TCL_OK && code != TCL_CONTINUE
+ && code != TCL_BREAK) {
+ Tcl_AddErrorInfo(mePtr->menuPtr->interp,
+ "\n (menu invoke)");
+ Tcl_BackgroundError(mePtr->menuPtr->interp);
+ }
}
*plResult = 0;
returnResult = 1;
@@ -954,12 +978,19 @@ TkWinHandleMenuEvent(phwnd, pMessage, pwParam, plParam, plResult)
*plResult = 0;
menuPtr = (TkMenu *) Tcl_GetHashValue(hashEntryPtr);
for (i = 0; i < menuPtr->numEntries; i++) {
- int underline = menuPtr->entries[i]->underline;
+ int underline;
+ char *label;
+
+ underline = menuPtr->entries[i]->underline;
+ if (menuPtr->entries[i]->labelPtr != NULL) {
+ label = Tcl_GetStringFromObj(
+ menuPtr->entries[i]->labelPtr, NULL);
+ }
if ((-1 != underline)
- && (NULL != menuPtr->entries[i]->label)
+ && (NULL != menuPtr->entries[i]->labelPtr)
&& (CharUpper((LPTSTR) menuChar)
- == CharUpper((LPTSTR) (unsigned char) menuPtr
- ->entries[i]->label[underline]))) {
+ == CharUpper((LPTSTR) (unsigned char)
+ label[underline]))) {
*plResult = (2 << 16) | i;
break;
}
@@ -973,16 +1004,25 @@ TkWinHandleMenuEvent(phwnd, pMessage, pwParam, plParam, plResult)
LPMEASUREITEMSTRUCT itemPtr = (LPMEASUREITEMSTRUCT) *plParam;
if (itemPtr != NULL) {
+ int hideMargin;
+
mePtr = (TkMenuEntry *) itemPtr->itemData;
menuPtr = mePtr->menuPtr;
TkRecomputeMenu(menuPtr);
itemPtr->itemHeight = mePtr->height;
itemPtr->itemWidth = mePtr->width;
- if (mePtr->hideMargin) {
- itemPtr->itemWidth += 2 - indicatorDimensions[0];
+ Tcl_GetBooleanFromObj(NULL, mePtr->hideMarginPtr,
+ &hideMargin);
+ if (hideMargin) {
+ itemPtr->itemWidth += 2 - indicatorDimensions[1];
} else {
- itemPtr->itemWidth += 2 * menuPtr->activeBorderWidth;
+ int activeBorderWidth;
+
+ Tk_GetPixelsFromObj(menuPtr->interp, menuPtr->tkwin,
+ menuPtr->activeBorderWidthPtr,
+ &activeBorderWidth);
+ itemPtr->itemWidth += 2 * activeBorderWidth;
}
*plResult = 1;
returnResult = 1;
@@ -996,13 +1036,18 @@ TkWinHandleMenuEvent(phwnd, pMessage, pwParam, plParam, plResult)
Tk_FontMetrics fontMetrics;
if (itemPtr != NULL) {
+ int state;
+ Tk_Font tkfont;
+
mePtr = (TkMenuEntry *) itemPtr->itemData;
menuPtr = mePtr->menuPtr;
twdPtr = (TkWinDrawable *) ckalloc(sizeof(TkWinDrawable));
twdPtr->type = TWD_WINDC;
twdPtr->winDC.hdc = itemPtr->hDC;
- if (mePtr->state != tkDisabledUid) {
+ Tcl_GetIndexFromObj(NULL, mePtr->statePtr,
+ tkMenuStateStrings, NULL, 0, &state);
+ if (state != ENTRY_DISABLED) {
if (itemPtr->itemState & ODS_SELECTED) {
TkActivateMenuEntry(menuPtr, mePtr->index);
} else {
@@ -1010,8 +1055,9 @@ TkWinHandleMenuEvent(phwnd, pMessage, pwParam, plParam, plResult)
}
}
- Tk_GetFontMetrics(menuPtr->tkfont, &fontMetrics);
- TkpDrawMenuEntry(mePtr, (Drawable) twdPtr, menuPtr->tkfont,
+ tkfont = Tk_GetFontFromObj(menuPtr->tkwin, menuPtr->fontPtr);
+ Tk_GetFontMetrics(tkfont, &fontMetrics);
+ TkpDrawMenuEntry(mePtr, (Drawable) twdPtr, tkfont,
&fontMetrics, itemPtr->rcItem.left,
itemPtr->rcItem.top, itemPtr->rcItem.right
- itemPtr->rcItem.left, itemPtr->rcItem.bottom
@@ -1045,6 +1091,8 @@ TkWinHandleMenuEvent(phwnd, pMessage, pwParam, plParam, plResult)
}
if (menuPtr != NULL) {
+ int state;
+
mePtr = NULL;
if (flags != 0xFFFF) {
if (flags & MF_POPUP) {
@@ -1053,15 +1101,22 @@ TkWinHandleMenuEvent(phwnd, pMessage, pwParam, plParam, plResult)
hashEntryPtr = Tcl_FindHashEntry(&commandTable,
(char *) LOWORD(*pwParam));
if (hashEntryPtr != NULL) {
- mePtr = (TkMenuEntry *) Tcl_GetHashValue(hashEntryPtr);
+ mePtr = (TkMenuEntry *)
+ Tcl_GetHashValue(hashEntryPtr);
}
}
}
- if ((mePtr == NULL) || (mePtr->state == tkDisabledUid)) {
+ if (mePtr == NULL) {
TkActivateMenuEntry(menuPtr, -1);
} else {
- TkActivateMenuEntry(menuPtr, mePtr->index);
+ Tcl_GetIndexFromObj(NULL, mePtr->statePtr,
+ tkMenuStateStrings, NULL, 0, &state);
+ if (state == ENTRY_DISABLED) {
+ TkActivateMenuEntry(menuPtr, -1);
+ } else {
+ TkActivateMenuEntry(menuPtr, mePtr->index);
+ }
}
MenuSelectEvent(menuPtr);
Tcl_ServiceAll();
@@ -1210,11 +1265,18 @@ GetMenuIndicatorGeometry (
int *widthPtr, /* The resulting width */
int *heightPtr) /* The resulting height */
{
+ int hideMargin;
+
*heightPtr = indicatorDimensions[0];
- if (mePtr->hideMargin) {
+ Tcl_GetBooleanFromObj(NULL, mePtr->hideMarginPtr, &hideMargin);
+ if (hideMargin) {
*widthPtr = 0;
} else {
- *widthPtr = indicatorDimensions[1] - menuPtr->borderWidth;
+ int borderWidth;
+
+ Tk_GetPixelsFromObj(menuPtr->interp, menuPtr->tkwin,
+ menuPtr->borderWidthPtr, &borderWidth);
+ *widthPtr = indicatorDimensions[1] - borderWidth;
}
}
@@ -1246,10 +1308,11 @@ GetMenuAccelGeometry (
*heightPtr = fmPtr->linespace;
if (mePtr->type == CASCADE_ENTRY) {
*widthPtr = 0;
- } else if (mePtr->accel == NULL) {
+ } else if (mePtr->accelPtr == NULL) {
*widthPtr = 0;
} else {
- *widthPtr = Tk_TextWidth(tkfont, mePtr->accel, mePtr->accelLength);
+ char *accel = Tcl_GetStringFromObj(mePtr->accelPtr, NULL);
+ *widthPtr = Tk_TextWidth(tkfont, accel, mePtr->accelLength);
}
}
@@ -1339,7 +1402,7 @@ DrawWindowsSystemBitmap(display, drawable, gc, rectPtr, bitmapID, alignFlags)
Display *display; /* The display we are drawing into */
Drawable drawable; /* The drawable we are working with */
GC gc; /* The GC to draw with */
- CONST RECT *rectPtr; /* The rectangle to draw into */
+ CONST RECT *rectPtr; /* The rectangle to draw into */
int bitmapID; /* The windows id of the system
* bitmap to draw. */
int alignFlags; /* How to align the bitmap inside the
@@ -1425,47 +1488,59 @@ DrawMenuEntryIndicator(menuPtr, mePtr, d, gc, indicatorGC, tkfont, fmPtr, x,
int width;
int height;
{
- if ((mePtr->type == CHECK_BUTTON_ENTRY ||
- mePtr->type == RADIO_BUTTON_ENTRY)
- && mePtr->indicatorOn
- && mePtr->entryFlags & ENTRY_SELECTED) {
- RECT rect;
- GC whichGC;
-
- if (mePtr->state != tkNormalUid) {
- whichGC = gc;
- } else {
- whichGC = indicatorGC;
- }
-
- rect.top = y;
- rect.bottom = y + mePtr->height;
- rect.left = menuPtr->borderWidth + menuPtr->activeBorderWidth + x;
- rect.right = mePtr->indicatorSpace + x;
+ if ((mePtr->type == CHECK_BUTTON_ENTRY)
+ || (mePtr->type == RADIO_BUTTON_ENTRY)) {
+ int indicatorOn;
+
+ Tcl_GetBooleanFromObj(NULL, mePtr->indicatorOnPtr, &indicatorOn);
+
+ if (indicatorOn && (mePtr->entryFlags & ENTRY_SELECTED)) {
+ RECT rect;
+ GC whichGC;
+ int state;
+ int borderWidth, activeBorderWidth;
+ Tcl_GetIndexFromObj(NULL, mePtr->statePtr, tkMenuStateStrings,
+ NULL, 0, &state);
+ if (state != ENTRY_NORMAL) {
+ whichGC = gc;
+ } else {
+ whichGC = indicatorGC;
+ }
- if ((mePtr->state == tkDisabledUid) && (menuPtr->disabledFg != NULL)
- && (versionInfo.dwMajorVersion >= 4)) {
- RECT hilightRect;
- COLORREF oldFgColor = whichGC->foreground;
-
- whichGC->foreground = GetSysColor(COLOR_3DHILIGHT);
- hilightRect.top = rect.top + 1;
- hilightRect.bottom = rect.bottom + 1;
- hilightRect.left = rect.left + 1;
- hilightRect.right = rect.right + 1;
- DrawWindowsSystemBitmap(menuPtr->display, d, whichGC,
- &hilightRect, OBM_CHECK, 0);
- whichGC->foreground = oldFgColor;
- }
+ rect.top = y;
+ rect.bottom = y + mePtr->height;
+ Tk_GetPixelsFromObj(menuPtr->interp, menuPtr->tkwin,
+ menuPtr->borderWidthPtr, &borderWidth);
+ Tk_GetPixelsFromObj(menuPtr->interp, menuPtr->tkwin,
+ menuPtr->activeBorderWidthPtr, &activeBorderWidth);
+ rect.left = borderWidth + activeBorderWidth + x;
+ rect.right = mePtr->indicatorSpace + x;
+
+ if ((state == ENTRY_DISABLED)
+ && (menuPtr->disabledFgPtr != NULL)
+ && (versionInfo.dwMajorVersion >= 4)) {
+ RECT hilightRect;
+ COLORREF oldFgColor = whichGC->foreground;
+
+ whichGC->foreground = GetSysColor(COLOR_3DHILIGHT);
+ hilightRect.top = rect.top + 1;
+ hilightRect.bottom = rect.bottom + 1;
+ hilightRect.left = rect.left + 1;
+ hilightRect.right = rect.right + 1;
+ DrawWindowsSystemBitmap(menuPtr->display, d, whichGC,
+ &hilightRect, OBM_CHECK, 0);
+ whichGC->foreground = oldFgColor;
+ }
- DrawWindowsSystemBitmap(menuPtr->display, d, whichGC, &rect,
- OBM_CHECK, 0);
+ DrawWindowsSystemBitmap(menuPtr->display, d, whichGC, &rect,
+ OBM_CHECK, 0);
- if ((mePtr->state == tkDisabledUid)
- && (menuPtr->disabledImageGC != None)
- && (versionInfo.dwMajorVersion < 4)) {
- XFillRectangle(menuPtr->display, d, menuPtr->disabledImageGC,
- rect.left, rect.top, rect.right, rect.bottom);
+ if ((state == ENTRY_DISABLED)
+ && (menuPtr->disabledImageGC != None)
+ && (versionInfo.dwMajorVersion < 4)) {
+ XFillRectangle(menuPtr->display, d, menuPtr->disabledImageGC,
+ rect.left, rect.top, rect.right, rect.bottom);
+ }
}
}
}
@@ -1510,18 +1585,26 @@ DrawMenuEntryAccelerator(menuPtr, mePtr, d, gc, tkfont, fmPtr,
{
int baseline;
int leftEdge = x + mePtr->indicatorSpace + mePtr->labelWidth;
+ int state;
+ char *accel;
+
+ if (mePtr->accelPtr != NULL) {
+ accel = Tcl_GetStringFromObj(mePtr->accelPtr, NULL);
+ }
baseline = y + (height + fmPtr->ascent - fmPtr->descent) / 2;
- if ((mePtr->state == tkDisabledUid) && (menuPtr->disabledFg != NULL)
- && ((mePtr->accel != NULL)
+ Tcl_GetIndexFromObj(NULL, mePtr->statePtr, tkMenuStateStrings, NULL,
+ 0, &state);
+ if ((state == ENTRY_DISABLED) && (menuPtr->disabledFgPtr != NULL)
+ && ((mePtr->accelPtr != NULL)
|| ((mePtr->type == CASCADE_ENTRY) && drawArrow))) {
if (versionInfo.dwMajorVersion >= 4) {
COLORREF oldFgColor = gc->foreground;
gc->foreground = GetSysColor(COLOR_3DHILIGHT);
- if (mePtr->accel != NULL) {
- Tk_DrawChars(menuPtr->display, d, gc, tkfont, mePtr->accel,
+ if (mePtr->accelPtr != NULL) {
+ Tk_DrawChars(menuPtr->display, d, gc, tkfont, accel,
mePtr->accelLength, leftEdge + 1, baseline + 1);
}
@@ -1539,12 +1622,12 @@ DrawMenuEntryAccelerator(menuPtr, mePtr, d, gc, tkfont, fmPtr,
}
}
- if (mePtr->accel != NULL) {
- Tk_DrawChars(menuPtr->display, d, gc, tkfont, mePtr->accel,
+ if (mePtr->accelPtr != NULL) {
+ Tk_DrawChars(menuPtr->display, d, gc, tkfont, accel,
mePtr->accelLength, leftEdge, baseline);
}
- if ((mePtr->state == tkDisabledUid)
+ if ((state == ENTRY_DISABLED)
&& (menuPtr->disabledImageGC != None)
&& (versionInfo.dwMajorVersion < 4)) {
XFillRectangle(menuPtr->display, d, menuPtr->disabledImageGC,
@@ -1561,7 +1644,7 @@ DrawMenuEntryAccelerator(menuPtr, mePtr, d, gc, tkfont, fmPtr,
rect.right = x + width - 1;
DrawWindowsSystemBitmap(menuPtr->display, d, gc, &rect, OBM_MNARROW,
ALIGN_BITMAP_RIGHT);
- if ((mePtr->state == tkDisabledUid)
+ if ((state == ENTRY_DISABLED)
&& (menuPtr->disabledImageGC != None)
&& (versionInfo.dwMajorVersion < 4)) {
XFillRectangle(menuPtr->display, d, menuPtr->disabledImageGC,
@@ -1600,13 +1683,15 @@ DrawMenuSeparator(menuPtr, mePtr, d, gc, tkfont, fmPtr, x, y, width, height)
int height; /* height of item */
{
XPoint points[2];
+ Tk_3DBorder border;
points[0].x = x;
points[0].y = y + height / 2;
points[1].x = x + width - 1;
points[1].y = points[0].y;
- Tk_Draw3DPolygon(menuPtr->tkwin, d,
- menuPtr->border, points, 2, 1, TK_RELIEF_RAISED);
+ border = Tk_Get3DBorderFromObj(menuPtr->tkwin, menuPtr->borderPtr);
+ Tk_Draw3DPolygon(menuPtr->tkwin, d, border, points, 2, 1,
+ TK_RELIEF_RAISED);
}
/*
@@ -1640,8 +1725,10 @@ DrawMenuUnderline(
int height) /* Height of entry */
{
if (mePtr->underline >= 0) {
+ char *label = Tcl_GetStringFromObj(mePtr->labelPtr, NULL);
+
Tk_UnderlineChars(menuPtr->display, d,
- gc, tkfont, mePtr->label, x + mePtr->indicatorSpace,
+ gc, tkfont, label, x + mePtr->indicatorSpace,
y + (height + fmPtr->ascent - fmPtr->descent) / 2,
mePtr->underline, mePtr->underline + 1);
}
@@ -1822,8 +1909,14 @@ DrawMenuEntryLabel(
{
int baseline;
int indicatorSpace = mePtr->indicatorSpace;
- int leftEdge = x + indicatorSpace + menuPtr->activeBorderWidth;
+ int activeBorderWidth;
+ int leftEdge;
int imageHeight, imageWidth;
+ int state;
+
+ Tk_GetPixelsFromObj(menuPtr->interp, menuPtr->tkwin,
+ menuPtr->activeBorderWidthPtr, &activeBorderWidth);
+ leftEdge = x + indicatorSpace + activeBorderWidth;
/*
* Draw label or bitmap or image for entry.
@@ -1842,27 +1935,27 @@ DrawMenuEntryLabel(
imageHeight, d, leftEdge,
(int) (y + (mePtr->height - imageHeight)/2));
}
- } else if (mePtr->bitmap != None) {
+ } else if (mePtr->bitmapPtr != NULL) {
int width, height;
-
- Tk_SizeOfBitmap(menuPtr->display,
- mePtr->bitmap, &width, &height);
- XCopyPlane(menuPtr->display,
- mePtr->bitmap, d,
- gc, 0, 0, (unsigned) width, (unsigned) height, leftEdge,
- (int) (y + (mePtr->height - height)/2), 1);
+ Pixmap bitmap = Tk_GetBitmapFromObj(menuPtr->tkwin, mePtr->bitmapPtr);
+ Tk_SizeOfBitmap(menuPtr->display, bitmap, &width, &height);
+ XCopyPlane(menuPtr->display, bitmap, d, gc, 0, 0, (unsigned) width,
+ (unsigned) height, leftEdge,
+ (int) (y + (mePtr->height - height)/2), 1);
} else {
if (mePtr->labelLength > 0) {
- Tk_DrawChars(menuPtr->display, d, gc,
- tkfont, mePtr->label, mePtr->labelLength,
- leftEdge, baseline);
+ char *label = Tcl_GetStringFromObj(mePtr->labelPtr, NULL);
+ Tk_DrawChars(menuPtr->display, d, gc, tkfont, label,
+ mePtr->labelLength, leftEdge, baseline);
DrawMenuUnderline(menuPtr, mePtr, d, gc, tkfont, fmPtr, x, y,
width, height);
}
}
- if (mePtr->state == tkDisabledUid) {
- if (menuPtr->disabledFg == NULL) {
+ Tcl_GetIndexFromObj(NULL, mePtr->statePtr, tkMenuStateStrings, NULL,
+ 0, &state);
+ if (state == ENTRY_DISABLED) {
+ if (menuPtr->disabledFgPtr == NULL) {
XFillRectangle(menuPtr->display, d, menuPtr->disabledGC, x, y,
(unsigned) width, (unsigned) height);
} else if ((mePtr->image != NULL)
@@ -1933,6 +2026,7 @@ DrawTearoffEntry(menuPtr, mePtr, d, gc, tkfont, fmPtr, x, y, width, height)
{
XPoint points[2];
int segmentWidth, maxX;
+ Tk_3DBorder border;
if (menuPtr->menuType != MASTER_MENU) {
return;
@@ -1943,13 +2037,14 @@ DrawTearoffEntry(menuPtr, mePtr, d, gc, tkfont, fmPtr, x, y, width, height)
points[1].y = points[0].y;
segmentWidth = 6;
maxX = width - 1;
+ border = Tk_Get3DBorderFromObj(menuPtr->tkwin, menuPtr->borderPtr);
while (points[0].x < maxX) {
points[1].x = points[0].x + segmentWidth;
if (points[1].x > maxX) {
points[1].x = maxX;
}
- Tk_Draw3DPolygon(menuPtr->tkwin, d, menuPtr->border, points, 2, 1,
+ Tk_Draw3DPolygon(menuPtr->tkwin, d, border, points, 2, 1,
TK_RELIEF_RAISED);
points[0].x += 2*segmentWidth;
}
@@ -1964,7 +2059,7 @@ DrawTearoffEntry(menuPtr, mePtr, d, gc, tkfont, fmPtr, x, y, width, height)
*
* Results:
* Returns standard TCL result. If TCL_ERROR is returned, then
- * interp->result contains an error message.
+ * the interp's result contains an error message.
*
* Side effects:
* Configuration information get set for mePtr; old resources
@@ -2030,13 +2125,15 @@ TkpDrawMenuEntry(mePtr, d, tkfont, menuMetricsPtr, x, y, width, height,
int padY = (menuPtr->menuType == MENUBAR) ? 3 : 0;
int adjustedY = y + padY;
int adjustedHeight = height - 2 * padY;
+ int state;
/*
* Choose the gc for drawing the foreground part of the entry.
*/
- if ((mePtr->state == tkActiveUid)
- && !strictMotif) {
+ Tcl_GetIndexFromObj(NULL, mePtr->statePtr, tkMenuStateStrings, NULL,
+ 0, &state);
+ if ((state == ENTRY_ACTIVE) && !strictMotif) {
gc = mePtr->activeGC;
if (gc == NULL) {
gc = menuPtr->activeGC;
@@ -2044,21 +2141,22 @@ TkpDrawMenuEntry(mePtr, d, tkfont, menuMetricsPtr, x, y, width, height,
} else {
TkMenuEntry *cascadeEntryPtr;
int parentDisabled = 0;
+ char *name;
for (cascadeEntryPtr = menuPtr->menuRefPtr->parentEntryPtr;
cascadeEntryPtr != NULL;
cascadeEntryPtr = cascadeEntryPtr->nextCascadePtr) {
- if (strcmp(cascadeEntryPtr->name,
- Tk_PathName(menuPtr->tkwin)) == 0) {
- if (cascadeEntryPtr->state == tkDisabledUid) {
+ name = Tcl_GetStringFromObj(cascadeEntryPtr->namePtr, NULL);
+ if (strcmp(name, Tk_PathName(menuPtr->tkwin)) == 0) {
+ if (state == ENTRY_DISABLED) {
parentDisabled = 1;
}
break;
}
}
- if (((parentDisabled || (mePtr->state == tkDisabledUid)))
- && (menuPtr->disabledFg != NULL)) {
+ if (((parentDisabled || (state == ENTRY_DISABLED)))
+ && (menuPtr->disabledFgPtr != NULL)) {
gc = mePtr->disabledGC;
if (gc == NULL) {
gc = menuPtr->disabledGC;
@@ -2074,24 +2172,22 @@ TkpDrawMenuEntry(mePtr, d, tkfont, menuMetricsPtr, x, y, width, height,
if (indicatorGC == NULL) {
indicatorGC = menuPtr->indicatorGC;
}
-
- bgBorder = mePtr->border;
- if (bgBorder == NULL) {
- bgBorder = menuPtr->border;
- }
+
+ bgBorder = Tk_Get3DBorderFromObj(menuPtr->tkwin,
+ (mePtr->borderPtr == NULL) ? menuPtr->borderPtr
+ : mePtr->borderPtr);
if (strictMotif) {
activeBorder = bgBorder;
} else {
- activeBorder = mePtr->activeBorder;
- if (activeBorder == NULL) {
- activeBorder = menuPtr->activeBorder;
- }
+ activeBorder = Tk_Get3DBorderFromObj(menuPtr->tkwin,
+ (mePtr->activeBorderPtr == NULL) ? menuPtr->activeBorderPtr
+ : mePtr->activeBorderPtr);
}
- if (mePtr->tkfont == NULL) {
+ if (mePtr->fontPtr == NULL) {
fmPtr = menuMetricsPtr;
} else {
- tkfont = mePtr->tkfont;
+ tkfont = Tk_GetFontFromObj(menuPtr->tkwin, mePtr->fontPtr);
Tk_GetFontMetrics(tkfont, &entryMetrics);
fmPtr = &entryMetrics;
}
@@ -2112,11 +2208,14 @@ TkpDrawMenuEntry(mePtr, d, tkfont, menuMetricsPtr, x, y, width, height,
DrawTearoffEntry(menuPtr, mePtr, d, gc, tkfont, fmPtr, x, adjustedY,
width, adjustedHeight);
} else {
+ int hideMargin;
+
DrawMenuEntryLabel(menuPtr, mePtr, d, gc, tkfont, fmPtr, x, adjustedY,
width, adjustedHeight);
DrawMenuEntryAccelerator(menuPtr, mePtr, d, gc, tkfont, fmPtr,
activeBorder, x, adjustedY, width, adjustedHeight, drawArrow);
- if (!mePtr->hideMargin) {
+ Tcl_GetBooleanFromObj(NULL, mePtr->hideMarginPtr, &hideMargin);
+ if (!hideMargin) {
DrawMenuEntryIndicator(menuPtr, mePtr, d, gc, indicatorGC, tkfont,
fmPtr, x, adjustedY, width, adjustedHeight);
}
@@ -2154,13 +2253,16 @@ GetMenuLabelGeometry(mePtr, tkfont, fmPtr, widthPtr, heightPtr)
if (mePtr->image != NULL) {
Tk_SizeOfImage(mePtr->image, widthPtr, heightPtr);
- } else if (mePtr->bitmap != (Pixmap) NULL) {
- Tk_SizeOfBitmap(menuPtr->display, mePtr->bitmap, widthPtr, heightPtr);
+ } else if (mePtr->bitmapPtr != NULL) {
+ Pixmap bitmap = Tk_GetBitmapFromObj(menuPtr->tkwin, mePtr->bitmapPtr);
+ Tk_SizeOfBitmap(menuPtr->display, bitmap, widthPtr, heightPtr);
} else {
*heightPtr = fmPtr->linespace;
- if (mePtr->label != NULL) {
- *widthPtr = Tk_TextWidth(tkfont, mePtr->label, mePtr->labelLength);
+ if (mePtr->labelPtr != NULL) {
+ char *label = Tcl_GetStringFromObj(mePtr->labelPtr, NULL);
+
+ *widthPtr = Tk_TextWidth(tkfont, label, mePtr->labelLength);
} else {
*widthPtr = 0;
}
@@ -2197,7 +2299,11 @@ DrawMenuEntryBackground(
int width, /* width of rectangle to draw */
int height) /* height of rectangle to draw */
{
- if (mePtr->state == tkActiveUid) {
+ int state;
+
+ Tcl_GetIndexFromObj(NULL, mePtr->statePtr, tkMenuStateStrings,
+ NULL, 0, &state);
+ if (state == ENTRY_ACTIVE) {
bgBorder = activeBorder;
}
Tk_Fill3DRectangle(menuPtr->tkwin, d, bgBorder,
@@ -2227,17 +2333,21 @@ void
TkpComputeStandardMenuGeometry(
TkMenu *menuPtr) /* Structure describing menu. */
{
- Tk_Font tkfont;
+ Tk_Font menuFont, tkfont;
Tk_FontMetrics menuMetrics, entryMetrics, *fmPtr;
int x, y, height, width, indicatorSpace, labelWidth, accelWidth;
int windowWidth, windowHeight, accelSpace;
int i, j, lastColumnBreak = 0;
+ int columnBreak;
+ int activeBorderWidth, borderWidth;
if (menuPtr->tkwin == NULL) {
return;
}
- x = y = menuPtr->borderWidth;
+ Tk_GetPixelsFromObj(menuPtr->interp, menuPtr->tkwin,
+ menuPtr->borderWidthPtr, &borderWidth);
+ x = y = borderWidth;
indicatorSpace = labelWidth = accelWidth = 0;
windowHeight = 0;
@@ -2252,20 +2362,26 @@ TkpComputeStandardMenuGeometry(
* give all of the geometry/drawing the entry's font and metrics.
*/
- Tk_GetFontMetrics(menuPtr->tkfont, &menuMetrics);
- accelSpace = Tk_TextWidth(menuPtr->tkfont, "M", 1);
+ menuFont = Tk_GetFontFromObj(menuPtr->tkwin, menuPtr->fontPtr);
+ Tk_GetFontMetrics(menuFont, &menuMetrics);
+ accelSpace = Tk_TextWidth(menuFont, "M", 1);
+ Tk_GetPixelsFromObj(menuPtr->interp, menuPtr->tkwin,
+ menuPtr->activeBorderWidthPtr, &activeBorderWidth);
for (i = 0; i < menuPtr->numEntries; i++) {
- tkfont = menuPtr->entries[i]->tkfont;
- if (tkfont == NULL) {
- tkfont = menuPtr->tkfont;
- fmPtr = &menuMetrics;
- } else {
+ if (menuPtr->entries[i]->fontPtr == NULL) {
+ tkfont = menuFont;
+ fmPtr = &menuMetrics;
+ } else {
+ tkfont = Tk_GetFontFromObj(menuPtr->tkwin,
+ menuPtr->entries[i]->fontPtr);
Tk_GetFontMetrics(tkfont, &entryMetrics);
fmPtr = &entryMetrics;
}
-
- if ((i > 0) && menuPtr->entries[i]->columnBreak) {
+
+ Tcl_GetBooleanFromObj(NULL, menuPtr->entries[i]->columnBreakPtr,
+ &columnBreak);
+ if ((i > 0) && columnBreak) {
if (accelWidth != 0) {
labelWidth += accelSpace;
}
@@ -2273,15 +2389,15 @@ TkpComputeStandardMenuGeometry(
menuPtr->entries[j]->indicatorSpace = indicatorSpace;
menuPtr->entries[j]->labelWidth = labelWidth;
menuPtr->entries[j]->width = indicatorSpace + labelWidth
- + accelWidth + 2 * menuPtr->activeBorderWidth;
+ + accelWidth + 2 * activeBorderWidth;
menuPtr->entries[j]->x = x;
menuPtr->entries[j]->entryFlags &= ~ENTRY_LAST_COLUMN;
}
x += indicatorSpace + labelWidth + accelWidth
- + 2 * menuPtr->borderWidth;
+ + 2 * borderWidth;
indicatorSpace = labelWidth = accelWidth = 0;
lastColumnBreak = i;
- y = menuPtr->borderWidth;
+ y = borderWidth;
}
if (menuPtr->entries[i]->type == SEPARATOR_ENTRY) {
@@ -2329,7 +2445,7 @@ TkpComputeStandardMenuGeometry(
indicatorSpace = width;
}
- menuPtr->entries[i]->height += 2 * menuPtr->activeBorderWidth + 1;
+ menuPtr->entries[i]->height += 2 * activeBorderWidth + 1;
}
menuPtr->entries[i]->y = y;
y += menuPtr->entries[i]->height;
@@ -2345,16 +2461,15 @@ TkpComputeStandardMenuGeometry(
menuPtr->entries[j]->indicatorSpace = indicatorSpace;
menuPtr->entries[j]->labelWidth = labelWidth;
menuPtr->entries[j]->width = indicatorSpace + labelWidth
- + accelWidth + 2 * menuPtr->activeBorderWidth;
+ + accelWidth + 2 * activeBorderWidth;
menuPtr->entries[j]->x = x;
menuPtr->entries[j]->entryFlags |= ENTRY_LAST_COLUMN;
}
windowWidth = x + indicatorSpace + labelWidth + accelWidth + accelSpace
- + 2 * menuPtr->activeBorderWidth
- + 2 * menuPtr->borderWidth;
+ + 2 * activeBorderWidth + 2 * borderWidth;
- windowHeight += menuPtr->borderWidth;
+ windowHeight += borderWidth;
/*
* The X server doesn't like zero dimensions, so round up to at least
@@ -2487,7 +2602,45 @@ MenuExitHandler(
/*
*----------------------------------------------------------------------
*
- * TkpMenuInit --
+ * TkWinGetMenuSystemDefault --
+ *
+ * Gets the Windows specific default value for a given X resource
+ * database name.
+ *
+ * Results:
+ * Returns a Tcl_Obj * with the default value. If there is no
+ * Windows-specific default for this attribute, returns NULL.
+ * This object has a ref count of 0.
+ *
+ * Side effects:
+ * Storage is allocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TkWinGetMenuSystemDefault(
+ Tk_Window tkwin, /* A window to use. */
+ char *dbName, /* The option database name. */
+ char *className) /* The name of the option class. */
+{
+ Tcl_Obj *valuePtr = NULL;
+
+ if ((strcmp(dbName, "activeBorderWidth") == 0) ||
+ (strcmp(dbName, "borderWidth") == 0)) {
+ valuePtr = Tcl_NewIntObj(defaultBorderWidth);
+ } else if (strcmp(dbName, "font") == 0) {
+ valuePtr = Tcl_NewStringObj(Tcl_DStringValue(&menuFontDString),
+ -1);
+ }
+
+ return valuePtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkWinMenuSetDefaults --
*
* Sets up the hash tables and the variables used by the menu package.
*
@@ -2502,37 +2655,20 @@ MenuExitHandler(
*/
void
-TkpMenuInit()
+SetDefaults(
+ int firstTime) /* Is this the first time this
+ * has been called? */
{
- WNDCLASS wndClass;
- char sizeString[4];
+ char sizeString[TCL_INTEGER_SPACE];
char faceName[LF_FACESIZE];
HDC scratchDC;
Tcl_DString boldItalicDString;
int bold = 0;
int italic = 0;
- int i;
TEXTMETRIC tm;
+ int pointSize;
+ HFONT menuFont;
- Tcl_InitHashTable(&winMenuTable, TCL_ONE_WORD_KEYS);
- Tcl_InitHashTable(&commandTable, TCL_ONE_WORD_KEYS);
-
- wndClass.style = CS_OWNDC;
- wndClass.lpfnWndProc = TkWinMenuProc;
- wndClass.cbClsExtra = 0;
- wndClass.cbWndExtra = 0;
- wndClass.hInstance = Tk_GetHINSTANCE();
- wndClass.hIcon = NULL;
- wndClass.hCursor = NULL;
- wndClass.hbrBackground = (HBRUSH)(COLOR_WINDOW + 1);
- wndClass.lpszMenuName = NULL;
- wndClass.lpszClassName = MENU_CLASS_NAME;
- RegisterClass(&wndClass);
-
- menuHWND = CreateWindow(MENU_CLASS_NAME, "MenuWindow", WS_POPUP,
- 0, 0, 10, 10, NULL, NULL, Tk_GetHINSTANCE(), NULL);
-
- Tcl_CreateExitHandler(MenuExitHandler, (ClientData) NULL);
versionInfo.dwOSVersionInfoSize = sizeof(versionInfo);
@@ -2551,74 +2687,59 @@ TkpMenuInit()
* out of options via a break statement.
*/
- for (i = 0; ; i++) {
- if (tkMenuConfigSpecs[i].type == TK_CONFIG_END) {
- break;
- }
+ defaultBorderWidth = GetSystemMetrics(SM_CXBORDER);
+ if (GetSystemMetrics(SM_CYBORDER) > defaultBorderWidth) {
+ defaultBorderWidth = GetSystemMetrics(SM_CYBORDER);
+ }
- if ((strcmp(tkMenuConfigSpecs[i].dbName,
- "activeBorderWidth") == 0) ||
- (strcmp(tkMenuConfigSpecs[i].dbName, "borderWidth") == 0)) {
- int borderWidth;
- borderWidth = GetSystemMetrics(SM_CXBORDER);
- if (GetSystemMetrics(SM_CYBORDER) > borderWidth) {
- borderWidth = GetSystemMetrics(SM_CYBORDER);
- }
- sprintf(borderString, "%d", borderWidth);
- tkMenuConfigSpecs[i].defValue = borderString;
- } else if ((strcmp(tkMenuConfigSpecs[i].dbName, "font") == 0)) {
- int pointSize;
- HFONT menuFont;
-
- scratchDC = CreateDC("DISPLAY", NULL, NULL, NULL);
- Tcl_DStringInit(&menuFontDString);
-
- if (versionInfo.dwMajorVersion >= 4) {
- NONCLIENTMETRICS ncMetrics;
-
- ncMetrics.cbSize = sizeof(ncMetrics);
- SystemParametersInfo(SPI_GETNONCLIENTMETRICS, sizeof(ncMetrics),
- &ncMetrics, 0);
- menuFont = CreateFontIndirect(&ncMetrics.lfMenuFont);
- } else {
- menuFont = GetStockObject(SYSTEM_FONT);
- }
- SelectObject(scratchDC, menuFont);
- GetTextMetrics(scratchDC, &tm);
- GetTextFace(scratchDC, sizeof(menuFontDString), faceName);
- pointSize = MulDiv(tm.tmHeight - tm.tmInternalLeading,
- 72, GetDeviceCaps(scratchDC, LOGPIXELSY));
- if (tm.tmWeight >= 700) {
- bold = 1;
- }
- if (tm.tmItalic) {
- italic = 1;
- }
+ scratchDC = CreateDC("DISPLAY", NULL, NULL, NULL);
+ if (!firstTime) {
+ Tcl_DStringFree(&menuFontDString);
+ }
+ Tcl_DStringInit(&menuFontDString);
- SelectObject(scratchDC, GetStockObject(SYSTEM_FONT));
- DeleteDC(scratchDC);
+ if (versionInfo.dwMajorVersion >= 4) {
+ NONCLIENTMETRICS ncMetrics;
- DeleteObject(menuFont);
-
- Tcl_DStringAppendElement(&menuFontDString, faceName);
- sprintf(sizeString, "%d", pointSize);
- Tcl_DStringAppendElement(&menuFontDString, sizeString);
-
- if (bold == 1 || italic == 1) {
- Tcl_DStringInit(&boldItalicDString);
- if (bold == 1) {
- Tcl_DStringAppendElement(&boldItalicDString, "bold");
- }
- if (italic == 1) {
- Tcl_DStringAppendElement(&boldItalicDString, "italic");
- }
- Tcl_DStringAppendElement(&menuFontDString,
- Tcl_DStringValue(&boldItalicDString));
- }
+ ncMetrics.cbSize = sizeof(ncMetrics);
+ SystemParametersInfo(SPI_GETNONCLIENTMETRICS, sizeof(ncMetrics),
+ &ncMetrics, 0);
+ menuFont = CreateFontIndirect(&ncMetrics.lfMenuFont);
+ } else {
+ menuFont = GetStockObject(SYSTEM_FONT);
+ }
+ SelectObject(scratchDC, menuFont);
+ GetTextMetrics(scratchDC, &tm);
+ GetTextFace(scratchDC, sizeof(menuFontDString), faceName);
+ pointSize = MulDiv(tm.tmHeight - tm.tmInternalLeading,
+ 72, GetDeviceCaps(scratchDC, LOGPIXELSY));
+ if (tm.tmWeight >= 700) {
+ bold = 1;
+ }
+ if (tm.tmItalic) {
+ italic = 1;
+ }
- tkMenuConfigSpecs[i].defValue = Tcl_DStringValue(&menuFontDString);
+ SelectObject(scratchDC, GetStockObject(SYSTEM_FONT));
+ DeleteDC(scratchDC);
+
+ DeleteObject(menuFont);
+
+ Tcl_DStringAppendElement(&menuFontDString, faceName);
+ sprintf(sizeString, "%d", pointSize);
+ Tcl_DStringAppendElement(&menuFontDString, sizeString);
+
+ if (bold == 1 || italic == 1) {
+ Tcl_DStringInit(&boldItalicDString);
+ if (bold == 1) {
+ Tcl_DStringAppendElement(&boldItalicDString, "bold");
}
+ if (italic == 1) {
+ Tcl_DStringAppendElement(&boldItalicDString, "italic");
+ }
+ Tcl_DStringAppendElement(&menuFontDString,
+ Tcl_DStringValue(&boldItalicDString));
}
/*
@@ -2642,5 +2763,47 @@ TkpMenuInit()
indicatorDimensions[0] = HIWORD(dimensions);
indicatorDimensions[1] = LOWORD(dimensions);
}
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpMenuInit --
+ *
+ * Sets up the hash tables and the variables used by the menu package.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * lastMenuID gets initialized, and the parent hash and the command hash
+ * are allocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpMenuInit()
+{
+ WNDCLASS wndClass;
+ Tcl_InitHashTable(&winMenuTable, TCL_ONE_WORD_KEYS);
+ Tcl_InitHashTable(&commandTable, TCL_ONE_WORD_KEYS);
+ wndClass.style = CS_OWNDC;
+ wndClass.lpfnWndProc = TkWinMenuProc;
+ wndClass.cbClsExtra = 0;
+ wndClass.cbWndExtra = 0;
+ wndClass.hInstance = Tk_GetHINSTANCE();
+ wndClass.hIcon = NULL;
+ wndClass.hCursor = NULL;
+ wndClass.hbrBackground = (HBRUSH)(COLOR_WINDOW + 1);
+ wndClass.lpszMenuName = NULL;
+ wndClass.lpszClassName = MENU_CLASS_NAME;
+ RegisterClass(&wndClass);
+
+ menuHWND = CreateWindow(MENU_CLASS_NAME, "MenuWindow", WS_POPUP,
+ 0, 0, 10, 10, NULL, NULL, Tk_GetHINSTANCE(), NULL);
+
+ Tcl_CreateExitHandler(MenuExitHandler, (ClientData) NULL);
+ SetDefaults(1);
}
diff --git a/win/tkWinPort.h b/win/tkWinPort.h
index 1f755a7..c2e9658 100644
--- a/win/tkWinPort.h
+++ b/win/tkWinPort.h
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * SCCS: @(#) tkWinPort.h 1.25 97/04/21 17:08:42
+ * SCCS: @(#) tkWinPort.h 1.27 98/02/10 10:35:52
*/
#ifndef _WINPORT
@@ -33,6 +33,7 @@
#include <io.h>
#include <sys/stat.h>
#include <time.h>
+#include <tchar.h>
#ifdef _MSC_VER
# define hypot _hypot
@@ -89,7 +90,6 @@
* The following Tk functions are implemented as macros under Windows.
*/
-#define TkGetNativeProlog(interp) TkGetProlog(interp)
#define TkpGetPixel(p) (((((p)->red >> 8) & 0xff) \
| ((p)->green & 0xff00) | (((p)->blue << 8) & 0xff0000)) | 0x20000000)
diff --git a/win/tkWinScrlbr.c b/win/tkWinScrlbr.c
index 6c1a664..613469f 100644
--- a/win/tkWinScrlbr.c
+++ b/win/tkWinScrlbr.c
@@ -9,7 +9,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * SCCS: @(#) tkWinScrlbr.c 1.19 97/08/13 17:37:49
+ * SCCS: @(#) tkWinScrlbr.c 1.20 97/11/07 21:25:53
*/
#include "tkWinInt.h"
@@ -62,7 +62,7 @@ static int vArrowWidth, vArrowHeight, vThumb; /* Vertical control metrics. */
* form for use in a Tk_ConfigSpec.
*/
-static char defWidth[8];
+static char defWidth[TCL_INTEGER_SPACE];
/*
* Declarations for functions defined in this file.
diff --git a/win/tkWinSend.c b/win/tkWinSend.c
index 6d12ed4..120ccf9 100644
--- a/win/tkWinSend.c
+++ b/win/tkWinSend.c
@@ -10,11 +10,67 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * SCCS: @(#) tkWinSend.c 1.4 97/06/10 09:39:50
+ * SCCS: @(#) tkWinSend.c 1.15 98/02/19 17:04:54
*/
-#include "tkPort.h"
-#include "tkInt.h"
+#include "tkWinInt.h"
+#include <ddeml.h>
+
+/*
+ * The following structure is used to keep track of the interpreters
+ * registered by this process.
+ */
+
+typedef struct RegisteredInterp {
+ struct RegisteredInterp *nextPtr;
+ /* The next interp this application knows
+ * about. */
+ char *name; /* Interpreter's name (malloc-ed). */
+ Tcl_Interp *interp; /* The interpreter attached to this name. */
+} RegisteredInterp;
+
+/*
+ * Used to keep track of conversations.
+ */
+
+typedef struct Conversation {
+ struct Conversation *nextPtr;
+ /* The next conversation in the list. */
+ RegisteredInterp *riPtr; /* The info we know about the conversation. */
+ HCONV hConv; /* The DDE handle for this conversation. */
+ Tcl_Obj *returnPackagePtr; /* The result package for this conversation. */
+} Conversation;
+
+/*
+ * Static variables used by the registration process. Most of these
+ * are allocated in RegOpen and freed in RegClose.
+ */
+
+static Conversation *currentConversations;
+ /* A list of conversations currently
+ * being processed. */
+static DWORD ddeInstance = 0; /* The application instance handle given
+ * to us by DdeInitialize. */
+static RegisteredInterp *interpListPtr;
+ /* The list of interps that this particular
+ * application knows about. */
+
+/*
+ * Forward declarations for procedures defined later in this file.
+ */
+
+static void RemoveDdeServerExitProc _ANSI_ARGS_((ClientData clientData));
+static void DeleteProc _ANSI_ARGS_((ClientData clientData));
+static Tcl_Obj * ExecuteRemoteObject _ANSI_ARGS_((
+ RegisteredInterp *riPtr,
+ Tcl_Obj *ddeObjectPtr));
+static int MakeDdeConnection _ANSI_ARGS_((Tcl_Interp *interp,
+ char *name, HCONV *ddeConvPtr));
+static HDDEDATA CALLBACK TkDdeServerProc _ANSI_ARGS_((UINT uType,
+ UINT uFmt, HCONV hConv, HSZ ddeTopic,
+ HSZ ddeItem, HDDEDATA hData, DWORD dwData1,
+ DWORD dwData2));
+static void SetDdeError _ANSI_ARGS_((Tcl_Interp *interp));
/*
@@ -52,7 +108,360 @@ Tk_SetAppName(tkwin, name)
* "send" commands. Must be globally
* unique. */
{
- return name;
+ TkWindow *winPtr = (TkWindow *) tkwin;
+ Tcl_Interp *interp = winPtr->mainPtr->interp;
+ int i, suffix, offset;
+ RegisteredInterp *riPtr, *prevPtr;
+ char *actualName;
+ Tcl_DString dString;
+ Tcl_Obj *resultObjPtr, *interpNamePtr;
+ char *interpName;
+
+ /*
+ * Make sure that the DDE server is there. This is done only once,
+ * add an exit handler tear it down.
+ */
+
+ if (ddeInstance == 0) {
+ HSZ ddeService;
+
+ if (DdeInitialize(&ddeInstance, TkDdeServerProc,
+ CBF_SKIP_REGISTRATIONS|CBF_SKIP_UNREGISTRATIONS
+ |CBF_FAIL_POKES, 0)
+ != DMLERR_NO_ERROR) {
+ DdeUninitialize(ddeInstance);
+ return NULL;
+ }
+ Tcl_CreateExitHandler(RemoveDdeServerExitProc, NULL);
+ ddeService = DdeCreateStringHandle(ddeInstance, "Tk", 0);
+ DdeNameService(ddeInstance, ddeService, 0L, DNS_REGISTER);
+ }
+
+ /*
+ * See if the application is already registered; if so, remove its
+ * current name from the registry. The deletion of the command
+ * will take care of disposing of this entry.
+ */
+
+ for (riPtr = interpListPtr, prevPtr = NULL; riPtr != NULL;
+ prevPtr = riPtr, riPtr = riPtr->nextPtr) {
+ if (riPtr->interp == interp) {
+ if (prevPtr == NULL) {
+ interpListPtr = interpListPtr->nextPtr;
+ } else {
+ prevPtr->nextPtr = riPtr->nextPtr;
+ }
+ break;
+ }
+ }
+
+ /*
+ * Pick a name to use for the application. Use "name" if it's not
+ * already in use. Otherwise add a suffix such as " #2", trying
+ * larger and larger numbers until we eventually find one that is
+ * unique.
+ */
+
+ actualName = name;
+ suffix = 1;
+ offset = 0;
+ Tcl_DStringInit(&dString);
+
+ TkGetInterpNames(interp, tkwin);
+ resultObjPtr = Tcl_GetObjResult(interp);
+ Tcl_IncrRefCount(resultObjPtr);
+ for (i = 0; ; ) {
+ (void) Tcl_ListObjIndex(NULL, resultObjPtr, i, &interpNamePtr);
+ if (interpNamePtr == NULL) {
+ break;
+ }
+ interpName = Tcl_GetString(interpNamePtr);
+ if (stricmp(actualName, interpName) == 0) {
+ if (suffix == 1) {
+ Tcl_DStringAppend(&dString, name, -1);
+ Tcl_DStringAppend(&dString, " #", 2);
+ offset = Tcl_DStringLength(&dString);
+ Tcl_DStringSetLength(&dString, offset + 10);
+ actualName = Tcl_DStringValue(&dString);
+ }
+ suffix++;
+ sprintf(actualName + offset, "%d", suffix);
+ i = 0;
+ } else {
+ i++;
+ }
+ }
+
+ Tcl_DecrRefCount(resultObjPtr);
+ Tcl_ResetResult(interp);
+
+ /*
+ * We have found a unique name. Now add it to the registry.
+ */
+
+ riPtr = (RegisteredInterp *) ckalloc(sizeof(RegisteredInterp));
+ riPtr->interp = interp;
+ riPtr->name = ckalloc(strlen(actualName) + 1);
+ riPtr->nextPtr = interpListPtr;
+ interpListPtr = riPtr;
+ strcpy(riPtr->name, actualName);
+
+ Tcl_CreateObjCommand(interp, "send", Tk_SendObjCmd,
+ (ClientData) riPtr, DeleteProc);
+ Tcl_CreateObjCommand(interp, "dde", Tk_DdeObjCmd,
+ (ClientData) NULL, NULL);
+ if (Tcl_IsSafe(interp)) {
+ Tcl_HideCommand(interp, "send", "send");
+ Tcl_HideCommand(interp, "dde", "dde");
+ }
+ Tcl_DStringFree(&dString);
+
+ return riPtr->name;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_SendObjCmd --
+ *
+ * This procedure is invoked to process the "send" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_SendObjCmd(
+ ClientData clientData, /* Used only for deletion */
+ Tcl_Interp *interp, /* The interp we are sending from */
+ int objc, /* Number of arguments */
+ Tcl_Obj *CONST objv[]) /* The arguments */
+{
+ char *string, *sendName;
+ int async, i, result, length;
+ RegisteredInterp *riPtr;
+ Tcl_Interp *sendInterp;
+ Tcl_Obj *objPtr;
+ static char *options[] = {
+ "-async", "-displayof", "--", (char *) NULL
+ };
+ enum options {
+ SEND_ASYNC, SEND_DISPLAYOF, SEND_LAST
+ };
+
+ async = 0;
+ for (i = 1; i < objc; i++) {
+ int index;
+
+ string = Tcl_GetString(objv[i]);
+ if (string[0] != '-') {
+ break;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", TCL_EXACT,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ switch ((enum options) index) {
+ case SEND_ASYNC: {
+ async = 1;
+ break;
+ }
+ case SEND_DISPLAYOF: {
+ /*
+ * Don't care about -displayof option. Skip the
+ * (ignored) window argument.
+ */
+
+ i++;
+ break;
+ }
+ case SEND_LAST: {
+ i++;
+ /* break 2; */
+ goto endOfOptionLoop;
+ }
+ }
+ }
+
+ endOfOptionLoop:
+ if (objc - i < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "?options? interpName arg ?arg ...?");
+ return TCL_ERROR;
+ }
+
+ sendName = Tcl_GetString(objv[i]);
+ objc -= i + 1;
+ ((Tcl_Obj **)objv) += i + 1;
+
+ /*
+ * See if the target interpreter is local. If so, execute
+ * the command directly without going through the DDE server.
+ * Don't exchange objects between interps. The target interp could
+ * compile an object, producing a bytecode structure that refers to
+ * other objects owned by the target interp. If the target interp
+ * is then deleted, the bytecode structure would be referring to
+ * deallocated objects.
+ */
+
+ for (riPtr = interpListPtr; riPtr != NULL; riPtr = riPtr->nextPtr) {
+ if (stricmp(sendName, riPtr->name) == 0) {
+ break;
+ }
+ }
+
+ if (riPtr != NULL) {
+ /*
+ * This command is to a local interp. No need to go through
+ * the server.
+ */
+
+ Tcl_Preserve((ClientData) riPtr);
+ sendInterp = riPtr->interp;
+ Tcl_Preserve((ClientData) sendInterp);
+
+ /*
+ * Don't exchange objects between interps. The target interp would
+ * compile an object, producing a bytecode structure that refers to
+ * other objects owned by the target interp. If the target interp
+ * is then deleted, the bytecode structure would be referring to
+ * deallocated objects.
+ */
+
+ if (objc == 1) {
+ result = Tcl_EvalObj(sendInterp, objv[0], TCL_EVAL_GLOBAL);
+ } else {
+ objPtr = Tcl_ConcatObj(objc, objv);
+ Tcl_IncrRefCount(objPtr);
+ result = Tcl_EvalObj(sendInterp, objPtr, TCL_EVAL_GLOBAL);
+ Tcl_DecrRefCount(objPtr);
+ }
+ if (interp != sendInterp) {
+ if (result == TCL_ERROR) {
+ /*
+ * An error occurred, so transfer error information from the
+ * destination interpreter back to our interpreter.
+ */
+
+ Tcl_ResetResult(interp);
+ objPtr = Tcl_GetObjVar2(sendInterp, "errorInfo", NULL,
+ TCL_GLOBAL_ONLY);
+ string = Tcl_GetStringFromObj(objPtr, &length);
+ Tcl_AddObjErrorInfo(interp, string, length);
+
+ objPtr = Tcl_GetObjVar2(sendInterp, "errorCode", NULL,
+ TCL_GLOBAL_ONLY);
+ Tcl_SetObjErrorCode(interp, objPtr);
+ }
+ Tcl_SetObjResult(interp, Tcl_GetObjResult(sendInterp));
+ }
+ Tcl_Release((ClientData) riPtr);
+ Tcl_Release((ClientData) sendInterp);
+ } else {
+ /*
+ * This is a non-local request. Send the script to the server and poll
+ * it for a result.
+ */
+
+ HCONV hConv;
+ HDDEDATA ddeItem;
+ HDDEDATA ddeData;
+ DWORD ddeResult;
+
+ if (MakeDdeConnection(interp, sendName, &hConv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ objPtr = Tcl_ConcatObj(objc, objv);
+ string = Tcl_GetStringFromObj(objPtr, &length);
+ ddeItem = DdeCreateDataHandle(ddeInstance, string, length, 0, 0,
+ CF_TEXT, 0);
+ if (async) {
+ ddeData = DdeClientTransaction((LPBYTE) ddeItem, 0xFFFFFFFF, hConv, 0,
+ CF_TEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult);
+ DdeAbandonTransaction(ddeInstance, hConv, ddeResult);
+ } else {
+ ddeData = DdeClientTransaction((LPBYTE) ddeItem, 0xFFFFFFFF, hConv, 0,
+ CF_TEXT, XTYP_EXECUTE, 7200000, NULL);
+ if (ddeData != 0) {
+ HSZ ddeCookie;
+
+ ddeCookie = DdeCreateStringHandle(ddeInstance,
+ "$TK$EXECUTE$RESULT", CP_WINANSI);
+ ddeData = DdeClientTransaction(NULL, 0, hConv, ddeCookie,
+ CF_TEXT, XTYP_REQUEST, 7200000, NULL);
+ DdeFreeStringHandle(ddeInstance, ddeCookie);
+ }
+ }
+
+ DdeFreeDataHandle(ddeItem);
+ Tcl_DecrRefCount(objPtr);
+
+ if (ddeData == 0) {
+ SetDdeError(interp);
+ DdeDisconnect(hConv);
+ return TCL_ERROR;
+ }
+
+ if (async == 0) {
+ Tcl_Obj *resultPtr;
+
+ /*
+ * The return handle has a two or four element list in it. The first
+ * element is the return code (TCL_OK, TCL_ERROR, etc.). The
+ * second is the result of the script. If the return code is TCL_ERROR,
+ * then the third element is the value of the variable "errorCode",
+ * and the fourth is the value of the variable "errorInfo".
+ */
+
+ length = DdeGetData(ddeData, NULL, 0, 0);
+ resultPtr = Tcl_NewObj();
+ Tcl_SetObjLength(resultPtr, length);
+ string = Tcl_GetString(resultPtr);
+ DdeGetData(ddeData, string, length, 0);
+ DdeFreeDataHandle(ddeData);
+ DdeDisconnect(hConv);
+
+ if (Tcl_ListObjIndex(NULL, resultPtr, 0, &objPtr) != TCL_OK) {
+ goto error;
+ }
+ if (Tcl_GetIntFromObj(NULL, objPtr, &result) != TCL_OK) {
+ goto error;
+ }
+ if (result == TCL_ERROR) {
+ Tcl_ResetResult(interp);
+
+ if (Tcl_ListObjIndex(NULL, resultPtr, 3, &objPtr) != TCL_OK) {
+ goto error;
+ }
+ string = Tcl_GetStringFromObj(objPtr, &length);
+ Tcl_AddObjErrorInfo(interp, string, length);
+
+ Tcl_ListObjIndex(NULL, resultPtr, 2, &objPtr);
+ Tcl_SetObjErrorCode(interp, objPtr);
+ }
+ if (Tcl_ListObjIndex(NULL, resultPtr, 1, &objPtr) != TCL_OK) {
+ goto error;
+ }
+ Tcl_SetObjResult(interp, objPtr);
+ Tcl_DecrRefCount(resultPtr);
+ return result;
+
+ error:
+ Tcl_SetStringObj(Tcl_GetObjResult(interp),
+ "invalid data returned from server", -1);
+ Tcl_DecrRefCount(resultPtr);
+ return TCL_ERROR;
+ }
+ }
+
+ return result;
}
/*
@@ -65,10 +474,10 @@ Tk_SetAppName(tkwin, name)
* of a particular window.
*
* Results:
- * A standard Tcl return value. Interp->result will be set
+ * A standard Tcl return value. The interp's result will be set
* to hold a list of all the interpreter names defined for
* tkwin's display. If an error occurs, then TCL_ERROR
- * is returned and interp->result will hold an error message.
+ * is returned and the interp's result will hold an error message.
*
* Side effects:
* None.
@@ -82,5 +491,766 @@ TkGetInterpNames(interp, tkwin)
Tk_Window tkwin; /* Window whose display is to be used
* for the lookup. */
{
+ Tcl_Obj *listObjPtr;
+ HCONVLIST hConvList;
+ HCONV hConv;
+ HSZ ddeService;
+ CONVINFO convInfo;
+ Tcl_DString dString;
+ char *topicName;
+ int len;
+
+ convInfo.cb = sizeof(CONVINFO);
+ ddeService = DdeCreateStringHandle(ddeInstance, "Tk", CP_WINANSI);
+ hConvList = DdeConnectList(ddeInstance, ddeService, NULL,
+ 0, NULL);
+ hConv = 0;
+
+ Tcl_DStringInit(&dString);
+ listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+ while (hConv = DdeQueryNextServer(hConvList, hConv), hConv != 0) {
+ DdeQueryConvInfo(hConv, QID_SYNC, &convInfo);
+ len = DdeQueryString(ddeInstance, convInfo.hszTopic,
+ NULL, 0, CP_WINANSI);
+ Tcl_DStringSetLength(&dString, len);
+ topicName = Tcl_DStringValue(&dString);
+ DdeQueryString(ddeInstance, convInfo.hszTopic, topicName,
+ len + 1, CP_WINANSI);
+ Tcl_ListObjAppendElement(interp, listObjPtr,
+ Tcl_NewStringObj(topicName, len));
+ }
+
+ DdeDisconnectList(hConvList);
+ Tcl_SetObjResult(interp, listObjPtr);
+ Tcl_DStringFree(&dString);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DeleteProc --
+ *
+ * This procedure is invoked by Tcl when the "send" command
+ * is deleted in an interpreter. It unregisters the interpreter.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The interpreter given by riPtr is unregistered.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DeleteProc(clientData)
+ ClientData clientData; /* The interp we are deleting passed
+ * as ClientData. */
+{
+ RegisteredInterp *riPtr = (RegisteredInterp *) clientData;
+ RegisteredInterp *searchPtr, *prevPtr;
+
+ for (searchPtr = interpListPtr, prevPtr = NULL;
+ (searchPtr != NULL) && (searchPtr != riPtr);
+ prevPtr = searchPtr, searchPtr = searchPtr->nextPtr) {
+ /*
+ * Empty loop body.
+ */
+ }
+
+ Tcl_DeleteCommand(riPtr->interp, "dde");
+
+ if (searchPtr != NULL) {
+ if (prevPtr == NULL) {
+ interpListPtr = interpListPtr->nextPtr;
+ } else {
+ prevPtr->nextPtr = searchPtr->nextPtr;
+ }
+ }
+ ckfree(riPtr->name);
+ Tcl_EventuallyFree(clientData, TCL_DYNAMIC);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ExecuteRemoteObject --
+ *
+ * Takes the package delivered by DDE and executes it in
+ * the server's interpreter.
+ *
+ * Results:
+ * A list Tcl_Obj * that describes what happened. The first
+ * element is the numerical return code (TCL_ERROR, etc.).
+ * The second element is the result of the script. If the
+ * return result was TCL_ERROR, then the third element
+ * will be the value of the global "errorCode", and the
+ * fourth will be the value of the global "errorInfo".
+ * The return result will have a refCount of 0.
+ *
+ * Side effects:
+ * A Tcl script is run, which can cause all kinds of other
+ * things to happen.
+ *
+ *--------------------------------------------------------------
+ */
+
+static Tcl_Obj *
+ExecuteRemoteObject(
+ RegisteredInterp *riPtr, /* Info about this server. */
+ Tcl_Obj *ddeObjectPtr) /* The object to execute. */
+{
+ Tcl_Obj *errorObjPtr;
+ Tcl_Obj *returnPackagePtr;
+ int result;
+
+ result = Tcl_EvalObj(riPtr->interp, ddeObjectPtr, TCL_EVAL_GLOBAL);
+ returnPackagePtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+ Tcl_ListObjAppendElement(NULL, returnPackagePtr,
+ Tcl_NewIntObj(result));
+ Tcl_ListObjAppendElement(NULL, returnPackagePtr,
+ Tcl_GetObjResult(riPtr->interp));
+ if (result == TCL_ERROR) {
+ errorObjPtr = Tcl_GetObjVar2(riPtr->interp, "errorCode", NULL,
+ TCL_GLOBAL_ONLY);
+ Tcl_ListObjAppendElement(NULL, returnPackagePtr, errorObjPtr);
+ errorObjPtr = Tcl_GetObjVar2(riPtr->interp, "errorInfo", NULL,
+ TCL_GLOBAL_ONLY);
+ Tcl_ListObjAppendElement(NULL, returnPackagePtr, errorObjPtr);
+ }
+
+ return returnPackagePtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkDdeServerProc --
+ *
+ * Handles all transactions for this server. Can handle
+ * execute, request, and connect protocols. Dde will
+ * call this routine when a client attempts to run a dde
+ * command using this server.
+ *
+ * Results:
+ * A DDE Handle with the result of the dde command.
+ *
+ * Side effects:
+ * Depending on which command is executed, arbitrary
+ * Tcl scripts can be run.
+ *
+ *--------------------------------------------------------------
+ */
+
+static HDDEDATA CALLBACK
+TkDdeServerProc (
+ UINT uType, /* The type of DDE transaction we
+ * are performing. */
+ UINT uFmt, /* The format that data is sent or
+ * received. */
+ HCONV hConv, /* The conversation associated with the
+ * current transaction. */
+ HSZ ddeTopic, /* A string handle. Transaction-type
+ * dependent. */
+ HSZ ddeItem, /* A string handle. Transaction-type
+ * dependent. */
+ HDDEDATA hData, /* DDE data. Transaction-type dependent. */
+ DWORD dwData1, /* Transaction-dependent data. */
+ DWORD dwData2) /* Transaction-dependent data. */
+{
+ Tcl_DString dString;
+ int len;
+ char *utilString;
+ Tcl_Obj *ddeObjectPtr;
+ HDDEDATA ddeReturn = NULL;
+ RegisteredInterp *riPtr;
+ Conversation *convPtr, *prevConvPtr;
+
+ switch(uType) {
+ case XTYP_CONNECT:
+
+ /*
+ * Dde is trying to initialize a conversation with us. Check
+ * and make sure we have a valid topic.
+ */
+
+ len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, 0);
+ Tcl_DStringInit(&dString);
+ Tcl_DStringSetLength(&dString, len);
+ utilString = Tcl_DStringValue(&dString);
+ DdeQueryString(ddeInstance, ddeTopic, utilString, len + 1,
+ CP_WINANSI);
+
+ for (riPtr = interpListPtr; riPtr != NULL;
+ riPtr = riPtr->nextPtr) {
+ if (stricmp(utilString, riPtr->name) == 0) {
+ Tcl_DStringFree(&dString);
+ return (HDDEDATA) TRUE;
+ }
+ }
+
+ Tcl_DStringFree(&dString);
+ return (HDDEDATA) FALSE;
+
+ case XTYP_CONNECT_CONFIRM:
+
+ /*
+ * Dde has decided that we can connect, so it gives us a
+ * conversation handle. We need to keep track of it
+ * so we know which execution result to return in an
+ * XTYP_REQUEST.
+ */
+
+ len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, 0);
+ Tcl_DStringInit(&dString);
+ Tcl_DStringSetLength(&dString, len);
+ utilString = Tcl_DStringValue(&dString);
+ DdeQueryString(ddeInstance, ddeTopic, utilString, len + 1,
+ CP_WINANSI);
+ for (riPtr = interpListPtr; riPtr != NULL;
+ riPtr = riPtr->nextPtr) {
+ if (stricmp(riPtr->name, utilString) == 0) {
+ convPtr = (Conversation *) ckalloc(sizeof(Conversation));
+ convPtr->nextPtr = currentConversations;
+ convPtr->returnPackagePtr = NULL;
+ convPtr->hConv = hConv;
+ convPtr->riPtr = riPtr;
+ currentConversations = convPtr;
+ break;
+ }
+ }
+ Tcl_DStringFree(&dString);
+ return (HDDEDATA) TRUE;
+
+ case XTYP_DISCONNECT:
+
+ /*
+ * The client has disconnected from our server. Forget this
+ * conversation.
+ */
+
+ for (convPtr = currentConversations, prevConvPtr = NULL;
+ convPtr != NULL;
+ prevConvPtr = convPtr, convPtr = convPtr->nextPtr) {
+ if (hConv == convPtr->hConv) {
+ if (prevConvPtr == NULL) {
+ currentConversations = convPtr->nextPtr;
+ } else {
+ prevConvPtr->nextPtr = convPtr->nextPtr;
+ }
+ if (convPtr->returnPackagePtr != NULL) {
+ Tcl_DecrRefCount(convPtr->returnPackagePtr);
+ }
+ ckfree((char *) convPtr);
+ break;
+ }
+ }
+ return (HDDEDATA) TRUE;
+
+ case XTYP_REQUEST:
+
+ /*
+ * This could be either a request for a value of a Tcl variable,
+ * or it could be the send command requesting the results of the
+ * last execute.
+ */
+
+ if (uFmt != CF_TEXT) {
+ return (HDDEDATA) FALSE;
+ }
+
+ ddeReturn = (HDDEDATA) FALSE;
+ for (convPtr = currentConversations; (convPtr != NULL)
+ && (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) {
+ /*
+ * Empty loop body.
+ */
+ }
+
+ if (convPtr != NULL) {
+ char *returnString;
+
+ len = DdeQueryString(ddeInstance, ddeItem, NULL, 0,
+ CP_WINANSI);
+ Tcl_DStringInit(&dString);
+ Tcl_DStringSetLength(&dString, len);
+ utilString = Tcl_DStringValue(&dString);
+ DdeQueryString(ddeInstance, ddeItem, utilString, len + 1,
+ CP_WINANSI);
+ if (stricmp(utilString, "$TK$EXECUTE$RESULT") == 0) {
+ returnString =
+ Tcl_GetStringFromObj(convPtr->returnPackagePtr, &len);
+ ddeReturn = DdeCreateDataHandle(ddeInstance,
+ returnString, len, 0, ddeItem, CF_TEXT,
+ 0);
+ } else {
+ Tcl_Obj *variableObjPtr = Tcl_GetObjVar2(
+ convPtr->riPtr->interp, utilString, NULL,
+ TCL_GLOBAL_ONLY);
+ if (variableObjPtr != NULL) {
+ returnString = Tcl_GetStringFromObj(variableObjPtr,
+ &len);
+ ddeReturn = DdeCreateDataHandle(ddeInstance,
+ returnString, len, 0, ddeItem, CF_TEXT, 0);
+ } else {
+ ddeReturn = NULL;
+ }
+ }
+ Tcl_DStringFree(&dString);
+ }
+ return ddeReturn;
+
+ case XTYP_EXECUTE: {
+
+ /*
+ * Execute this script. The results will be saved into
+ * a list object which will be retreived later. See
+ * ExecuteRemoteObject.
+ */
+
+ Tcl_Obj *returnPackagePtr;
+
+ for (convPtr = currentConversations; (convPtr != NULL)
+ && (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) {
+ /*
+ * Empty loop body.
+ */
+
+ }
+
+ if (convPtr == NULL) {
+ return (HDDEDATA) DDE_FNOTPROCESSED;
+ }
+
+ utilString = (char *) DdeAccessData(hData, &len);
+ ddeObjectPtr = Tcl_NewStringObj(utilString, len);
+ Tcl_IncrRefCount(ddeObjectPtr);
+ DdeUnaccessData(hData);
+ if (convPtr->returnPackagePtr != NULL) {
+ Tcl_DecrRefCount(convPtr->returnPackagePtr);
+ }
+ convPtr->returnPackagePtr = NULL;
+ returnPackagePtr =
+ ExecuteRemoteObject(convPtr->riPtr, ddeObjectPtr);
+ for (convPtr = currentConversations; (convPtr != NULL)
+ && (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) {
+ /*
+ * Empty loop body.
+ */
+
+ }
+ if (convPtr != NULL) {
+ Tcl_IncrRefCount(returnPackagePtr);
+ convPtr->returnPackagePtr = returnPackagePtr;
+ }
+ Tcl_DecrRefCount(ddeObjectPtr);
+ if (returnPackagePtr == NULL) {
+ return (HDDEDATA) DDE_FNOTPROCESSED;
+ } else {
+ return (HDDEDATA) DDE_FACK;
+ }
+ }
+
+ case XTYP_WILDCONNECT: {
+
+ /*
+ * Dde wants a list of services and topics that we support.
+ */
+
+ HSZPAIR *returnPtr;
+ int i;
+ int numItems;
+
+ for (i = 0, riPtr = interpListPtr; riPtr != NULL;
+ i++, riPtr = riPtr->nextPtr) {
+ /*
+ * Empty loop body.
+ */
+
+ }
+
+ numItems = i;
+ ddeReturn = DdeCreateDataHandle(ddeInstance, NULL,
+ (numItems + 1) * sizeof(HSZPAIR), 0, 0, 0, 0);
+ returnPtr = (HSZPAIR *) DdeAccessData(ddeReturn, &len);
+ for (i = 0, riPtr = interpListPtr; i < numItems;
+ i++, riPtr = riPtr->nextPtr) {
+ returnPtr[i].hszSvc = DdeCreateStringHandle(ddeInstance,
+ "Tk", CP_WINANSI);
+ returnPtr[i].hszTopic = DdeCreateStringHandle(ddeInstance,
+ riPtr->name, CP_WINANSI);
+ }
+ returnPtr[i].hszSvc = NULL;
+ returnPtr[i].hszTopic = NULL;
+ DdeUnaccessData(ddeReturn);
+ return ddeReturn;
+ }
+
+ }
+ return NULL;
+}
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * RemoveDdeServerExitProc --
+ *
+ * Gets rid of our DDE server when we go away.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The DDE server is deleted.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+RemoveDdeServerExitProc(
+ ClientData clientData) /* Not used in this handler. */
+{
+ DdeNameService(ddeInstance, NULL, 0, DNS_UNREGISTER);
+ DdeUninitialize(ddeInstance);
+ ddeInstance = 0;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * MakeDdeConnection --
+ *
+ * This procedure is a utility used to connect to a DDE
+ * server when given a server name and a topic name.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ *
+ * Side effects:
+ * Passes back a conversation through ddeConvPtr
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+MakeDdeConnection(
+ Tcl_Interp *interp, /* Used to report errors. */
+ char *name, /* The connection to use. */
+ HCONV *ddeConvPtr)
+{
+ HSZ ddeTopic, ddeService;
+ HCONV ddeConv;
+
+ ddeService = DdeCreateStringHandle(ddeInstance, "Tk", 0);
+ ddeTopic = DdeCreateStringHandle(ddeInstance, name, 0);
+
+ ddeConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
+ DdeFreeStringHandle(ddeInstance, ddeService);
+ DdeFreeStringHandle(ddeInstance, ddeTopic);
+
+ if (ddeConv == (HCONV) NULL) {
+ if (interp != NULL) {
+ Tcl_AppendResult(interp, "no registered server named \"",
+ name, "\"", (char *) NULL);
+ }
+ return TCL_ERROR;
+ }
+
+ *ddeConvPtr = ddeConv;
return TCL_OK;
}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * SetDdeError --
+ *
+ * Sets the interp result to a cogent error message
+ * describing the last DDE error.
+ *
+ * Results:
+ * None.
+ *
+ *
+ * Side effects:
+ * The interp's result object is changed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+SetDdeError(
+ Tcl_Interp *interp) /* The interp to put the message in.*/
+{
+ Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
+ int err;
+
+ err = DdeGetLastError(ddeInstance);
+ switch (err) {
+ case DMLERR_DATAACKTIMEOUT:
+ case DMLERR_EXECACKTIMEOUT:
+ case DMLERR_POKEACKTIMEOUT:
+ Tcl_SetStringObj(resultPtr,
+ "remote interpreter did not respond", -1);
+ break;
+
+ case DMLERR_BUSY:
+ Tcl_SetStringObj(resultPtr, "remote server is busy", -1);
+ break;
+
+ case DMLERR_NOTPROCESSED:
+ Tcl_SetStringObj(resultPtr,
+ "remote server cannot handle this command", -1);
+ break;
+
+ default:
+ Tcl_SetStringObj(resultPtr, "dde command failed", -1);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_DdeObjCmd --
+ *
+ * This procedure is invoked to process the "dde" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_DdeObjCmd(
+ ClientData clientData, /* Used only for deletion */
+ Tcl_Interp *interp, /* The interp we are sending from */
+ int objc, /* Number of arguments */
+ Tcl_Obj *CONST objv[]) /* The arguments */
+{
+ enum {
+ DDE_EXECUTE,
+ DDE_REQUEST,
+ DDE_SERVICES
+ };
+
+ static char *ddeCommands[] = {"execute", "request", "services",
+ (char *) NULL};
+ static char *ddeOptions[] = {"-async", (char *) NULL};
+ int index, argIndex;
+ int async = 0;
+ int result = TCL_OK;
+ HSZ ddeService = NULL;
+ HSZ ddeTopic = NULL;
+ HSZ ddeItem = NULL;
+ HDDEDATA ddeData = NULL;
+ HCONV hConv;
+ char *serviceName, *topicName, *itemString, *dataString;
+ int firstArg, length, dataLength;
+ DWORD ddeResult;
+ HDDEDATA ddeReturn;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "?-async? serviceName topicName value");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[1], ddeCommands, "command", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch (index) {
+ case DDE_EXECUTE:
+ if ((objc < 5) || (objc > 6)) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "execute ?-async? serviceName topicName value");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObj(NULL, objv[2], ddeOptions, "option", 0,
+ &argIndex) != TCL_OK) {
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "execute ?-async? serviceName topicName value");
+ return TCL_ERROR;
+ }
+ async = 0;
+ firstArg = 2;
+ } else {
+ if (objc != 6) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "execute ?-async? serviceName topicName value");
+ return TCL_ERROR;
+ }
+ async = 1;
+ firstArg = 3;
+ }
+ break;
+ case DDE_REQUEST:
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "request serviceName topicName value");
+ return TCL_ERROR;
+ }
+ firstArg = 2;
+ break;
+ case DDE_SERVICES:
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "services serviceName topicName");
+ return TCL_ERROR;
+ }
+ firstArg = 2;
+ break;
+ }
+
+ serviceName = Tcl_GetStringFromObj(objv[firstArg], &length);
+ if (length == 0) {
+ serviceName = NULL;
+ } else {
+ ddeService = DdeCreateStringHandle(ddeInstance, serviceName,
+ CP_WINANSI);
+ }
+ topicName = Tcl_GetStringFromObj(objv[firstArg + 1], &length);
+ if (length == 0) {
+ topicName = NULL;
+ } else {
+ ddeTopic = DdeCreateStringHandle(ddeInstance, topicName, CP_WINANSI);
+ }
+
+ switch (index) {
+ case DDE_EXECUTE: {
+ dataString = Tcl_GetStringFromObj(objv[firstArg + 2], &dataLength);
+ if (dataLength == 0) {
+ Tcl_SetStringObj(Tcl_GetObjResult(interp),
+ "cannot execute null data", -1);
+ result = TCL_ERROR;
+ break;
+ }
+ hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
+
+ if (hConv == NULL) {
+ SetDdeError(interp);
+ result = TCL_ERROR;
+ break;
+ }
+
+ ddeData = DdeCreateDataHandle(ddeInstance, dataString,
+ dataLength, 0, 0, CF_TEXT, 0);
+ if (ddeData != NULL) {
+ if (async) {
+ DdeClientTransaction((LPBYTE) ddeData, 0xFFFFFFFF, hConv, 0,
+ CF_TEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult);
+ DdeAbandonTransaction(ddeInstance, hConv, ddeResult);
+ } else {
+ ddeReturn = DdeClientTransaction((LPBYTE) ddeData, 0xFFFFFFFF,
+ hConv, 0, CF_TEXT, XTYP_EXECUTE, 7200000, NULL);
+ if (ddeReturn == 0) {
+ SetDdeError(interp);
+ result = TCL_ERROR;
+ }
+ }
+ DdeFreeDataHandle(ddeData);
+ } else {
+ SetDdeError(interp);
+ result = TCL_ERROR;
+ }
+ DdeDisconnect(hConv);
+ break;
+ }
+ case DDE_REQUEST: {
+ itemString = Tcl_GetStringFromObj(objv[firstArg + 2], &length);
+ if (length == 0) {
+ Tcl_SetStringObj(Tcl_GetObjResult(interp),
+ "cannot request value of null data", -1);
+ return TCL_ERROR;
+ }
+ hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
+
+ if (hConv == NULL) {
+ SetDdeError(interp);
+ result = TCL_ERROR;
+ } else {
+ Tcl_Obj *returnObjPtr;
+ ddeItem = DdeCreateStringHandle(ddeInstance, itemString,
+ CP_WINANSI);
+ if (ddeItem != NULL) {
+ ddeData = DdeClientTransaction(NULL, 0, hConv, ddeItem,
+ CF_TEXT, XTYP_REQUEST, 5000, NULL);
+ if (ddeData == NULL) {
+ SetDdeError(interp);
+ result = TCL_ERROR;
+ } else {
+ dataString = DdeAccessData(ddeData, &dataLength);
+ returnObjPtr = Tcl_NewStringObj(dataString, dataLength);
+ DdeUnaccessData(ddeData);
+ DdeFreeDataHandle(ddeData);
+ Tcl_SetObjResult(interp, returnObjPtr);
+ }
+ } else {
+ SetDdeError(interp);
+ result = TCL_ERROR;
+ }
+ DdeDisconnect(hConv);
+ }
+
+ break;
+ }
+ case DDE_SERVICES: {
+ HCONVLIST hConvList;
+ CONVINFO convInfo;
+ Tcl_Obj *convListObjPtr, *elementObjPtr;
+ Tcl_DString dString;
+ char *name;
+
+ convInfo.cb = sizeof(CONVINFO);
+ hConvList = DdeConnectList(ddeInstance, ddeService, ddeTopic,
+ 0, NULL);
+ hConv = 0;
+ convListObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+ Tcl_DStringInit(&dString);
+
+ while (hConv = DdeQueryNextServer(hConvList, hConv), hConv != 0) {
+ elementObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+ DdeQueryConvInfo(hConv, QID_SYNC, &convInfo);
+ length = DdeQueryString(ddeInstance, convInfo.hszSvcPartner,
+ NULL, 0, CP_WINANSI);
+ Tcl_DStringSetLength(&dString, length);
+ name = Tcl_DStringValue(&dString);
+ DdeQueryString(ddeInstance, convInfo.hszSvcPartner, name,
+ length + 1, CP_WINANSI);
+ Tcl_ListObjAppendElement(interp, elementObjPtr,
+ Tcl_NewStringObj(name, length));
+ length = DdeQueryString(ddeInstance, convInfo.hszTopic,
+ NULL, 0, CP_WINANSI);
+ Tcl_DStringSetLength(&dString, length);
+ name = Tcl_DStringValue(&dString);
+ DdeQueryString(ddeInstance, convInfo.hszTopic, name,
+ length + 1, CP_WINANSI);
+ Tcl_ListObjAppendElement(interp, elementObjPtr,
+ Tcl_NewStringObj(name, length));
+ Tcl_ListObjAppendElement(interp, convListObjPtr, elementObjPtr);
+ }
+ DdeDisconnectList(hConvList);
+ Tcl_SetObjResult(interp, convListObjPtr);
+ Tcl_DStringFree(&dString);
+ break;
+ }
+ }
+ if (ddeService != NULL) {
+ DdeFreeStringHandle(ddeInstance, ddeService);
+ }
+ if (ddeTopic != NULL) {
+ DdeFreeStringHandle(ddeInstance, ddeTopic);
+ }
+
+ return result;
+}
diff --git a/win/tkWinTest.c b/win/tkWinTest.c
new file mode 100644
index 0000000..3ca00d4
--- /dev/null
+++ b/win/tkWinTest.c
@@ -0,0 +1,230 @@
+/*
+ * tkWinTest.c --
+ *
+ * Contains commands for platform specific tests for
+ * the Windows platform.
+ *
+ * Copyright (c) 1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkWinTest.c 1.4 97/11/07 21:26:18
+ */
+
+#include "tkWinInt.h"
+
+HWND tkWinCurrentDialog;
+
+/*
+ * Forward declarations of procedures defined later in this file:
+ */
+
+int TkplatformtestInit(Tcl_Interp *interp);
+static int TestclipboardCmd(ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv);
+static int TestwineventCmd(ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv);
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkplatformtestInit --
+ *
+ * Defines commands that test platform specific functionality for
+ * Unix platforms.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * Defines new commands.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkplatformtestInit(
+ Tcl_Interp *interp) /* Interpreter to add commands to. */
+{
+ /*
+ * Add commands for platform specific tests on MacOS here.
+ */
+
+ Tcl_CreateCommand(interp, "testclipboard", TestclipboardCmd,
+ (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateCommand(interp, "testwinevent", TestwineventCmd,
+ (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestclipboardCmd --
+ *
+ * This procedure implements the testclipboard command. It provides
+ * a way to determine the actual contents of the Windows clipboard.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestclipboardCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Main window for application. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ TkWindow *winPtr = (TkWindow *) clientData;
+ HGLOBAL handle;
+ char *data;
+
+ if (OpenClipboard(NULL)) {
+ handle = GetClipboardData(CF_TEXT);
+ if (handle != NULL) {
+ data = GlobalLock(handle);
+ Tcl_AppendResult(interp, data, (char *) NULL);
+ GlobalUnlock(handle);
+ }
+ CloseClipboard();
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestwineventCmd --
+ *
+ * This procedure implements the testwinevent command. It provides
+ * a way to send messages to windows dialogs.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestwineventCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Main window for application. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ HWND hwnd;
+ int id;
+ char *rest;
+ UINT message;
+ WPARAM wParam;
+ LPARAM lParam;
+ static TkStateMap messageMap[] = {
+ {WM_LBUTTONDOWN, "WM_LBUTTONDOWN"},
+ {WM_LBUTTONUP, "WM_LBUTTONUP"},
+ {WM_CHAR, "WM_CHAR"},
+ {WM_GETTEXT, "WM_GETTEXT"},
+ {WM_SETTEXT, "WM_SETTEXT"},
+ {-1, NULL}
+ };
+
+ if ((argc == 3) && (strcmp(argv[1], "debug") == 0)) {
+ int i;
+
+ if (Tcl_GetBoolean(interp, argv[2], &i) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ TkWinDialogDebug(i);
+ return TCL_OK;
+ }
+
+ if (argc < 4) {
+ return TCL_ERROR;
+ }
+
+ hwnd = (HWND) strtol(argv[1], &rest, 0);
+ if (rest == argv[2]) {
+ hwnd = FindWindow(NULL, argv[1]);
+ if (hwnd == NULL) {
+ Tcl_SetResult(interp, "no such window", TCL_STATIC);
+ return TCL_ERROR;
+ }
+ }
+ UpdateWindow(hwnd);
+
+ id = strtol(argv[2], &rest, 0);
+ if (rest == argv[2]) {
+ HWND child;
+ char buf[256];
+
+ child = GetWindow(hwnd, GW_CHILD);
+ while (child != NULL) {
+ SendMessage(child, WM_GETTEXT, (WPARAM) sizeof(buf), (LPARAM) buf);
+ if (strcasecmp(buf, argv[2]) == 0) {
+ id = GetDlgCtrlID(child);
+ break;
+ }
+ child = GetWindow(child, GW_HWNDNEXT);
+ }
+ if (child == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ message = TkFindStateNum(NULL, NULL, messageMap, argv[3]);
+ if (message < 0) {
+ message = strtol(argv[3], NULL, 0);
+ }
+ wParam = 0;
+ lParam = 0;
+
+ if (argc > 4) {
+ wParam = strtol(argv[4], NULL, 0);
+ }
+ if (argc > 5) {
+ lParam = strtol(argv[5], NULL, 0);
+ }
+
+ switch (message) {
+ case WM_GETTEXT: {
+ Tcl_DString ds;
+ char buf[256];
+
+ GetDlgItemText(hwnd, id, buf, 256);
+ Tcl_ExternalToUtfDString(NULL, buf, -1, &ds);
+ Tcl_AppendResult(interp, Tcl_DStringValue(&ds), NULL);
+ Tcl_DStringFree(&ds);
+ break;
+ }
+ case WM_SETTEXT: {
+ Tcl_DString ds;
+
+ Tcl_UtfToExternalDString(NULL, argv[4], -1, &ds);
+ SetDlgItemText(hwnd, id, Tcl_DStringValue(&ds));
+ Tcl_DStringFree(&ds);
+ break;
+ }
+ default: {
+ char buf[TCL_INTEGER_SPACE];
+
+ sprintf(buf, "%d",
+ SendDlgItemMessage(hwnd, id, message, wParam, lParam));
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ break;
+ }
+ }
+ return TCL_OK;
+}
+
+
+
diff --git a/win/tkWinWindow.c b/win/tkWinWindow.c
index 2b8eb41..ab723c4 100644
--- a/win/tkWinWindow.c
+++ b/win/tkWinWindow.c
@@ -4,12 +4,12 @@
* Xlib emulation routines for Windows related to creating,
* displaying and destroying windows.
*
- * Copyright (c) 1995 Sun Microsystems, Inc.
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * SCCS: @(#) tkWinWindow.c 1.23 97/07/01 18:14:13
+ * SCCS: @(#) tkWinWindow.c 1.25 97/12/08 15:16:32
*/
#include "tkWinInt.h"
@@ -114,7 +114,12 @@ Tk_Window
Tk_HWNDToWindow(hwnd)
HWND hwnd;
{
- Tcl_HashEntry *entryPtr = Tcl_FindHashEntry(&windowTable, (char*)hwnd);
+ Tcl_HashEntry *entryPtr;
+ if (!initialized) {
+ Tcl_InitHashTable(&windowTable, TCL_ONE_WORD_KEYS);
+ initialized = 1;
+ }
+ entryPtr = Tcl_FindHashEntry(&windowTable, (char*)hwnd);
if (entryPtr != NULL) {
return (Tk_Window) Tcl_GetHashValue(entryPtr);
}
@@ -185,7 +190,7 @@ TkpPrintWindowId(buf, window)
* The return value is normally TCL_OK; in this case *idPtr
* will be set to the X Window id equivalent to string. If
* string is improperly formed then TCL_ERROR is returned and
- * an error message will be left in interp->result. If the
+ * an error message will be left in the interp's result. If the
* number does not correspond to a Tk Window, then *idPtr will
* be set to None.
*
diff --git a/win/tkWinWm.c b/win/tkWinWm.c
index 6ec1a2a..c81e137 100644
--- a/win/tkWinWm.c
+++ b/win/tkWinWm.c
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * SCCS: @(#) tkWinWm.c 1.67 97/09/23 17:39:47
+ * SCCS: @(#) tkWinWm.c 1.68 97/11/07 21:25:21
*/
#include "tkWinInt.h"
@@ -1096,7 +1096,7 @@ Tk_WmCmd(clientData, interp, argc, argv)
return TCL_ERROR;
}
if (argc == 2) {
- interp->result = (wmTracing) ? "on" : "off";
+ Tcl_SetResult(interp, ((wmTracing) ? "on" : "off"), TCL_STATIC);
return TCL_OK;
}
return Tcl_GetBoolean(interp, argv[2], &wmTracing);
@@ -1126,9 +1126,12 @@ Tk_WmCmd(clientData, interp, argc, argv)
}
if (argc == 3) {
if (wmPtr->sizeHintsFlags & PAspect) {
- sprintf(interp->result, "%d %d %d %d", wmPtr->minAspect.x,
+ char buf[TCL_INTEGER_SPACE * 4];
+
+ sprintf(buf, "%d %d %d %d", wmPtr->minAspect.x,
wmPtr->minAspect.y, wmPtr->maxAspect.x,
wmPtr->maxAspect.y);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
}
return TCL_OK;
}
@@ -1143,7 +1146,8 @@ Tk_WmCmd(clientData, interp, argc, argv)
}
if ((numer1 <= 0) || (denom1 <= 0) || (numer2 <= 0) ||
(denom2 <= 0)) {
- interp->result = "aspect number can't be <= 0";
+ Tcl_SetResult(interp, "aspect number can't be <= 0",
+ TCL_STATIC);
return TCL_ERROR;
}
wmPtr->minAspect.x = numer1;
@@ -1163,7 +1167,7 @@ Tk_WmCmd(clientData, interp, argc, argv)
}
if (argc == 3) {
if (wmPtr->clientMachine != NULL) {
- interp->result = wmPtr->clientMachine;
+ Tcl_SetResult(interp, wmPtr->clientMachine, TCL_STATIC);
}
return TCL_OK;
}
@@ -1278,8 +1282,9 @@ Tk_WmCmd(clientData, interp, argc, argv)
}
if (argc == 3) {
if (wmPtr->cmdArgv != NULL) {
- interp->result = Tcl_Merge(wmPtr->cmdArgc, wmPtr->cmdArgv);
- interp->freeProc = TCL_DYNAMIC;
+ Tcl_SetResult(interp,
+ Tcl_Merge(wmPtr->cmdArgc, wmPtr->cmdArgv),
+ TCL_DYNAMIC);
}
return TCL_OK;
}
@@ -1331,7 +1336,8 @@ Tk_WmCmd(clientData, interp, argc, argv)
return TCL_ERROR;
}
if (argc == 3) {
- interp->result = wmPtr->hints.input ? "passive" : "active";
+ Tcl_SetResult(interp, (wmPtr->hints.input ? "passive" : "active"),
+ TCL_STATIC);
return TCL_OK;
}
c = argv[3][0];
@@ -1348,6 +1354,7 @@ Tk_WmCmd(clientData, interp, argc, argv)
} else if ((c == 'f') && (strncmp(argv[1], "frame", length) == 0)
&& (length >= 2)) {
HWND hwnd;
+ char buf[TCL_INTEGER_SPACE];
if (argc != 3) {
Tcl_AppendResult(interp, "wrong # arguments: must be \"",
@@ -1358,7 +1365,8 @@ Tk_WmCmd(clientData, interp, argc, argv)
if (hwnd == NULL) {
hwnd = Tk_GetHWND(Tk_WindowId((Tk_Window) winPtr));
}
- sprintf(interp->result, "0x%x", (unsigned int) hwnd);
+ sprintf(buf, "0x%x", (unsigned int) hwnd);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
} else if ((c == 'g') && (strncmp(argv[1], "geometry", length) == 0)
&& (length >= 2)) {
char xSign, ySign;
@@ -1371,6 +1379,8 @@ Tk_WmCmd(clientData, interp, argc, argv)
return TCL_ERROR;
}
if (argc == 3) {
+ char buf[16 + TCL_INTEGER_SPACE * 4];
+
xSign = (wmPtr->flags & WM_NEGATIVE_X) ? '-' : '+';
ySign = (wmPtr->flags & WM_NEGATIVE_Y) ? '-' : '+';
if (wmPtr->gridWin != NULL) {
@@ -1382,8 +1392,9 @@ Tk_WmCmd(clientData, interp, argc, argv)
width = winPtr->changes.width;
height = winPtr->changes.height;
}
- sprintf(interp->result, "%dx%d%c%d%c%d", width, height,
- xSign, wmPtr->x, ySign, wmPtr->y);
+ sprintf(buf, "%dx%d%c%d%c%d", width, height, xSign, wmPtr->x,
+ ySign, wmPtr->y);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
return TCL_OK;
}
if (*argv[3] == '\0') {
@@ -1404,9 +1415,12 @@ Tk_WmCmd(clientData, interp, argc, argv)
}
if (argc == 3) {
if (wmPtr->sizeHintsFlags & PBaseSize) {
- sprintf(interp->result, "%d %d %d %d", wmPtr->reqGridWidth,
+ char buf[TCL_INTEGER_SPACE * 4];
+
+ sprintf(buf, "%d %d %d %d", wmPtr->reqGridWidth,
wmPtr->reqGridHeight, wmPtr->widthInc,
wmPtr->heightInc);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
}
return TCL_OK;
}
@@ -1433,19 +1447,19 @@ Tk_WmCmd(clientData, interp, argc, argv)
return TCL_ERROR;
}
if (reqWidth < 0) {
- interp->result = "baseWidth can't be < 0";
+ Tcl_SetResult(interp, "baseWidth can't be < 0", TCL_STATIC);
return TCL_ERROR;
}
if (reqHeight < 0) {
- interp->result = "baseHeight can't be < 0";
+ Tcl_SetResult(interp, "baseHeight can't be < 0", TCL_STATIC);
return TCL_ERROR;
}
if (widthInc < 0) {
- interp->result = "widthInc can't be < 0";
+ Tcl_SetResult(interp, "widthInc can't be < 0", TCL_STATIC);
return TCL_ERROR;
}
if (heightInc < 0) {
- interp->result = "heightInc can't be < 0";
+ Tcl_SetResult(interp, "heightInc can't be < 0", TCL_STATIC);
return TCL_ERROR;
}
Tk_SetGrid((Tk_Window) winPtr, reqWidth, reqHeight, widthInc,
@@ -1464,7 +1478,7 @@ Tk_WmCmd(clientData, interp, argc, argv)
}
if (argc == 3) {
if (wmPtr->hints.flags & WindowGroupHint) {
- interp->result = wmPtr->leaderName;
+ Tcl_SetResult(interp, wmPtr->leaderName, TCL_STATIC);
}
return TCL_OK;
}
@@ -1497,8 +1511,9 @@ Tk_WmCmd(clientData, interp, argc, argv)
}
if (argc == 3) {
if (wmPtr->hints.flags & IconPixmapHint) {
- interp->result = Tk_NameOfBitmap(winPtr->display,
- wmPtr->hints.icon_pixmap);
+ Tcl_SetResult(interp,
+ Tk_NameOfBitmap(winPtr->display, wmPtr->hints.icon_pixmap),
+ TCL_STATIC);
}
return TCL_OK;
}
@@ -1556,8 +1571,9 @@ Tk_WmCmd(clientData, interp, argc, argv)
}
if (argc == 3) {
if (wmPtr->hints.flags & IconMaskHint) {
- interp->result = Tk_NameOfBitmap(winPtr->display,
- wmPtr->hints.icon_mask);
+ Tcl_SetResult(interp,
+ Tk_NameOfBitmap(winPtr->display, wmPtr->hints.icon_mask),
+ TCL_STATIC);
}
return TCL_OK;
}
@@ -1582,7 +1598,9 @@ Tk_WmCmd(clientData, interp, argc, argv)
return TCL_ERROR;
}
if (argc == 3) {
- interp->result = (wmPtr->iconName != NULL) ? wmPtr->iconName : "";
+ Tcl_SetResult(interp,
+ ((wmPtr->iconName != NULL) ? wmPtr->iconName : ""),
+ TCL_STATIC);
return TCL_OK;
} else {
wmPtr->iconName = Tk_GetUid(argv[3]);
@@ -1602,8 +1620,11 @@ Tk_WmCmd(clientData, interp, argc, argv)
}
if (argc == 3) {
if (wmPtr->hints.flags & IconPositionHint) {
- sprintf(interp->result, "%d %d", wmPtr->hints.icon_x,
+ char buf[TCL_INTEGER_SPACE * 2];
+
+ sprintf(buf, "%d %d", wmPtr->hints.icon_x,
wmPtr->hints.icon_y);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
}
return TCL_OK;
}
@@ -1632,7 +1653,7 @@ Tk_WmCmd(clientData, interp, argc, argv)
}
if (argc == 3) {
if (wmPtr->icon != NULL) {
- interp->result = Tk_PathName(wmPtr->icon);
+ Tcl_SetResult(interp, Tk_PathName(wmPtr->icon), TCL_STATIC);
}
return TCL_OK;
}
@@ -1699,8 +1720,9 @@ Tk_WmCmd(clientData, interp, argc, argv)
if (!(wmPtr2->flags & WM_NEVER_MAPPED)) {
if (XWithdrawWindow(Tk_Display(tkwin2), Tk_WindowId(tkwin2),
Tk_ScreenNumber(tkwin2)) == 0) {
- interp->result =
- "couldn't send withdraw message to window manager";
+ Tcl_SetResult(interp,
+ "couldn't send withdraw message to window manager",
+ TCL_STATIC);
return TCL_ERROR;
}
}
@@ -1715,8 +1737,11 @@ Tk_WmCmd(clientData, interp, argc, argv)
return TCL_ERROR;
}
if (argc == 3) {
+ char buf[TCL_INTEGER_SPACE * 2];
+
GetMaxSize(wmPtr, &width, &height);
- sprintf(interp->result, "%d %d", width, height);
+ sprintf(buf, "%d %d", width, height);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
return TCL_OK;
}
if ((Tcl_GetInt(interp, argv[3], &width) != TCL_OK)
@@ -1736,8 +1761,11 @@ Tk_WmCmd(clientData, interp, argc, argv)
return TCL_ERROR;
}
if (argc == 3) {
+ char buf[TCL_INTEGER_SPACE * 2];
+
GetMinSize(wmPtr, &width, &height);
- sprintf(interp->result, "%d %d", width, height);
+ sprintf(buf, "%d %d", width, height);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
return TCL_OK;
}
if ((Tcl_GetInt(interp, argv[3], &width) != TCL_OK)
@@ -1760,9 +1788,9 @@ Tk_WmCmd(clientData, interp, argc, argv)
}
if (argc == 3) {
if (Tk_Attributes((Tk_Window) winPtr)->override_redirect) {
- interp->result = "1";
+ Tcl_SetResult(interp, "1", TCL_STATIC);
} else {
- interp->result = "0";
+ Tcl_SetResult(interp, "0", TCL_STATIC);
}
return TCL_OK;
}
@@ -1786,9 +1814,9 @@ Tk_WmCmd(clientData, interp, argc, argv)
}
if (argc == 3) {
if (wmPtr->sizeHintsFlags & USPosition) {
- interp->result = "user";
+ Tcl_SetResult(interp, "user", TCL_STATIC);
} else if (wmPtr->sizeHintsFlags & PPosition) {
- interp->result = "program";
+ Tcl_SetResult(interp, "program", TCL_STATIC);
}
return TCL_OK;
}
@@ -1842,7 +1870,7 @@ Tk_WmCmd(clientData, interp, argc, argv)
for (protPtr = wmPtr->protPtr; protPtr != NULL;
protPtr = protPtr->nextPtr) {
if (protPtr->protocol == protocol) {
- interp->result = protPtr->command;
+ Tcl_SetResult(interp, protPtr->command, TCL_STATIC);
return TCL_OK;
}
}
@@ -1886,9 +1914,12 @@ Tk_WmCmd(clientData, interp, argc, argv)
return TCL_ERROR;
}
if (argc == 3) {
- sprintf(interp->result, "%d %d",
+ char buf[TCL_INTEGER_SPACE * 2];
+
+ sprintf(buf, "%d %d",
(wmPtr->flags & WM_WIDTH_NOT_RESIZABLE) ? 0 : 1,
(wmPtr->flags & WM_HEIGHT_NOT_RESIZABLE) ? 0 : 1);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
return TCL_OK;
}
if ((Tcl_GetBoolean(interp, argv[3], &width) != TCL_OK)
@@ -1917,9 +1948,9 @@ Tk_WmCmd(clientData, interp, argc, argv)
}
if (argc == 3) {
if (wmPtr->sizeHintsFlags & USSize) {
- interp->result = "user";
+ Tcl_SetResult(interp, "user", TCL_STATIC);
} else if (wmPtr->sizeHintsFlags & PSize) {
- interp->result = "program";
+ Tcl_SetResult(interp, "program", TCL_STATIC);
}
return TCL_OK;
}
@@ -1950,20 +1981,20 @@ Tk_WmCmd(clientData, interp, argc, argv)
return TCL_ERROR;
}
if (wmPtr->iconFor != NULL) {
- interp->result = "icon";
+ Tcl_SetResult(interp, "icon", TCL_STATIC);
} else {
switch (wmPtr->hints.initial_state) {
case NormalState:
- interp->result = "normal";
+ Tcl_SetResult(interp, "normal", TCL_STATIC);
break;
case IconicState:
- interp->result = "iconic";
+ Tcl_SetResult(interp, "iconic", TCL_STATIC);
break;
case WithdrawnState:
- interp->result = "withdrawn";
+ Tcl_SetResult(interp, "withdrawn", TCL_STATIC);
break;
case ZoomState:
- interp->result = "zoomed";
+ Tcl_SetResult(interp, "zoomed", TCL_STATIC);
break;
}
}
@@ -1975,8 +2006,9 @@ Tk_WmCmd(clientData, interp, argc, argv)
return TCL_ERROR;
}
if (argc == 3) {
- interp->result = (wmPtr->titleUid != NULL) ? wmPtr->titleUid
- : winPtr->nameUid;
+ Tcl_SetResult(interp,
+ ((wmPtr->titleUid != NULL) ? wmPtr->titleUid : winPtr->nameUid),
+ TCL_STATIC);
return TCL_OK;
} else {
wmPtr->titleUid = Tk_GetUid(argv[3]);
@@ -2576,7 +2608,7 @@ UpdateGeometryInfo(clientData)
*
* Results:
* A standard Tcl return value, plus an error message in
- * interp->result if an error occurs.
+ * the interp's result if an error occurs.
*
* Side effects:
* The size and/or location of winPtr may change.
diff --git a/win/tkWinX.c b/win/tkWinX.c
index 0b00186..579eaf7 100644
--- a/win/tkWinX.c
+++ b/win/tkWinX.c
@@ -9,10 +9,9 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * SCCS: @(#) tkWinX.c 1.51 97/09/02 13:06:57
+ * SCCS: @(#) tkWinX.c 1.55 98/01/21 00:23:17
*/
-#include "tkInt.h"
#include "tkWinInt.h"
/*
@@ -763,19 +762,61 @@ GenerateXEvent(hwnd, message, wParam, lParam)
*/
event.type = KeyRelease;
event.xkey.keycode = wParam;
- event.xkey.nchars = 0;
+ event.xkey.nbytes = 0;
break;
case WM_CHAR:
/*
* Synthesize both a KeyPress and a KeyRelease.
+ * Strings generated by Input Method Editor are handled
+ * in the following manner:
+ * 1. A series of WM_KEYDOWN & WM_KEYUP messages that
+ * cause GetTranslatedKey() to be called and return
+ * immediately because the WM_KEYDOWNs have no
+ * associated WM_CHAR messages -- the IME window is
+ * accumulating the characters and translating them
+ * itself. In the "bind" command, you get an event
+ * with a mystery keysym and %A == "" for each
+ * WM_KEYDOWN that actually was meant for the IME.
+ * 2. A WM_KEYDOWN corresponding to the "confirm typing"
+ * character. This causes GetTranslatedKey() to be
+ * called.
+ * 3. A WM_IME_NOTIFY message saying that the IME is
+ * done. A side effect of this message is that
+ * GetTranslatedKey() thinks this means that there
+ * are no WM_CHAR messages and returns immediately.
+ * In the "bind" command, you get an another event
+ * with a mystery keysym and %A == "".
+ * 4. A sequence of WM_CHAR messages that correspond to
+ * the characters in the IME window. A bunch of
+ * simulated KeyPress/KeyRelease events will be
+ * generated, one for each character. Adjacent
+ * WM_CHAR messages may actually specify the high
+ * and low bytes of a multi-byte character -- in that
+ * case the two WM_CHAR messages will be combined into
+ * one event. It is the event-consumer's
+ * responsibility to convert the string returned from
+ * XLookupString from system encoding to UTF-8.
+ * 5. And finally we get the WM_KEYUP for the "confirm
+ * typing" character.
*/
event.type = KeyPress;
event.xany.send_event = -1;
event.xkey.keycode = 0;
- event.xkey.nchars = 1;
+ event.xkey.nbytes = 1;
event.xkey.trans_chars[0] = (char) wParam;
+
+ if (IsDBCSLeadByte((BYTE) wParam)) {
+ MSG msg;
+
+ if ((PeekMessage(&msg, NULL, 0, 0, PM_NOREMOVE) != 0)
+ && (msg.message == WM_CHAR)) {
+ GetMessage(&msg, NULL, 0, 0);
+ event.xkey.nbytes = 2;
+ event.xkey.trans_chars[1] = (char) msg.wParam;
+ }
+ }
Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL);
event.type = KeyRelease;
break;
@@ -874,7 +915,7 @@ GetState(message, wParam, lParam)
* given KeyPress event.
*
* Results:
- * Sets the trans_chars and nchars member of the key event.
+ * Sets the trans_chars and nbytes member of the key event.
*
* Side effects:
* Removes any WM_CHAR messages waiting on the top of the system
@@ -888,18 +929,21 @@ GetTranslatedKey(xkey)
XKeyEvent *xkey;
{
MSG msg;
+ char buf[XMaxTransChars];
- xkey->nchars = 0;
+ xkey->nbytes = 0;
- while (xkey->nchars < XMaxTransChars
+ while ((xkey->nbytes < XMaxTransChars)
&& PeekMessage(&msg, NULL, 0, 0, PM_NOREMOVE)) {
if (msg.message == WM_CHAR) {
- xkey->trans_chars[xkey->nchars] = (char) msg.wParam;
- xkey->nchars++;
GetMessage(&msg, NULL, 0, 0);
- if ((msg.message == WM_CHAR) && (msg.lParam & 0x20000000)) {
+
+ if (msg.lParam & 0x20000000) {
xkey->state = 0;
}
+ buf[xkey->nbytes] = (char) msg.wParam;
+ xkey->trans_chars[xkey->nbytes] = (char) msg.wParam;
+ xkey->nbytes++;
} else {
break;
}
diff --git a/win/winMain.c b/win/winMain.c
index f263339..691aa91 100644
--- a/win/winMain.c
+++ b/win/winMain.c
@@ -3,12 +3,12 @@
*
* Main entry point for wish and other Tk-based applications.
*
- * Copyright (c) 1995 Sun Microsystems, Inc.
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * SCCS: @(#) winMain.c 1.33 96/12/17 12:56:14
+ * SCCS: @(#) winMain.c 1.37 98/01/20 22:47:06
*/
#include <tk.h>
@@ -37,6 +37,11 @@ static void WishPanic _ANSI_ARGS_(TCL_VARARGS(char *,format));
EXTERN int Tktest_Init(Tcl_Interp *interp);
#endif /* TK_TEST */
+#ifdef TCL_TEST
+EXTERN int TclObjTest_Init _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN int Tcltest_Init _ANSI_ARGS_((Tcl_Interp *interp));
+#endif /* TCL_TEST */
+
/*
*----------------------------------------------------------------------
@@ -62,9 +67,8 @@ WinMain(hInstance, hPrevInstance, lpszCmdLine, nCmdShow)
LPSTR lpszCmdLine;
int nCmdShow;
{
- char **argv, *p;
+ char **argv;
int argc;
- char buffer[MAX_PATH];
Tcl_SetPanicProc(WishPanic);
@@ -74,7 +78,7 @@ WinMain(hInstance, hPrevInstance, lpszCmdLine, nCmdShow)
*/
setlocale(LC_ALL, "C");
-
+ setargv(&argc, &argv);
/*
* Increase the application queue size from default value of 8.
@@ -83,6 +87,7 @@ WinMain(hInstance, hPrevInstance, lpszCmdLine, nCmdShow)
* This is only needed for Windows 3.x, since NT dynamically expands
* the queue.
*/
+
SetMessageQueue(64);
/*
@@ -93,21 +98,6 @@ WinMain(hInstance, hPrevInstance, lpszCmdLine, nCmdShow)
TkConsoleCreate();
- setargv(&argc, &argv);
-
- /*
- * Replace argv[0] with full pathname of executable, and forward
- * slashes substituted for backslashes.
- */
-
- GetModuleFileName(NULL, buffer, sizeof(buffer));
- argv[0] = buffer;
- for (p = buffer; *p != '\0'; p++) {
- if (*p == '\\') {
- *p = '/';
- }
- }
-
Tk_Main(argc, argv, Tcl_AppInit);
return 1;
}
@@ -124,7 +114,7 @@ WinMain(hInstance, hPrevInstance, lpszCmdLine, nCmdShow)
*
* Results:
* Returns a standard Tcl completion code, and leaves an error
- * message in interp->result if an error occurs.
+ * message in the interp's result if an error occurs.
*
* Side effects:
* Depends on the startup script.
@@ -153,6 +143,17 @@ Tcl_AppInit(interp)
goto error;
}
+#ifdef TCL_TEST
+ if (Tcltest_Init(interp) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init,
+ (Tcl_PackageInitProc *) NULL);
+ if (TclObjTest_Init(interp) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+#endif /* TCL_TEST */
+
#ifdef TK_TEST
if (Tktest_Init(interp) == TCL_ERROR) {
goto error;
@@ -165,7 +166,7 @@ Tcl_AppInit(interp)
return TCL_OK;
error:
- WishPanic(interp->result);
+ WishPanic(Tcl_GetStringResult(interp));
return TCL_ERROR;
}
@@ -241,7 +242,7 @@ setargv(argcPtr, argvPtr)
char **argv;
int argc, size, inquote, copy, slashes;
- cmdLine = GetCommandLine();
+ cmdLine = GetCommandLine(); /* INTL: BUG */
/*
* Precompute an overly pessimistic guess at the number of arguments
@@ -250,9 +251,9 @@ setargv(argcPtr, argvPtr)
size = 2;
for (p = cmdLine; *p != '\0'; p++) {
- if (isspace(*p)) {
+ if ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */
size++;
- while (isspace(*p)) {
+ while ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */
p++;
}
if (*p == '\0') {
@@ -260,8 +261,8 @@ setargv(argcPtr, argvPtr)
}
}
}
- argSpace = (char *) ckalloc((unsigned) (size * sizeof(char *)
- + strlen(cmdLine) + 1));
+ argSpace = (char *) Tcl_Alloc(
+ (unsigned) (size * sizeof(char *) + strlen(cmdLine) + 1));
argv = (char **) argSpace;
argSpace += size * sizeof(char *);
size--;
@@ -269,7 +270,7 @@ setargv(argcPtr, argvPtr)
p = cmdLine;
for (argc = 0; argc < size; argc++) {
argv[argc] = arg = argSpace;
- while (isspace(*p)) {
+ while ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */
p++;
}
if (*p == '\0') {
@@ -303,7 +304,8 @@ setargv(argcPtr, argvPtr)
slashes--;
}
- if ((*p == '\0') || (!inquote && isspace(*p))) {
+ if ((*p == '\0')
+ || (!inquote && ((*p == ' ') || (*p == '\t')))) { /* INTL: ISO space. */
break;
}
if (copy != 0) {
@@ -320,4 +322,3 @@ setargv(argcPtr, argvPtr)
*argcPtr = argc;
*argvPtr = argv;
}
-
generated by cgit v0.12 at 2024-07-16 09:26:03 (GMT)