* generic/tkImgPhoto.c (ImgPhotoCmd): [Bug 2983824]: Use the file

	extension to guess the output format to use if one isn't specified.

3 files changed, 127 insertions, 27 deletions

diff --git a/ChangeLog b/ChangeLog
index 073643f..5e2e9e3 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,22 +1,27 @@
+2010-04-09  Donal K. Fellows  <dkf@users.sf.net>
+
+	* generic/tkImgPhoto.c (ImgPhotoCmd): [Bug 2983824]: Use the file
+	extension to guess the output format to use if one isn't specified.
+
 2010-04-08  Jan Nijtmans  <nijtmans@users.sf.net>
 
-	* win/tkWinPort.h     Add <wchar.h> to tkWinPort.h, and
-	* win/tkWinSend.c     remove some earlier CYGWIN-related
-	* win/tkWinSendCom.c  hacks which are no longer necessary.
+	* win/tkWinPort.h:    Add <wchar.h> to tkWinPort.h, and
+	* win/tkWinSend.c:    remove some earlier CYGWIN-related
+	* win/tkWinSendCom.c: hacks which are no longer necessary.
 
 2010-04-06  Jan Nijtmans  <nijtmans@users.sf.net>
 
 	* win/tcl.m4          Sync with Tcl version
 	* unix/tcl.m4
 	* win/configure       (regenerate with autoconf-2.59)
-	* unix/configure      [Bug 2982540] configure and install* script files
-	                      should always have LF
+	* unix/configure      [Bug 2982540]: configure and install* script
+			      files should always have LF
 
 2010-03-29  Jan Nijtmans  <nijtmans@users.sf.net>
 
-	* unix/tcl.m4             Only test for -visibility=hidden with gcc
+	* unix/tcl.m4:            Only test for -visibility=hidden with gcc
 	                          (Second remark in [Bug 2976508])
-	* unix/configure          regen
+	* unix/configure:         regen
 
 2010-03-29  Donal K. Fellows  <dkf@users.sf.net>
 
diff --git a/generic/tkImgPhoto.c b/generic/tkImgPhoto.c
index 9066456..b9e99e1 100644
--- a/generic/tkImgPhoto.c
+++ b/generic/tkImgPhoto.c
@@ -17,7 +17,7 @@
  *	   Department of Computer Science,
  *	   Australian National University.
  *
