Tk Source Code

	((HINSTANCE) GetWindowLongPtr((from), GWLP_HINSTANCE))
#define TkWinGetUserData(from) \
	GetWindowLongPtr((from), GWLP_USERDATA)
#define TkWinSetUserData(to,what) \
	SetWindowLongPtr((to), GWLP_USERDATA, (LPARAM)(what))

/*
 * The value of TK_MULTI_MAX_PATH dictactes how many files can be retrieved
 * with tk_get*File -multiple 1. It must be allocated on the stack, so make it
 * large enough but not too large. - hobbs
 *
 * The data is stored as <dir>\0<file1>\0<file2>\0...<fileN>\0\0. Since
 * MAX_PATH == 260 on Win2K/NT, *40 is ~10Kbytes.
 */

				 * browser listbox. */
    char 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. */
    OPENFILENAMEA *ofnPtr;	/* pointer to the OFN structure */
} ChooseDir;

/*
 * The following structure is used to pass information between GetFileName
 * function and OFN dialog hook procedures. [Bug 2896501, Patch 2898255]
 */

typedef struct OFNData {
    Tcl_Interp *interp;		/* Interp, used only if debug is turned on,
				 * for setting the "tk_dialog" variable. */
    int dynFileBufferSize;	/* Dynamic filename buffer size, stored to
				 * avoid shrinking and expanding the buffer
				 * when selection changes */
    char *dynFileBuffer;	/* Dynamic filename buffer, cast to WCHAR* in
				 * UNICODE procedures */
} OFNData;

/*
 * Definitions of functions used only in this file.
 */

