Corrected handling of MacOS filetypes in tk_*file dialogs

7 files changed, 168 insertions, 82 deletions

diff --git a/ChangeLog b/ChangeLog
index d1a662e..5ccd58e 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,13 @@
+2004-12-20  Vince Darley  <vincentdarley@users.sourceforge.net>
+
+	* generic/tkFileFilter.c:
+	* generic/tkFileFilter.h: 
+	* macosx/tkMacOSXDialog.c:
+	* win/tkWinDialog.c:
+	* tests/filebox.test:
+	* tests/winDialog.test: Corrected handling of MacOS file types
+	in tk_*file dialogs [Bug 1083878].
+
 2004-12-20  Donal K. Fellows  <donal.k.fellows@man.ac.uk>
 
 	* doc/panedwindow.n: Fix silly typo. [Bug 1087842]
diff --git a/generic/tkFileFilter.c b/generic/tkFileFilter.c
index 319065f..4734b00 100644
--- a/generic/tkFileFilter.c
+++ b/generic/tkFileFilter.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.
  *
- * RCS: @(#) $Id: tkFileFilter.c,v 1.5 2002/01/27 11:10:50 das Exp $
+ * RCS: @(#) $Id: tkFileFilter.c,v 1.6 2004/12/20 10:34:20 vincentdarley Exp $
  */
 
 #include "tkInt.h"
@@ -17,7 +17,7 @@
 
 static int		AddClause _ANSI_ARGS_((
 			    Tcl_Interp * interp, FileFilter * filterPtr,
-			    CONST char * patternsStr, CONST char * ostypesStr,
+			    Tcl_Obj * patternsObj, Tcl_Obj * ostypesObj,
 			    int isWindows));
 static void		FreeClauses _ANSI_ARGS_((FileFilter * filterPtr));
 static void		FreeGlobPatterns _ANSI_ARGS_((
@@ -75,27 +75,29 @@ TkInitFileFilters(flistPtr)
  *	A standard TCL return value.
  *
  * Side effects:
- *	The fields in flistPtr are changed according to string.
+ *	The fields in flistPtr are changed according to 'types'.
  *----------------------------------------------------------------------
  */
 int
-TkGetFileFilters(interp, flistPtr, string, isWindows)
+TkGetFileFilters(interp, flistPtr, types, isWindows)
     Tcl_Interp *interp;		/* Interpreter to use for error reporting. */
     FileFilterList * flistPtr;	/* Stores the list of file filters. */
-    char * string;		/* Value of the -filetypes option. */
+    Tcl_Obj* types;		/* Value of the -filetypes option. */
     int isWindows;		/* True if we are running on Windows. */
 {
-    int listArgc;
-    CONST char ** listArgv = NULL;
-    CONST char ** typeInfo = NULL;
-    int code = TCL_OK;
+    int listObjc;
+    Tcl_Obj ** listObjv = NULL;
     int i;
 
-    if (Tcl_SplitList(interp, string, &listArgc, &listArgv) != TCL_OK) {
+    if (types == NULL) {
+        return TCL_OK;
+    }
+    
+    if (Tcl_ListObjGetElements(interp, types, &listObjc, &listObjv) != TCL_OK) {
 	return TCL_ERROR;
     }
-    if (listArgc == 0) {
-	goto done;
+    if (listObjc == 0) {
+	return TCL_OK;
     }
 
     /*
@@ -105,7 +107,7 @@ TkGetFileFilters(interp, flistPtr, string, isWindows)
      */
     TkFreeFileFilters(flistPtr);
 
-    for (i = 0; i<listArgc; i++) {
+    for (i = 0; i<listObjc; i++) {
 	/*
 	 * Each file type should have two or three elements: the first one
 	 * is the name of the type and the second is the filter of the type.
@@ -113,47 +115,33 @@ TkGetFileFilters(interp, flistPtr, string, isWindows)
 	 */
 	int count;
 	FileFilter * filterPtr;
+	Tcl_Obj ** typeInfo;
 
-	if (Tcl_SplitList(interp, listArgv[i], &count, &typeInfo) != TCL_OK) {
-	    code = TCL_ERROR;
-	    goto done;
+	if (Tcl_ListObjGetElements(interp, listObjv[i], &count, 
+				   &typeInfo) != TCL_OK) {
+	    return TCL_ERROR;
 	}
 	
 	if (count != 2 && count != 3) {
-	    Tcl_AppendResult(interp, "bad file type \"", listArgv[i], "\", ",
+	    Tcl_AppendResult(interp, "bad file type \"", 
+		Tcl_GetString(listObjv[i]), "\", ",
 		"should be \"typeName {extension ?extensions ...?} ",
 		"?{macType ?macTypes ...?}?\"",	NULL);
-	    code = TCL_ERROR;
-	    goto done;
+	    return TCL_ERROR;
 	}
 
-	filterPtr = GetFilter(flistPtr, typeInfo[0]);
+	filterPtr = GetFilter(flistPtr, Tcl_GetString(typeInfo[0]));
 
 	if (count == 2) {
-	    code = AddClause(interp, filterPtr, typeInfo[1], NULL,
-		isWindows);
+	    return AddClause(interp, filterPtr, typeInfo[1], 
+			     NULL, isWindows);
 	} else {
-	    code = AddClause(interp, filterPtr, typeInfo[1], typeInfo[2],
-		isWindows);
-	}
-	if (code != TCL_OK) {
-	    goto done;
-	}
-
-        if (typeInfo) {
-	    ckfree((char*)typeInfo);
+	    return AddClause(interp, filterPtr, typeInfo[1], 
+			     typeInfo[2], isWindows);
 	}
-	typeInfo = NULL;
     }
 
-  done:
-    if (typeInfo) {
-       ckfree((char*)typeInfo);
-    }
-    if (listArgv) {
-	ckfree((char*)listArgv);
-    }
-    return code;
+    return TCL_OK;
 }
 
 /*
@@ -203,38 +191,77 @@ TkFreeFileFilters(flistPtr)
  *----------------------------------------------------------------------
  */
 
-static int AddClause(interp, filterPtr, patternsStr, ostypesStr, isWindows)
+static int AddClause(interp, filterPtr, patternsObj, ostypesObj, isWindows)
     Tcl_Interp * interp;	/* Interpreter to use for error reporting. */
     FileFilter * filterPtr;	/* Stores the new filter clause */
-    CONST char * patternsStr;		/* A TCL list of glob patterns. */
-    CONST char * ostypesStr;		/* A TCL list of Mac OSType strings. */
+    Tcl_Obj * patternsObj;	/* A Tcl list of glob patterns. */
+    Tcl_Obj * ostypesObj;	/* A Tcl list of Mac OSType strings. */
     int isWindows;		/* True if we are running on Windows; False
 				 * if we are running on the Mac; Glob
 				 * patterns need to be processed differently
 				 * on these two platforms */
 {
-    CONST char ** globList = NULL;
+    Tcl_Obj ** globList = NULL;
     int globCount;
-    CONST char ** ostypeList = NULL;
+    Tcl_Obj ** ostypeList = NULL;
     int ostypeCount;
     FileFilterClause * clausePtr;
     int i;
     int code = TCL_OK;
-
-    if (Tcl_SplitList(interp, patternsStr, &globCount, &globList)!= TCL_OK) {
+    Tcl_Encoding macRoman = NULL;
+    
+    if (Tcl_ListObjGetElements(interp, patternsObj, &globCount, &globList)
+	    != TCL_OK) {
 	code = TCL_ERROR;
 	goto done;
     }
-    if (ostypesStr != NULL) {
-	if (Tcl_SplitList(interp, ostypesStr, &ostypeCount, &ostypeList)
+    if (ostypesObj != NULL) {
+	if (Tcl_ListObjGetElements(interp, ostypesObj, &ostypeCount, &ostypeList)
 		!= TCL_OK) {
 	    code = TCL_ERROR;
 	    goto done;
 	}
+	/* 
+	 * Might be cleaner to use 'Tcl_GetOSTypeFromObj' but that is
+	 * actually static to the MacOS X/Darwin version of Tcl, and
+	 * would therefore require further code refactoring.
+	 */
 	for (i=0; i<ostypeCount; i++) {
-	    if (strlen(ostypeList[i]) != 4) {
+	    int len;
+	    CONST char *strType = Tcl_GetStringFromObj(ostypeList[i], &len);
+	    /* 
+	     * If len is < 4, it is definitely an error.  If equal or
+	     * longer, we need to use the macRoman encoding to determine
+	     * the correct length (assuming there may be non-ascii
+	     * characters, eg., embedded nulls or accented characters in
+	     * the string, the macRoman length will be different).
+	     */
+	    if (len >= 4) {
+		if (macRoman == NULL) {
+		    macRoman = Tcl_GetEncoding(NULL, "macRoman");
+		}
+		/* 
+		 * If we couldn't load the encoding, then we can't
+		 * actually check the correct length.  But here we
+		 * assume we're probably operating on unix/windows
+		 * with a minimal set of encodings and so don't
+		 * care about MacOS types.  So we won't signal
+		 * an error.
+		 */
+		if (macRoman != NULL) {
+		    Tcl_DString osTypeDS;
+		    /* 
+		     * Convert utf to macRoman, since MacOS types are 
+		     * defined to be 4 macRoman characters long
+		     */
+		    Tcl_UtfToExternalDString(macRoman, strType, len, &osTypeDS);
+		    len = Tcl_DStringLength(&osTypeDS);
+		    Tcl_DStringFree(&osTypeDS);
+		}
+	    }
+	    if (len != 4) {
 		Tcl_AppendResult(interp, "bad Macintosh file type \"",
-		    ostypeList[i], "\"", NULL);
+		    Tcl_GetString(ostypeList[i]), "\"", NULL);
 		code = TCL_ERROR;
 		goto done;
 	    }
@@ -264,22 +291,23 @@ static int AddClause(interp, filterPtr, patternsStr, ostypesStr, isWindows)
 	    GlobPattern * globPtr = (GlobPattern*)ckalloc(sizeof(GlobPattern));
 	    int len;
 	    
-	    len = (strlen(globList[i]) + 1) * sizeof(char);
+	    CONST char *str = Tcl_GetStringFromObj(globList[i], &len);
+	    len = (len + 1) * sizeof(char);
 
-	    if (globList[i][0] && globList[i][0] != '*') {
+	    if (str[0] && str[0] != '*') {
 		/*
 		 * Prepend a "*" to patterns that do not have a leading "*"
 		 */
 		globPtr->pattern = (char*)ckalloc((unsigned int) len+1);
 		globPtr->pattern[0] = '*';
-		strcpy(globPtr->pattern+1, globList[i]);
+		strcpy(globPtr->pattern+1, str);
 	    }
 	    else if (isWindows) {
-		if (strcmp(globList[i], "*") == 0) {
+		if (strcmp(str, "*") == 0) {
 		    globPtr->pattern = (char*)ckalloc(4*sizeof(char));
 		    strcpy(globPtr->pattern, "*.*");
 		}
-		else if (strcmp(globList[i], "") == 0) {
+		else if (strcmp(str, "") == 0) {
 		    /*
 		     * An empty string means "match all files with no
 		     * extensions"
@@ -290,11 +318,11 @@ static int AddClause(interp, filterPtr, patternsStr, ostypesStr, isWindows)
 		}
 		else {
 		    globPtr->pattern = (char*)ckalloc((unsigned int) len);
-		    strcpy(globPtr->pattern, globList[i]);
+		    strcpy(globPtr->pattern, str);
 		}
 	    } else {
 		globPtr->pattern = (char*)ckalloc((unsigned int) len);
-		strcpy(globPtr->pattern, globList[i]);
+		strcpy(globPtr->pattern, str);
 	    }
 
 	    /*
@@ -311,10 +339,23 @@ static int AddClause(interp, filterPtr, patternsStr, ostypesStr, isWindows)
 	}
     }
     if (ostypeCount > 0 && ostypeList != NULL) {
+	if (macRoman == NULL) {
+	    macRoman = Tcl_GetEncoding(NULL, "macRoman");
+	}
 	for (i=0; i<ostypeCount; i++) {
+	    Tcl_DString osTypeDS;
+	    int len;
 	    MacFileType * mfPtr = (MacFileType*)ckalloc(sizeof(MacFileType));
+	    CONST char *strType = Tcl_GetStringFromObj(ostypeList[i], &len);
+
+	    /* 
+	     * Convert utf to macRoman, since MacOS types are 
+	     * defined to be 4 macRoman characters long
+	     */
+	    Tcl_UtfToExternalDString(macRoman, strType, len, &osTypeDS);
 
-	    memcpy(&mfPtr->type, ostypeList[i], sizeof(OSType));
+	    memcpy(&mfPtr->type, Tcl_DStringValue(&osTypeDS), sizeof(OSType));
+	    Tcl_DStringFree(&osTypeDS);
 
 	    /*
 	     * Add the Mac type pattern into the list of Mac types
@@ -330,13 +371,10 @@ static int AddClause(interp, filterPtr, patternsStr, ostypesStr, isWindows)
     }
 
   done:
-    if (globList) {
-	ckfree((char*)globList);
-    }
-    if (ostypeList) {
-	ckfree((char*)ostypeList);
-    }
 
+    if (macRoman != NULL) {
+	Tcl_FreeEncoding(macRoman);
+    }
     return code;
 }	
 
diff --git a/generic/tkFileFilter.h b/generic/tkFileFilter.h
index 4893c1b..edcf96a 100644
--- a/generic/tkFileFilter.h
+++ b/generic/tkFileFilter.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.
  *
- * RCS: @(#) $Id: tkFileFilter.h,v 1.5 2004/03/17 18:15:43 das Exp $
+ * RCS: @(#) $Id: tkFileFilter.h,v 1.6 2004/12/20 10:34:20 vincentdarley Exp $
  *
  */
 
@@ -79,7 +79,7 @@ EXTERN void		TkFreeFileFilters _ANSI_ARGS_((
 EXTERN void		TkInitFileFilters _ANSI_ARGS_((
 			    FileFilterList * flistPtr));
 EXTERN int		TkGetFileFilters _ANSI_ARGS_ ((Tcl_Interp *interp,
-    			    FileFilterList * flistPtr, char * string,
+    			    FileFilterList * flistPtr, Tcl_Obj *valuePtr,
 			    int isWindows));
 
 # undef TCL_STORAGE_CLASS
diff --git a/macosx/tkMacOSXDialog.c b/macosx/tkMacOSXDialog.c
index 5845e4a..ebf66b2 100644
--- a/macosx/tkMacOSXDialog.c
+++ b/macosx/tkMacOSXDialog.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.
  *
- * RCS: @(#) $Id: tkMacOSXDialog.c,v 1.10 2004/05/24 21:21:50 dkf Exp $
+ * RCS: @(#) $Id: tkMacOSXDialog.c,v 1.11 2004/12/20 10:34:20 vincentdarley Exp $
  */
 #include <Carbon/Carbon.h>
 
@@ -323,8 +323,7 @@ Tk_GetOpenFileObjCmd(
             case OPEN_DEFAULT:
                 break;
             case OPEN_FILETYPES:
-                choice = Tcl_GetStringFromObj(objv[i + 1], NULL);
-                if (TkGetFileFilters(interp, &ofd.fl, choice, 0) 
+                if (TkGetFileFilters(interp, &ofd.fl, objv[i + 1], 0) 
                         != TCL_OK) {
                     result = TCL_ERROR;
                     goto end;
diff --git a/tests/filebox.test b/tests/filebox.test
index f42af62..432323d 100644
--- a/tests/filebox.test
+++ b/tests/filebox.test
@@ -6,13 +6,27 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: filebox.test,v 1.17 2004/12/08 03:02:53 dgp Exp $
+# RCS: @(#) $Id: filebox.test,v 1.18 2004/12/20 10:34:20 vincentdarley Exp $
 #
 
 package require tcltest 2.1
 eval tcltest::configure $argv
 tcltest::loadTestedCommands
 
+test fileDialog-0.1 {GetFileName: file types: MakeFilter() fails} {
+    # MacOS type that is too long
+
+    set res [list [catch {tk_getSaveFile -filetypes {{"foo" .foo {\0\0\0\0\0}}}} msg] $msg]
+    regsub -all "\0" $res {\\0}
+} {1 {bad Macintosh file type "\0\0\0\0\0"}}
+test fileDialog-0.2 {GetFileName: file types: MakeFilter() fails} {
+    # MacOS type that is too short, but looks ok in utf (4 bytes).
+
+    set x [catch {tk_getSaveFile -filetypes {{"foo" .foo {\0\0}}}} msg]
+    regsub -all "\0" $msg {\\0} msg
+    list $x $msg
+} {1 {bad Macintosh file type "\0\0"}}
+
 set tk_strictMotif_old $tk_strictMotif
 
 #----------------------------------------------------------------------
diff --git a/tests/winDialog.test b/tests/winDialog.test
index b2a705a..c89ff27 100644
--- a/tests/winDialog.test
+++ b/tests/winDialog.test
@@ -6,7 +6,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # Copyright (c) 1998-1999 ActiveState Corporation.
 #
-# RCS: @(#) $Id: winDialog.test,v 1.11 2004/06/17 22:38:57 dkf Exp $
+# RCS: @(#) $Id: winDialog.test,v 1.12 2004/12/20 10:34:20 vincentdarley Exp $
 
 package require tcltest 2.1
 eval tcltest::configure $argv
@@ -257,6 +257,24 @@ test winDialog-5.24 {GetFileName: convert \ to /} {nt testwinevent} {
     }
     set x
 } {c:/12x 457}
+test winDialog-5.25 {GetFileName: file types: MakeFilter() succeeds} {nt} {
+    # MacOS type that is correct, but has embedded nulls.
+
+    start {set x [catch {tk_getSaveFile -filetypes {{"foo" .foo {\0\0\0\0}}}}]}
+    then {
+	Click 2
+    }
+    set x
+} {0}
+test winDialog-5.26 {GetFileName: file types: MakeFilter() succeeds} {nt} {
+    # MacOS type that is correct, but has embedded high-bit chars.
+
+    start {set x [catch {tk_getSaveFile -filetypes {{"foo" .foo {\u2022\u2022\u2022\u2022}}}}]}
+    then {
+	Click 2
+    }
+    set x
+} {0}
 
 test winDialog-6.1 {MakeFilter} {emptyTest nt} {} {}
 
diff --git a/win/tkWinDialog.c b/win/tkWinDialog.c
index 4a18942..f794174 100644
--- a/win/tkWinDialog.c
+++ b/win/tkWinDialog.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.
  *
- * RCS: @(#) $Id: tkWinDialog.c,v 1.36 2004/08/20 00:58:52 hobbs Exp $
+ * RCS: @(#) $Id: tkWinDialog.c,v 1.37 2004/12/20 10:34:21 vincentdarley Exp $
  *
  */
 
@@ -175,7 +175,7 @@ static int 		GetFileNameA(ClientData clientData,
 static int 		GetFileNameW(ClientData clientData, 
 			    Tcl_Interp *interp, int objc, 
 			    Tcl_Obj *CONST objv[], int isOpen);
-static int 		MakeFilter(Tcl_Interp *interp, char *string, 
+static int 		MakeFilter(Tcl_Interp *interp, Tcl_Obj *valuePtr, 
 			    Tcl_DString *dsPtr);
 static UINT APIENTRY	OFNHookProc(HWND hdlg, UINT uMsg, WPARAM wParam, 
 			    LPARAM lParam);
@@ -651,7 +651,7 @@ GetFileNameW(clientData, interp, objc, objv, open)
 	    }
 	    case FILE_TYPES: {
 		Tcl_DStringFree(&utfFilterString);
-		if (MakeFilter(interp, string, &utfFilterString) != TCL_OK) {
+		if (MakeFilter(interp, valuePtr, &utfFilterString) != TCL_OK) {
 		    goto end;
 		}
 		filter = Tcl_DStringValue(&utfFilterString);
@@ -698,7 +698,7 @@ GetFileNameW(clientData, interp, objc, objv, open)
     }
 
     if (filter == NULL) {
-	if (MakeFilter(interp, "", &utfFilterString) != TCL_OK) {
+	if (MakeFilter(interp, NULL, &utfFilterString) != TCL_OK) {
 	    goto end;
 	}
     }
@@ -1127,7 +1127,7 @@ GetFileNameA(clientData, interp, objc, objv, open)
 	    }
 	    case FILE_TYPES: {
 		Tcl_DStringFree(&utfFilterString);
-		if (MakeFilter(interp, string, &utfFilterString) != TCL_OK) {
+		if (MakeFilter(interp, valuePtr, &utfFilterString) != TCL_OK) {
 		    goto end;
 		}
 		filter = Tcl_DStringValue(&utfFilterString);
@@ -1174,7 +1174,7 @@ GetFileNameA(clientData, interp, objc, objv, open)
     }
 
     if (filter == NULL) {
-	if (MakeFilter(interp, "", &utfFilterString) != TCL_OK) {
+	if (MakeFilter(interp, NULL, &utfFilterString) != TCL_OK) {
 	    goto end;
 	}
     }
@@ -1516,9 +1516,9 @@ OFNHookProc(
  *----------------------------------------------------------------------
  */
 static int 
-MakeFilter(interp, string, dsPtr) 
+MakeFilter(interp, valuePtr, dsPtr) 
     Tcl_Interp *interp;		/* Current interpreter. */
-    char *string;		/* String value of the -filetypes option */
+    Tcl_Obj *valuePtr;		/* Value of the -filetypes option */
     Tcl_DString *dsPtr;		/* Filled with windows filter string. */
 {
     char *filterStr;
@@ -1528,7 +1528,7 @@ MakeFilter(interp, string, dsPtr)
     FileFilter *filterPtr;
 
     TkInitFileFilters(&flist);
-    if (TkGetFileFilters(interp, &flist, string, 1) != TCL_OK) {
+    if (TkGetFileFilters(interp, &flist, valuePtr, 1) != TCL_OK) {
 	return TCL_ERROR;
     }
 
@@ -1552,6 +1552,13 @@ MakeFilter(interp, string, dsPtr)
 	*p = '\0';
 
     } else {
+	int len;
+	if (valuePtr == NULL) {
+	    len = 0;
+	} else {
+	    CONST char* string = Tcl_GetStringFromObj(valuePtr, &len);
+	}
+	
 	/* We format the filetype into a string understood by Windows:
 	 * {"Text Documents" {.doc .txt} {TEXT}} becomes
 	 * "Text Documents (*.doc,*.txt)\0*.doc;*.txt\0"
@@ -1564,7 +1571,7 @@ MakeFilter(interp, string, dsPtr)
 	 * Since we may only add asterisks (*) to the filter, we need at most
 	 * twice the size of the string to format the filter
 	 */
-	filterStr = ckalloc((unsigned int) strlen(string) * 3);
+	filterStr = ckalloc((unsigned int) len * 3);
 
 	for (filterPtr = flist.filters, p = filterStr; filterPtr;
 	        filterPtr = filterPtr->next) {