Backport of 923555 fixes

4 files changed, 140 insertions, 28 deletions

diff --git a/ChangeLog b/ChangeLog
index ed9a335..e46f3cc 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,11 @@
+2004-03-26  Donal K. Fellows  <donal.k.fellows@man.ac.uk>
+
+	* generic/tkImgPPM.c (StringWritePPM): New function to support
+	converting of images to PPM strings.  Other direction not yet
+	done.  Rest of file converted to use new image API.
+	* generic/tkImgPhoto.c (ImgPhotoCmd): Restored support for the
+	stringWriteProc of old photo formats.  [Bug 923555]
+
 2004-03-20  Jim Ingham  <jingham@apple.com>
 
 	* macosx/tkMacOSXSubwindows.c (GenerateConfigureNotify): New
diff --git a/generic/tkImgPPM.c b/generic/tkImgPPM.c
index 9715cf4..d55cdfc 100644
--- a/generic/tkImgPPM.c
+++ b/generic/tkImgPPM.c
@@ -13,11 +13,9 @@
  *	   Department of Computer Science,
  *	   Australian National University.
  *
- * RCS: @(#) $Id: tkImgPPM.c,v 1.10 2002/06/14 13:35:48 dkf Exp $
+ * RCS: @(#) $Id: tkImgPPM.c,v 1.10.2.1 2004/03/26 22:01:26 dkf Exp $
  */
 
-#define USE_OLD_IMAGE
-
 #include "tkInt.h"
 #include "tkPort.h"
 
@@ -40,25 +38,27 @@
  */
 
 static int		FileMatchPPM _ANSI_ARGS_((Tcl_Channel chan,
-			    char *fileName, char *formatString,
+			    CONST char *fileName, Tcl_Obj *format,
 			    int *widthPtr, int *heightPtr));
 static int		FileReadPPM  _ANSI_ARGS_((Tcl_Interp *interp,
-			    Tcl_Channel chan, char *fileName,
-			    char *formatString, Tk_PhotoHandle imageHandle,
+			    Tcl_Channel chan, CONST char *fileName,
+			    Tcl_Obj *format, Tk_PhotoHandle imageHandle,
 			    int destX, int destY, int width, int height,
 			    int srcX, int srcY));
 static int		FileWritePPM _ANSI_ARGS_((Tcl_Interp *interp,
-			    char *fileName, char *formatString,
+			    CONST char *fileName, Tcl_Obj *format,
 			    Tk_PhotoImageBlock *blockPtr));
+static int		StringWritePPM _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *format, Tk_PhotoImageBlock *blockPtr));
 
 Tk_PhotoImageFormat tkImgFmtPPM = {
-    "PPM",			/* name */
+    "ppm",			/* name */
     FileMatchPPM,		/* fileMatchProc */
     NULL,			/* stringMatchProc */
     FileReadPPM,		/* fileReadProc */
     NULL,			/* stringReadProc */
     FileWritePPM,		/* fileWriteProc */
-    NULL,			/* stringWriteProc */
+    StringWritePPM,		/* stringWriteProc */
 };
 
 /*
@@ -88,10 +88,10 @@ static int		ReadPPMFileHeader _ANSI_ARGS_((Tcl_Channel chan,
  */
 
 static int
-FileMatchPPM(chan, fileName, formatString, widthPtr, heightPtr)
+FileMatchPPM(chan, fileName, format, widthPtr, heightPtr)
     Tcl_Channel chan;		/* The image file, open for reading. */
-    char *fileName;		/* The name of the image file. */
-    char *formatString;		/* User-specified format string, or NULL. */
+    CONST char *fileName;	/* The name of the image file. */
+    Tcl_Obj *format;		/* User-specified format string, or NULL. */
     int *widthPtr, *heightPtr;	/* The dimensions of the image are
 				 * returned here if the file is a valid
 				 * raw PPM file. */
@@ -122,12 +122,12 @@ FileMatchPPM(chan, fileName, formatString, widthPtr, heightPtr)
  */
 
 static int