static UINT APIENTRY	ChooseDirectoryValidateProc(HWND hdlg, UINT uMsg,

	    &filterIndex) != TCL_OK) {
	goto end;
    }

    Tk_MakeWindowExist(tkwin);
    hWnd = Tk_GetHWND(Tk_WindowId(tkwin));

    ZeroMemory(&ofn, sizeof(OPENFILENAMEW));
    if (LOBYTE(LOWORD(GetVersion())) < 5) {
	ofn.lStructSize = OPENFILENAME_SIZE_VERSION_400;
    } else {
	ofn.lStructSize = sizeof(OPENFILENAMEW);
    }
    ofn.hwndOwner = hWnd;
    ofn.hInstance = TkWinGetHInstance(ofn.hwndOwner);
    ofn.lpstrFile = (WCHAR *) file;
    ofn.nMaxFile = TK_MULTI_MAX_PATH;
    ofn.Flags = OFN_HIDEREADONLY | OFN_PATHMUSTEXIST | OFN_NOCHANGEDIR
	    | OFN_EXPLORER | OFN_ENABLEHOOK| OFN_ENABLESIZING;
    ofn.lpfnHook = (LPOFNHOOKPROC) OFNHookProc;
    ofn.lCustData = (LPARAM) &ofnData;

    if (open != 0) {

	ofn.Flags |= OFN_ALLOWMULTISELECT;

	/*
	 * Starting buffer size. The buffer will be expanded by the OFN dialog
	 * procedure when necessary
	 */

	ofnData.dynFileBufferSize = 1024;
	ofnData.dynFileBuffer = ckalloc(1024);
    }

    if (extension != NULL) {
	Tcl_UtfToExternalDString(unicodeEncoding, extension, -1, &extString);
	ofn.lpstrDefExt = (WCHAR *) Tcl_DStringValue(&extString);
    }

    Tcl_UtfToExternalDString(unicodeEncoding,
	    Tcl_DStringValue(&utfFilterString),
	    Tcl_DStringLength(&utfFilterString), &filterString);
    ofn.lpstrFilter = (WCHAR *) Tcl_DStringValue(&filterString);
    ofn.nFilterIndex = filterIndex;

    if (Tcl_DStringValue(&utfDirString)[0] != '\0') {
	Tcl_UtfToExternalDString(unicodeEncoding,
		Tcl_DStringValue(&utfDirString),
		Tcl_DStringLength(&utfDirString), &dirString);
    } else {

	    Tcl_ResetResult(interp);
	} else {
	    Tcl_UtfToExternalDString(unicodeEncoding, Tcl_DStringValue(&cwd),
		    Tcl_DStringLength(&cwd), &dirString);
	}
	Tcl_DStringFree(&cwd);
    }
    ofn.lpstrInitialDir = (WCHAR *) Tcl_DStringValue(&dirString);

    if (title != NULL) {
	Tcl_UtfToExternalDString(unicodeEncoding, title, -1, &titleString);
	ofn.lpstrTitle = (WCHAR *) Tcl_DStringValue(&titleString);
    }

    /*
     * Popup the dialog.
     */

    oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);

	if (ofn.Flags & OFN_ALLOWMULTISELECT) {
	    /*
	     * The result in dynFileBuffer contains many items, separated by
	     * NUL characters. It is terminated with two nulls in a row. The
	     * first element is the directory path.
	     */

	    WCHAR *files = (WCHAR *) ofnData.dynFileBuffer;
	    Tcl_Obj *returnList = Tcl_NewObj();
	    int count = 0;

	    /*
	     * Get directory.
	     */

	 * gathering the selected filenames happens twice when they fit into the
	 * declared buffer. Luckily, it's not frequent operation so it should
	 * not incur any noticeable delay. See [tktoolkit-Bugs-2987995]
	 */
	if (notifyPtr->hdr.code == CDN_FILEOK ||
		notifyPtr->hdr.code == CDN_SELCHANGE) {
	    int dirsize, selsize;
	    WCHAR *buffer;
	    int buffersize;

	    /*
	     * Change of selection. Unscramble the unholy mess that's in the
	     * selection buffer, resizing it if necessary.
	     */

	    ofnPtr = notifyPtr->lpOFN;
	    ofnData = (OFNData *) ofnPtr->lCustData;
	    buffer = (WCHAR *) ofnData->dynFileBuffer;
	    hdlg = GetParent(hdlg);

	    selsize = SendMessage(hdlg, CDM_GETSPEC, 0, 0);
	    dirsize = SendMessage(hdlg, CDM_GETFOLDERPATH, 0, 0);
	    buffersize = (selsize + dirsize + 1) * 2;

	    /*
	     * Just empty the buffer if dirsize indicates an error [Bug 3071836]
	     */
	    if ((selsize > 1) && (dirsize > 0)) {
		if (ofnData->dynFileBufferSize < buffersize) {
		    buffer = ckrealloc(buffer, buffersize);
		    ofnData->dynFileBufferSize = buffersize;
		    ofnData->dynFileBuffer = (char *) buffer;
		}

		SendMessage(hdlg, CDM_GETFOLDERPATH, dirsize, PTR2INT(buffer));
		buffer += dirsize;

		SendMessage(hdlg, CDM_GETSPEC, selsize, PTR2INT(buffer));

		/*
		 * If there are multiple files, delete the quotes and change
		 * every second quote to NULL terminator
		 */

		if (buffer[0] == '"') {
		    BOOL findquote = TRUE;
		    WCHAR *tmp = buffer;

		    while(*buffer != '\0') {
			if (findquote) {
			    if (*buffer == '"') {
				findquote = FALSE;
			    }
			    buffer++;

	    if (SUCCEEDED(SHGetMalloc(&pMalloc))) {
		if (SUCCEEDED(SHGetDesktopFolder(&psfFolder))) {
		    LPITEMIDLIST pidlMain;
		    ULONG ulCount, ulAttr;

		    if (SUCCEEDED(psfFolder->lpVtbl->ParseDisplayName(
			    psfFolder, hwnd, NULL, (WCHAR *)
			    Tcl_DStringValue(&initDirDStr), &ulCount,&pidlMain,&ulAttr))
			    && (pidlMain != NULL)) {
			SendMessageA(hwnd, BFFM_SETSELECTION, FALSE,
				(LPARAM) pidlMain);
			pMalloc->lpVtbl->Free(pMalloc, pidlMain);
		    }
		    psfFolder->lpVtbl->Release(psfFolder);

     * In order to have the parent window icon reflected in a MessageBox, we
     * have to create a hook that will trigger when the MessageBox is being
     * created.
     */

    tsdPtr->hSmallIcon = TkWinGetIcon(parent, ICON_SMALL);
    tsdPtr->hBigIcon   = TkWinGetIcon(parent, ICON_BIG);
    tsdPtr->hMsgBoxHook = SetWindowsHookExA(WH_CBT, MsgBoxCBTProc, NULL,
	    GetCurrentThreadId());
    winCode = MessageBox(hWnd, Tcl_GetUnicode(tmpObj),
	    titleObj ? Tcl_GetUnicode(titleObj) : L"", flags);
    UnhookWindowsHookEx(tsdPtr->hMsgBoxHook);
    (void) Tcl_SetServiceMode(oldMode);

    /*

     * 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.
     */

    EnumFontFamiliesW(hdc, NULL, (FONTENUMPROCW) WinFontFamilyEnumProc,
	    (LPARAM) resultObj);
    ReleaseDC(hwnd, hdc);
    Tcl_SetObjResult(interp, resultObj);
}

static int CALLBACK
WinFontFamilyEnumProc(

    HFONT oldFont;
    TEXTMETRICA tm;
    Window window;
    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);

    GetTextMetricsA(hdc, &tm);

     * 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.
     */

    GetTextFaceW(hdc, LF_FACESIZE, (WCHAR *) buf);
    Tcl_ExternalToUtfDString(systemEncoding, buf, -1, &faceString);

    fontPtr->font.fid	= (Font) fontPtr;
    fontPtr->hwnd	= hwnd;
    fontPtr->pixelSize	= tm.tmHeight - tm.tmInternalLeading;

    faPtr		= &fontPtr->font.fa;
    faPtr->family	= Tk_GetUid(Tcl_DStringValue(&faceString));

    fontPtr->numSubFonts 	= 1;
    fontPtr->subFontArray	= fontPtr->staticSubFonts;
    InitSubFont(hdc, hFont, 1, &fontPtr->subFontArray[0]);

    encoding = fontPtr->subFontArray[0].familyPtr->encoding;
    if (encoding == TkWinGetUnicodeEncoding()) {
	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);

    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)];
    ThreadSpecificData *tsdPtr =
	    Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    hFont = SelectObject(hdc, hFont);
    GetTextFaceW(hdc, LF_FACESIZE, (WCHAR *) buf);
    Tcl_ExternalToUtfDString(systemEncoding, buf, -1, &faceString);
    faceName = Tk_GetUid(Tcl_DStringValue(&faceString));
    Tcl_DStringFree(&faceString);
    hFont = SelectObject(hdc, hFont);

    familyPtr = tsdPtr->fontFamilyList;
    for ( ; familyPtr != NULL; familyPtr = familyPtr->nextPtr) {
	if (familyPtr->faceName == faceName) {

    canUse.hdc = hdc;
    canUse.fontPtr = fontPtr;
    canUse.nameTriedPtr = &ds;
    canUse.ch = ch;
    canUse.subFontPtr = NULL;
    canUse.subFontPtrPtr = subFontPtrPtr;
    EnumFontFamiliesW(hdc, NULL, (FONTENUMPROCW) WinFontCanUseProc,
	    (LPARAM) &canUse);
    subFontPtr = canUse.subFontPtr;

  end:
    Tcl_DStringFree(&ds);

    if (subFontPtr == NULL) {

    int pixelSize,		/* Overrides size specified in font
				 * attributes. */
    double angle)		/* What is the desired orientation of the
				 * font. */
{
    Tcl_DString ds;
    HFONT hFont;
    LOGFONTW lf;

    memset(&lf, 0, sizeof(lf));
    lf.lfHeight		= -pixelSize;
    lf.lfWidth		= 0;
    lf.lfEscapement	= ROUND16(angle * 10);
    lf.lfOrientation	= ROUND16(angle * 10);
    lf.lfWeight = (faPtr->weight == TK_FW_NORMAL) ? FW_NORMAL : FW_BOLD;

    if (TkWinGetPlatformId() == VER_PLATFORM_WIN32_NT) {
	Tcl_UniChar *src, *dst;

	/*
	 * We can only store up to LF_FACESIZE wide characters
	 */

	if (Tcl_DStringLength(&ds) >= (int)(LF_FACESIZE * sizeof(WCHAR))) {
	    Tcl_DStringSetLength(&ds, LF_FACESIZE);
	}
	src = (Tcl_UniChar *) Tcl_DStringValue(&ds);
	dst = (Tcl_UniChar *) lf.lfFaceName;
	while (*src != '\0') {
	    *dst++ = *src++;
	}
	*dst = '\0';
	hFont = CreateFontIndirectW(&lf);
    } else {
	/*
	 * We can only store up to LF_FACESIZE characters
	 */

	if (Tcl_DStringLength(&ds) >= LF_FACESIZE) {
	    Tcl_DStringSetLength(&ds, LF_FACESIZE);

    /*
     * 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.
     */

    result = EnumFontFamiliesW(hdc, (WCHAR*) Tcl_DStringValue(&faceString),
	    (FONTENUMPROCW) WinFontExistProc, 0);
    Tcl_DStringFree(&faceString);
    return (result == 0);
}

static const char *
FamilyOrAliasExists(
    HDC hdc,