- * RCS: @(#) $Id: tkImgPhoto.c,v 1.96 2010/02/17 19:21:16 nijtmans Exp $
+ * RCS: @(#) $Id: tkImgPhoto.c,v 1.97 2010/04/09 13:15:31 dkf Exp $
  */
 
 #include "tkImgPhoto.h"
@@ -198,6 +198,7 @@ static int		MatchStringFormat(Tcl_Interp *interp, Tcl_Obj *data,
 			    Tcl_Obj *formatString,
 			    Tk_PhotoImageFormat **imageFormatPtr,
 			    int *widthPtr, int *heightPtr, int *oldformat);
+static const char *	GetExtension(const char *path);
 
 /*
  *----------------------------------------------------------------------
@@ -1237,7 +1238,9 @@ ImgPhotoCmd(
 
     case PHOTO_WRITE: {
 	char *data;
+	const char *fmtString;
 	Tcl_Obj *format;
+	int usedExt;
 
 	/*
 	 * Prevent file system access in safe interpreters.
@@ -1276,13 +1279,22 @@ ImgPhotoCmd(
 	}
 
 	/*
-	 * Fill in default values for unspecified parameters.
+	 * Fill in default values for unspecified parameters. Note that a
+	 * missing -format flag results in us having a guess from the file
+	 * extension. [Bug 2983824]
 	 */
 
 	if (!(options.options & OPT_FROM) || (options.fromX2 < 0)) {
 	    options.fromX2 = masterPtr->width;
 	    options.fromY2 = masterPtr->height;
 	}
+	if (options.format == NULL) {
+	    fmtString = GetExtension(Tcl_GetString(options.name));
+	    usedExt = (fmtString != NULL);
+	} else {
+	    fmtString = Tcl_GetString(options.format);
+	    usedExt = 0;
+	}
 
 	/*
 	 * Search for an appropriate image file format handler, and give an
@@ -1290,11 +1302,12 @@ ImgPhotoCmd(
 	 */
 
 	matched = 0;
+    redoFormatLookup:
 	for (imageFormat = tsdPtr->formatList; imageFormat != NULL;
 		imageFormat = imageFormat->nextPtr) {
-	    if ((options.format == NULL)
-		    || (strncasecmp(Tcl_GetString(options.format),
-		    imageFormat->name, strlen(imageFormat->name)) == 0)) {
+	    if ((fmtString == NULL)
+		    || (strncasecmp(fmtString, imageFormat->name,
+			    strlen(imageFormat->name)) == 0)) {
 		matched = 1;
 		if (imageFormat->fileWriteProc != NULL) {
 		    break;
@@ -1305,9 +1318,9 @@ ImgPhotoCmd(
 	    oldformat = 1;
 	    for (imageFormat = tsdPtr->oldFormatList; imageFormat != NULL;
 		    imageFormat = imageFormat->nextPtr) {
-		if ((options.format == NULL)
-			|| (strncasecmp(Tcl_GetString(options.format),
-			imageFormat->name, strlen(imageFormat->name)) == 0)) {
+		if ((fmtString == NULL)
+			|| (strncasecmp(fmtString, imageFormat->name,
+				strlen(imageFormat->name)) == 0)) {
 		    matched = 1;
 		    if (imageFormat->fileWriteProc != NULL) {
 			break;
@@ -1315,18 +1328,31 @@ ImgPhotoCmd(
 		}
 	    }
 	}
+	if (usedExt && !matched) {
+	    /*
+	     * If we didn't find one and we're using file extensions as the
+	     * basis for the guessing, go back and look again without
+	     * prejudice. Supports old broken code.
+	     */
+
+	    usedExt = 0;
+	    fmtString = NULL;
+	    goto redoFormatLookup;
+	}
 	if (imageFormat == NULL) {
-	    if (options.format == NULL) {
+	    if (fmtString == NULL) {
 		Tcl_AppendResult(interp, "no available image file format ",
 			"has file writing capability", NULL);
 	    } else if (!matched) {
 		Tcl_AppendResult(interp, "image file format \"",
-			Tcl_GetString(options.format),
-			"\" is unknown", NULL);
+			fmtString, "\" is unknown", NULL);
+		Tcl_SetErrorCode(interp, "TK", "LOOKUP", "PHOTO_FORMAT",
+			fmtString, NULL);
 	    } else {
 		Tcl_AppendResult(interp, "image file format \"",
-			Tcl_GetString(options.format),
-			"\" has no file writing capability", NULL);
+			fmtString, "\" has no file writing capability", NULL);
+		Tcl_SetErrorCode(interp, "TK", "LOOKUP", "PHOTO_FORMAT",
+			fmtString, NULL);
 	    }
 	    return TCL_ERROR;
 	}
@@ -1359,6 +1385,36 @@ ImgPhotoCmd(
 /*
  *----------------------------------------------------------------------
  *
+ * GetExtension --
+ *
+ *	Return the extension part of a path, or NULL if there is no extension.
+ *	The returned string will be a substring of the argument string, so
+ *	should not be ckfree()d directly. No side effects.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static const char *
+GetExtension(
+    const char *path)
+{
+    char c;
+    const char *extension = NULL;
+
+    for (; (c=*path++) != '\0' ;) {
+	if (c == '.') {
+	    extension = path;
+	}
+    }
+    if (extension != NULL && extension[0] == '\0') {
+	extension = NULL;
+    }
+    return extension;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * ParseSubcommandOptions --
  *
  *	This function is invoked to process one of the options which may be
@@ -1534,7 +1590,7 @@ ParseSubcommandOptions(
 		} else {
 		    break;
 		}
-		++argIndex;
+		argIndex++;
 	    }
 
 	    if (numValues == 0) {
@@ -3658,12 +3714,12 @@ ImgGetPhoto(
 	blockPtr->pixelSize = newPixelSize;
 	blockPtr->pitch = newPixelSize * blockPtr->width;
 	blockPtr->offset[0] = 0;
-	if (newPixelSize>2) {
-	    blockPtr->offset[1]= 1;
-	    blockPtr->offset[2]= 2;
+	if (newPixelSize > 2) {
+	    blockPtr->offset[1] = 1;
+	    blockPtr->offset[2] = 2;
 	} else {
-	    blockPtr->offset[1]= 0;
-	    blockPtr->offset[2]= 0;
+	    blockPtr->offset[1] = 0;
+	    blockPtr->offset[2] = 0;
 	}
 	return data;
     }
diff --git a/tests/imgPhoto.test b/tests/imgPhoto.test
index ee567ca..079bed9 100644
--- a/tests/imgPhoto.test
+++ b/tests/imgPhoto.test
@@ -10,7 +10,7 @@
 #
 # Author: Paul Mackerras (paulus@cs.anu.edu.au)
 #
-# RCS: @(#) $Id: imgPhoto.test,v 1.35 2009/01/13 01:46:06 patthoyts Exp $
+# RCS: @(#) $Id: imgPhoto.test,v 1.36 2010/04/09 13:15:32 dkf Exp $
 
 package require tcltest 2.2
 namespace import ::tcltest::*
@@ -1115,6 +1115,45 @@ test imgPhoto-16.1 {copying to self doesn't access freed memory} -setup {
     image delete $i
 } -result {}
 
+# Check that we can guess our supported output formats [Bug 2983824]
+test imgPhoto-17.1 {photo write: format guessing from filename} -setup {
+    set i [image create photo -width 3 -height 3]
+} -body {
+    set f [makeFile {} test.png]
+    $i write $f
+    set fd [open $f]
+    seek $fd 1
+    read $fd 3
+} -cleanup {
+    catch {close $fd}
+    image delete $i
+    catch {removeFile $f}
+} -result PNG
+test imgPhoto-17.2 {photo write: format guessing from filename} -setup {
+    set i [image create photo -width 3 -height 3]
+} -body {
+    set f [makeFile {} test.gif]
+    $i write $f
+    set fd [open $f]
+    read $fd 3
+} -cleanup {
+    catch {close $fd}
+    image delete $i
+    catch {removeFile $f}
+} -result GIF
+test imgPhoto-17.3 {photo write: format guessing from filename} -setup {
+    set i [image create photo -width 3 -height 3]
+} -body {
+    set f [makeFile {} test.ppm]
+    $i write $f
+    set fd [open $f]
+    read $fd 3
+} -cleanup {
+    catch {close $fd}
+    image delete $i
+    catch {removeFile $f}
+} -result "P6\n"
+
 # ----------------------------------------------------------------------
 
 catch {rename foreachPixel {}}