-FileReadPPM(interp, chan, fileName, formatString, imageHandle, destX, destY,
+FileReadPPM(interp, chan, fileName, format, imageHandle, destX, destY,
 	width, height, srcX, srcY)
     Tcl_Interp *interp;		/* Interpreter to use for reporting errors. */
     Tcl_Channel chan;		/* The image file, open for reading. */
-    char *fileName;		/* The name of the image file. */
-    char *formatString;		/* User-specified format string, or NULL. */
+    CONST char *fileName;	/* The name of the image file. */
+    Tcl_Obj *format;		/* User-specified format string, or NULL. */
     Tk_PhotoHandle imageHandle;	/* The photo image to write into. */
     int destX, destY;		/* Coordinates of top-left pixel in
 				 * photo image to be written to. */
@@ -256,10 +256,10 @@ FileReadPPM(interp, chan, fileName, formatString, imageHandle, destX, destY,
  */
 
 static int
-FileWritePPM(interp, fileName, formatString, blockPtr)
+FileWritePPM(interp, fileName, format, blockPtr)
     Tcl_Interp *interp;
-    char *fileName;
-    char *formatString;
+    CONST char *fileName;
+    Tcl_Obj *format;
     Tk_PhotoImageBlock *blockPtr;
 {
     Tcl_Channel chan;
@@ -283,10 +283,10 @@ FileWritePPM(interp, fileName, formatString, blockPtr)
 	Tcl_Close(NULL, chan);
 	return TCL_ERROR;
     }
-    
+
     sprintf(header, "P6\n%d %d\n255\n", blockPtr->width, blockPtr->height);
     Tcl_Write(chan, header, -1);
-	
+
     pixLinePtr = blockPtr->pixelPtr + blockPtr->offset[0];
     greenOffset = blockPtr->offset[1] - blockPtr->offset[0];
     blueOffset = blockPtr->offset[2] - blockPtr->offset[0];
@@ -329,6 +329,78 @@ FileWritePPM(interp, fileName, formatString, blockPtr)
 /*
  *----------------------------------------------------------------------
  *
+ * StringWritePPM --
+ *
+ *	This procedure is invoked to write image data to a string in PPM
+ *	format.
+ *
+ * Results:
+ *	A standard TCL completion code.  If TCL_ERROR is returned
+ *	then an error message is left in the interp's result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+StringWritePPM(interp, format, blockPtr)
+    Tcl_Interp *interp;
+    Tcl_Obj *format;
+    Tk_PhotoImageBlock *blockPtr;
+{
+    int w, h, size, greenOffset, blueOffset;
+    unsigned char *pixLinePtr, *byteArray;
+    char header[16 + TCL_INTEGER_SPACE * 2];
+    Tcl_Obj *byteArrayObj;
+
+    sprintf(header, "P6\n%d %d\n255\n", blockPtr->width, blockPtr->height);
+    /*
+     * Construct a byte array of the right size with the header and
+     * get a pointer to the data part of it.
+     */
+    size = strlen(header);
+    byteArrayObj = Tcl_NewByteArrayObj((unsigned char *)header, size);
+    byteArray = Tcl_SetByteArrayLength(byteArrayObj,
+	    size + 3*blockPtr->width*blockPtr->height);
+    byteArray += size;
+
+    pixLinePtr = blockPtr->pixelPtr + blockPtr->offset[0];
+    greenOffset = blockPtr->offset[1] - blockPtr->offset[0];
+    blueOffset = blockPtr->offset[2] - blockPtr->offset[0];
+
+    /*
+     * Check if we can do the data move in single action.
+     */
+    if ((greenOffset == 1) && (blueOffset == 2) && (blockPtr->pixelSize == 3)
+	    && (blockPtr->pitch == (blockPtr->width * 3))) {
+	memcpy(byteArray, pixLinePtr,
+		(unsigned)blockPtr->height * blockPtr->pitch);
+    } else {
+	for (h = blockPtr->height; h > 0; h--) {
+	    unsigned char *pixelPtr = pixLinePtr;
+
+	    for (w = blockPtr->width; w > 0; w--) {
+		*byteArray++ = pixelPtr[0];
+		*byteArray++ = pixelPtr[greenOffset];
+		*byteArray++ = pixelPtr[blueOffset];
+		pixelPtr += blockPtr->pixelSize;
+	    }
+	    pixLinePtr += blockPtr->pitch;
+	}
+    }
+
+    /*
+     * Return the object in the interpreter result.
+     */
+    Tcl_SetObjResult(interp, byteArrayObj);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * ReadPPMFileHeader --
  *
  *	This procedure reads the PPM header from the beginning of a
diff --git a/generic/tkImgPhoto.c b/generic/tkImgPhoto.c
index edff9cf..a969082 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.36.2.5 2004/02/23 10:49:30 das Exp $
+ * RCS: @(#) $Id: tkImgPhoto.c,v 1.36.2.6 2004/03/26 22:01:26 dkf Exp $
  */
 
 #include "tkInt.h"
@@ -948,9 +948,25 @@ ImgPhotoCmd(clientData, interp, objc, objv)
 		}
 	    }
 	    if (stringWriteProc == NULL) {
+		oldformat = 1;
+		for (imageFormat = tsdPtr->oldFormatList; imageFormat != NULL;
+			imageFormat = imageFormat->nextPtr) {
+		    if ((strncasecmp(Tcl_GetString(options.format),
+			    imageFormat->name,
+			    strlen(imageFormat->name)) == 0)) {
+			matched = 1;
+			if (imageFormat->stringWriteProc != NULL) {
+			    stringWriteProc = imageFormat->stringWriteProc;
+			    break;
+			}
+		    }
+		}
+	    }
+	    if (stringWriteProc == NULL) {
 		Tcl_AppendResult(interp, "image string format \"",
-			Tcl_GetString(options.format),
-			"\" is not supported", (char *) NULL);
+			Tcl_GetString(options.format), "\" is ",
+			(matched ? "not supported" : "unknown"),
+			(char *) NULL);
 		return TCL_ERROR;
 	    }
 	} else {
@@ -964,9 +980,25 @@ ImgPhotoCmd(clientData, interp, objc, objv)
 
 	data = ImgGetPhoto(masterPtr, &block, &options);
 
-	result = ((int (*) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *formatString,
-		Tk_PhotoImageBlock *blockPtr, VOID *dummy))) stringWriteProc)
-		(interp, options.format, &block, (VOID *) NULL);
+	if (oldformat) {
+	    Tcl_DString buffer;
+
+	    Tcl_DStringInit(&buffer);
+	    result = ((int (*) _ANSI_ARGS_((Tcl_Interp *interp,
+		    Tcl_DString *buffer, char *formatString,
+		    Tk_PhotoImageBlock *blockPtr))) stringWriteProc)
+		    (interp, &buffer, Tcl_GetString(options.format), &block);
+	    if (result == TCL_OK) {
+		Tcl_DStringResult(interp, &buffer);
+	    } else {
+		Tcl_DStringFree(&buffer);
+	    }
+	} else {
+	    result = ((int (*) _ANSI_ARGS_((Tcl_Interp *interp,
+		    Tcl_Obj *formatString, Tk_PhotoImageBlock *blockPtr,
+		    VOID *dummy))) stringWriteProc)
+		    (interp, options.format, &block, (VOID *) NULL);
+	}
 	if (options.background) {
 	    Tk_FreeColor(options.background);
 	}
diff --git a/generic/tkWindow.c b/generic/tkWindow.c
index 7efee6d..7a23210 100644
--- a/generic/tkWindow.c
+++ b/generic/tkWindow.c
@@ -12,7 +12,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tkWindow.c,v 1.56.2.2 2004/02/16 00:42:34 wolfsuit Exp $
+ * RCS: @(#) $Id: tkWindow.c,v 1.56.2.3 2004/03/26 22:01:26 dkf Exp $
  */
 
 #include "tkPort.h"
@@ -353,7 +353,7 @@ CreateTopLevelWindow(interp, parent, name, screenName, flags)
 	 */
     
 	Tk_CreatePhotoImageFormat(&tkImgFmtGIF);
-	Tk_CreateOldPhotoImageFormat(&tkImgFmtPPM);
+	Tk_CreatePhotoImageFormat(&tkImgFmtPPM);
 
 	/*
 	 * Create exit handler to delete all windows when the application