diff options
Diffstat (limited to 'win')
-rw-r--r-- | win/README | 35 | ||||
-rw-r--r-- | win/makefile.bc | 20 | ||||
-rw-r--r-- | win/makefile.vc | 12 | ||||
-rw-r--r-- | win/rc/tk.rc | 34 | ||||
-rw-r--r-- | win/tkWin.h | 7 | ||||
-rw-r--r-- | win/tkWin32Dll.c | 38 | ||||
-rw-r--r-- | win/tkWin3d.c | 6 | ||||
-rw-r--r-- | win/tkWinButton.c | 76 | ||||
-rw-r--r-- | win/tkWinClipboard.c | 6 | ||||
-rw-r--r-- | win/tkWinColor.c | 6 | ||||
-rw-r--r-- | win/tkWinConfig.c | 60 | ||||
-rw-r--r-- | win/tkWinCursor.c | 7 | ||||
-rw-r--r-- | win/tkWinDefault.h | 5 | ||||
-rw-r--r-- | win/tkWinDialog.c | 1580 | ||||
-rw-r--r-- | win/tkWinEmbed.c | 9 | ||||
-rw-r--r-- | win/tkWinFont.c | 2124 | ||||
-rw-r--r-- | win/tkWinInit.c | 4 | ||||
-rw-r--r-- | win/tkWinInt.h | 14 | ||||
-rw-r--r-- | win/tkWinKey.c | 72 | ||||
-rw-r--r-- | win/tkWinMenu.c | 667 | ||||
-rw-r--r-- | win/tkWinPort.h | 4 | ||||
-rw-r--r-- | win/tkWinScrlbr.c | 4 | ||||
-rw-r--r-- | win/tkWinSend.c | 1182 | ||||
-rw-r--r-- | win/tkWinTest.c | 230 | ||||
-rw-r--r-- | win/tkWinWindow.c | 13 | ||||
-rw-r--r-- | win/tkWinWm.c | 120 | ||||
-rw-r--r-- | win/tkWinX.c | 64 | ||||
-rw-r--r-- | win/winMain.c | 61 |
28 files changed, 5151 insertions, 1309 deletions
@@ -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; } - |