Added -withalpha option to [imageName get].

The list-of-lists-of-pixel-data format now is a registered format as the others.
Thanks to this change, [imageName data] now can return data that includes the alpha channel.
Changed the position of the '-alpha' and '-boolean' options to [imageName transparency set].
Updated doc
Updated test suite

14 files changed, 2673 insertions, 1288 deletions

diff --git a/doc/photo.n b/doc/photo.n
index 287ed02..4c2b933 100644
--- a/doc/photo.n
+++ b/doc/photo.n
@@ -24,7 +24,7 @@ photo \- Full-color images
 \fIimageName \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
 \fIimageName \fBcopy \fIsourceImage\fR ?\fIoption value(s) ...\fR?
 \fIimageName \fBdata\fR ?\fIoption value(s) ...\fR?
-\fIimageName \fBget \fIx y\fR
+\fIimageName \fBget \fIx y\fR ?\fIoption\fR?
 \fIimageName \fBput \fIdata\fR ?\fIoption value(s) ...\fR?
 \fIimageName \fBread \fIfilename\fR ?\fIoption value(s) ...\fR?
 \fIimageName \fBredither\fR
@@ -34,21 +34,21 @@ photo \- Full-color images
 .BE
 .SH DESCRIPTION
 .PP
-A photo is an image whose pixels can display any color or be
-transparent.  A photo image is stored internally in full color (32
-bits per pixel), and is displayed using dithering if necessary.  Image
-data for a photo image can be obtained from a file or a string, or it
-can be supplied from
-C code through a procedural interface.  At present, only
+A photo is an image whose pixels can display any color with a varying
+degree of transparency (the alpha channel). A photo image is stored
+internally in full color (32 bits per pixel), and is displayed using
+dithering if necessary.  Image data for a photo image can be obtained
+from a file or a string, or it can be supplied from C code through a
+procedural interface.  At present, only
 .VS 8.6
 PNG,
 .VE 8.6
-GIF and PPM/PGM
-formats are supported, but an interface exists to allow additional
-image file formats to be added easily.  A photo image is transparent
-in regions where no image data has been supplied
-or where it has been set transparent by the \fBtransparency set\fR
-subcommand.
+GIF and PPM/PGM formats are supported, but an interface exists to
+allow additional image file formats to be added easily.  A photo image
+is (semi)transparent if the image data it was obtained from had
+transparency informaton. In regions where no image data has been
+supplied, it is fully transparent. Transparency may also be modified
+with the \fBtransparency set\fR subcommand.
 .SH "CREATING PHOTOS"
 .PP
 Like all images, photos are created using the \fBimage create\fR
@@ -57,19 +57,23 @@ Photos support the following \fIoptions\fR:
 .TP
 \fB\-data \fIstring\fR
 .
-Specifies the contents of the image as a string.  The string should
-contain binary data or, for some formats, base64-encoded data (this is
+Specifies the contents of the image as a string.  
+.VS 8.7
+The string should
+contain data in the default list-of-lists form, 
+.VE 8.7
+binary data or, for some formats, base64-encoded data (this is
 currently guaranteed to be supported for PNG and GIF images). The
-format of the
-string must be one of those for which there is an image file format
-handler that will accept string data.  If both the \fB\-data\fR
-and \fB\-file\fR options are specified, the \fB\-file\fR option takes
-precedence.
+format of the string must be one of those for which there is an image
+file format handler that will accept string data.  If both the
+\fB\-data\fR and \fB\-file\fR options are specified, the \fB\-file\fR
+option takes precedence.
 .TP
-\fB\-format \fIformat-name\fR
+\fB\-format\fR {\fIformat-name\fR ?\fIoption value ...\fR?}
 .
 Specifies the name of the file format for the data specified with the
-\fB\-data\fR or \fB\-file\fR option.
+\fB\-data\fR or \fB\-file\fR option and optional arguments passed to
+the format handler.
 .TP
 \fB\-file \fIname\fR
 .
@@ -233,8 +237,14 @@ the source image is used as-is.  The default compositing rule is
 .TP
 \fIimageName \fBdata\fR ?\fIoption value(s) ...\fR?
 .
-Returns image data in the form of a string. The following options
-may be specified:
+Returns image data in the form of a string. 
+.VS 8.7
+The format of the string depends on the format handler. By default, a
+human readable format as a list of lists of pixel data is used, other
+formats can be chosen with the \fB-format\fR option. See \fBIMAGE
+FORMATS\fR below for details.
+.VE 8.7
+The following options may be specified:
 .RS
 .TP
 \fB\-background\fI color\fR
@@ -243,19 +253,20 @@ If the color is specified, the data will not contain any transparency
 information. In all transparent pixels the color will be replaced by
 the specified color.
 .TP
-\fB\-format\fI format-name\fR
-.
-Specifies the name of the image file format handler to be used.
-Specifically, this subcommand searches
-for the first handler whose name matches an initial substring of
-\fIformat-name\fR and which has the capability to write a string
-containing this image data.
-If this option is not given, this subcommand uses a format that
-consists of a list (one element per row) of lists (one element per
-pixel/column) of colors in
+\fB\-format\fR {\fIformat-name\fR ?\fIoption value ...\fR?}
+.
+Specifies the name of the image file format handler to use and,
+optionally, arguments to the format handler.  Specifically, this
+subcommand searches for the first handler whose name matches an
+initial substring of \fIformat-name\fR and which has the capability to
+write a string containing this image data.  
+.VS 8.7
+If this option is not given, this subcommand uses the default format
+that consists of a list (one element per row) of lists (one element
+per pixel/column) of colors in
 .QW \fB#\fIrrggbb\fR
-format (where \fIrr\fR is a pair of hexadecimal digits for the red
-channel, \fIgg\fR for green, and \fIbb\fR for blue).
+format (see \fBIMAGE FORMATS\fR below).
+.VE 8.7
 .TP
 \fB\-from \fIx1 y1 x2 y2\fR
 .
@@ -273,77 +284,33 @@ If this options is specified, the data will not contain color
 information. All pixel data will be transformed into grayscale.
 .RE
 .TP
-\fIimageName \fBget\fR \fIx y\fR
+.VS 8.7
+\fIimageName \fBget\fR \fIx y\fR ?\fB-withalpha\fR?
 .
 Returns the color of the pixel at coordinates (\fIx\fR,\fIy\fR) in the
-image as a list of four integers between 0 and 255, representing the
-red, green, blue and alpha components respectively.
+image as a list of three integers between 0 and 255, representing the
+red, green and blue components respectively. If the \fB-withalpha\fR
+option is specified, the returned list will have a fourth element
+representing the alpha value of the pixel as an integer between 0 and
+255.
+.VE 8.7
 .TP
 \fIimageName \fBput\fR \fIdata\fR ?\fIoption value(s) ...\fR?
 .
 Sets pixels in \fI imageName\fR to the data specified in \fIdata\fR.
-This command first searches the list of image file format handlers for
+.VS 8.7
+This command searches the list of image file format handlers for
 a handler that can interpret the data in \fIdata\fR, and then reads
 the image encoded within into \fIimageName\fR (the destination image).
-If \fIdata\fR does not match any known format, an attempt to interpret
-it as a (top-to-bottom) list of scan-lines is made, with each
-scan-line being a (left-to-right) list of pixel data. Every scan-line
-must be of the same length. Pixel data is a color specification 
-optionally followed by a suffix giving the pixel's alpha value.
-The color of a pixel may be specified in any of these forms:
-.RS
-.IP \(bu 3
-The empty string - the pixel shall be fully transparent. In this case
-no alpha suffix is allowed.
-.IP \(bu 3
-Any value accepted by \fBTk_GetColor\fR.
-.IP \(bu 3
-A Tcl list with three or four integers in the range 0 to 255, 
-specifying the values for the red, green, bule and (optionally) 
-alpha channels respectively.
-.IP \(bu 3
-\fB#\fR\fIARGB\fR format: a \fB#\fR followed by four hexadecimal digits,
-where each digit is the value for the alpha, red, green and blue 
-channels respectively. Each digit will be expanded internally to 
-8-bits by multiplication by 0x11.
-.IP \(bu 3
-\fB#\fR\fIAARRGGBB\fR format: \fB#\fR followed by eight hexadecimal digits,
-where two subsequent digits represent the value for the alpha, red, green
-and blue channels respectively.
-.RE
-.sp
-The alpha value of a pixel can be specified by appending a prefix to the color
-specification. If no value for alpha is passed, the pixel is made fully 
-opaque. It is an error to append an alpha suffix to a color format that 
-already specifies an alpha value. The alpha suffix can have one of these 
-forms:
-.RS
-.TP
-\fB@\fR\fIA\fR
-.
-The alpha value \fIA\fR must be a fractional value in the range  0.0 
-(fully transparent) to 1.0 (fully opaque).
-.TP
-\fB#\fR\fIX\fR
-.
-The alpha value \fIX\fR is a hexadecimal digit that specifies an integer
-alpha value in the range 0 (fully transparent) to 255 (fully opaque). 
-This is expanded in range from 4 bits wide to 8 bits wide by 
-multiplication by 0x11.
-.TP
-\fB#\fR\fIXX\fR
-.
-The alpha value \fIXX\fR is passed as two hexadecimal digits that 
-specify an integer alpha value in the range 0 (fully transparent) to 255 
-(fully opaque). 
-.RE
-.sp
+See \fBIMAGE FORMATS\fR below for details on formats for image data.
+.VE 8.7
 The following options may be specified:
 .RS
 .TP
-\fB\-format \fIformat-name\fR
+\fB\-format\fR {\fIformat-name\fR ?\fIoption value ..\fR?}
 .
-Specifies the format of the image data in \fIdata\fR.
+Specifies the format of the image data in \fIdata\fR and, optionally,
+arguments to be passed to the format handler.
 Specifically, only image file format handlers whose names begin with
 \fIformat-name\fR will be used while searching for an image data
 format handler to read the data.
@@ -374,7 +341,8 @@ specified:
 .TP
 \fB\-format \fIformat-name\fR
 .
-Specifies the format of the image data in \fIfilename\fR.
+Specifies the format of the image data in \fIfilename\fR and,
+optionally, additional options to the format handler.
 Specifically, only image file format handlers whose names begin with
 \fIformat-name\fR will be used while searching for an image data
 format handler to read the data.
@@ -421,6 +389,7 @@ Allows examination and manipulation of the transparency information in
 the photo image.  Several subcommands are available:
 .RS
 .TP
+.VS 8.7
 \fIimageName \fBtransparency get \fIx y\fR ?\fIoption\fR?
 .
 Returns information about the transparency of the pixel at (\fIx\fR,\fIy\fR).
@@ -437,9 +406,11 @@ the specified pixel.
 .
 The return value is a boolean indicating if the specified pixel is fully
 transparent.
+.VE 8.7
 .RE
 .TP
-\fIimageName \fBtransparency set \fIx y\fR ?\fIoption\fR? \fInewVal\fR
+.VS 8.7
+\fIimageName \fBtransparency set \fIx y\fR \fInewVal\fR ?\fIoption\fR?
 .
 Change the transparency of the pixel at (\fIx\fR,\fIy\fR).
 At most one of the following options may be specified. If no option is 
@@ -455,6 +426,7 @@ an integral value in the range 0 to 255.
 .
 \fInewVal\fR will be interpreted as a boolean. If true, make the specified 
 pixel fully transparent, opaque otherwise.
+.VE 8.7
 .RE
 .RE
 .TP
@@ -470,15 +442,16 @@ If the color is specified, the data will not contain any transparency
 information. In all transparent pixels the color will be replaced by
 the specified color.
 .TP
-\fB\-format\fI format-name\fR
+\fB\-format\fR {\fIformat-name\fR ?\fIoption value ...\fR?}
 .
 Specifies the name of the image file format handler to be used to
-write the data to the file.  Specifically, this subcommand searches
-for the first handler whose name matches an initial substring of
-\fIformat-name\fR and which has the capability to write an image
-file.  If this option is not given, the format is guessed from
-the file extension. If that cannot be determined, this subcommand
-uses the first handler that has the capability to write an image file.
+write the data to the file and, optionally, options to pass to the
+format handler.  Specifically, this subcommand searches for the first
+handler whose name matches an initial substring of \fIformat-name\fR
+and which has the capability to write an image file.  If this option
+is not given, the format is guessed from the file extension. If that
+cannot be determined, this subcommand uses the first handler that has
+the capability to write an image file.
 .TP
 \fB\-from \fIx1 y1 x2 y2\fR
 .
@@ -501,20 +474,24 @@ image file formats to be added easily.  The photo image code maintains
 a list of these handlers.  Handlers are added to the list by
 registering them with a call to \fBTk_CreatePhotoImageFormat\fR.  The
 standard Tk distribution comes with handlers for PPM/PGM, PNG and GIF
-formats, which are automatically registered on initialization.
+formats, 
+.VS 8.7
+as well as the \fBdefault\fR handler to encode/decode image
+data in a human readable form. 
+.VE 8.7
+These handlers are automatically registered on initialization.
 .PP
-When reading an image file or processing
-string data specified with the \fB\-data\fR configuration option, the
-photo image code invokes each handler in turn until one is
-found that claims to be able to read the data in the file or string.
-Usually this will find the correct handler, but if it does not, the
-user may give a format name with the \fB\-format\fR option to specify
-which handler to use.  In fact the photo image code will try those
-handlers whose names begin with the string specified for the
-\fB\-format\fR option (the comparison is case-insensitive).  For
-example, if the user specifies \fB\-format gif\fR, then a handler
-named GIF87 or GIF89 may be invoked, but a handler
-named JPEG may not (assuming that such handlers had been
+When reading an image file or processing string data specified with
+the \fB\-data\fR configuration option, the photo image code invokes
+each handler in turn until one is found that claims to be able to read
+the data in the file or string.  Usually this will find the correct
+handler, but if it does not, the user may give a format name with the
+\fB\-format\fR option to specify which handler to use.  In this case,
+the photo image code will try those handlers whose names begin with
+the string specified for the \fB\-format\fR option (the comparison is
+case-insensitive).  For example, if the user specifies \fB\-format
+gif\fR, then a handler named GIF87 or GIF89 may be invoked, but a
+handler named JPEG may not (assuming that such handlers had been
 registered).
 .PP
 When writing image data to a file, the processing of the
@@ -525,27 +502,109 @@ that, which the handler can use, for example, to specify which variant
 to use of the formats supported by the handler.
 Note that not all image handlers may support writing transparency data
 to a file, even where the target image format does.
+.VS 8.7
+.SS "THE DEFAULT IMAGE HANDLER"
+.pp
+The \fBdefault\fR image handler cannot be used to read or write data
+from/to a file. Its sole purpose is to encode and decode image data in
+string form in a clear text, human readable, form. The \fIimageName\fR
+\fBdata\fR subcommand uses this handler when no other format is
+specified. When reading image data from a string with \fIimageName\fR
+\fBput\fR or the \fB-data\fR option, the default handler is treated
+as the other handlers.
+.PP
+Image data in the \fBdefault\fR string format is a (top-to-bottom)
+list of scan-lines, with each scan-line being a (left-to-right) list
+of pixel data. Every scan-line has the same length. The color
+and, optionally, alpha value of each pixel is specified in any of
+the forms described in the \fBCOLOR/ALPHA FORMAT\fR section below.
+.VE 8.7
+
 .SS "FORMAT SUBOPTIONS"
 .PP
 .VS 8.6
-Some image formats support sub-options, which are specified at the time that
-the image is loaded using additional words in the \fB\-format\fR option. At
-the time of writing, the following are supported:
+Image formats may support sub-options, which ahre specified using
+additional words in the value to the \fB\-format\fR option. These
+suboptions can affect how image data is read or written to file or
+string. The nature and values of these options is up to the format
+handler.
+The built-in handlers support these suboptions:
+.TP
+.VS 8.7
+\fBdefault \-colorformat\fI formatType\fR
+.
+The option is allowed when writing image data to a string with
+\fIimageName\fR \fBdata\fR. Specifies the format to use for the color
+string of each pixel. \fIformatType\fR may be one of: \fBrgb\fR to
+encode pixel data in the form \fB#\fIRRGGBB\fR, \fBargb\fR to encode
+pixel data in the form \fB#\fIAARRGGBB\fR or \fBlist\fR to encode
+pixel data as a list with four elements. See \fBCOLOR/ALPHA FORMAT\fR
+below for details. The default is \fBrgb\fR.
+.VE 8.7
 .TP
 \fBgif \-index\fI indexValue\fR
 .
-When parsing a multi-part GIF image, Tk normally only accesses the first
-image. By giving the \fB\-index\fR sub-option, the \fIindexValue\fR'th value
-may be used instead. The \fIindexValue\fR must be an integer from 0 up to the
-number of image parts in the GIF data.
+The option has effect when reading image data from a file. When
+parsing a multi-part GIF image, Tk normally only accesses the first
+image. By giving the \fB\-index\fR sub-option, the \fIindexValue\fR'th
+value may be used instead. The \fIindexValue\fR must be an integer
+from 0 up to the number of image parts in the GIF data.
 .TP
 \fBpng \-alpha\fI alphaValue\fR
 .
-An additional alpha filtering for the overall image, which allows the
-background on which the image is displayed to show through. This usually also
-has the effect of desaturating the image. The \fIalphaValue\fR must be between
-0.0 and 1.0.
+The option has effect when reading image data from a file. Specifies
+an additional alpha filtering for the overall image, which allows the
+background on which the image is displayed to show through.  This
+usually also has the effect of desaturating the image.  The
+\fIalphaValue\fR must be between 0.0 and 1.0.
 .VE 8.6
+.VS 8.7
+.SH "COLOR/ALPHA FORMAT"
+.PP
+The default image handler can represent/parse color and alpha values
+of a pixel in one of the formats listed below. If a color format does
+not contain transparency information, full opacity is assumed.  The
+available color formats are:
+.IP \(bu 3
+The empty string - interpreted as full transparency, the color value
+is undefined.
+.IP \(bu 3
+Any value accepted by \fBTk_GetColor\fR, optionally followed by an
+alpha suffix. The alpha suffix may be one of:
+.RS
+.TP
+\fB@\fR\fIA\fR
+.
+The alpha value \fIA\fR must be a fractional value in the range  0.0 
+(fully transparent) to 1.0 (fully opaque).
+.TP
+\fB#\fR\fIX\fR
+.
+The alpha value \fIX\fR is a hexadecimal digit that specifies an integer
+alpha value in the range 0 (fully transparent) to 255 (fully opaque). 
+This is expanded in range from 4 bits wide to 8 bits wide by 
+multiplication by 0x11.
+.TP
+\fB#\fR\fIXX\fR
+.
+The alpha value \fIXX\fR is passed as two hexadecimal digits that 
+specify an integer alpha value in the range 0 (fully transparent) to 255 
+(fully opaque). 
+.RE
+.IP \(bu 3
+A Tcl list with three or four integers in the range 0 to 255, 
+specifying the values for the red, green, bule and (optionally) 
+alpha channels respectively.
+.IP \(bu 3
+\fB#\fR\fIARGB\fR format: a \fB#\fR followed by four hexadecimal digits,
+where each digit is the value for the alpha, red, green and blue 
+channels respectively. Each digit will be expanded internally to 
+8-bits by multiplication by 0x11.
+.IP \(bu 3
+\fB#\fR\fIAARRGGBB\fR format: \fB#\fR followed by eight hexadecimal digits,
+where two subsequent digits represent the value for the alpha, red, green
+and blue channels respectively.
+.VE 8.7
 .SH "COLOR ALLOCATION"
 .PP
 When a photo image is displayed in a window, the photo image code
@@ -609,6 +668,23 @@ buttons:
 button .b \-image icon \-disabledimage iconDisabled
 .CE
 .VE 8.6
+.PP
+.VS 8.7
+Create a green box with a simple shadow effect
+.PP
+.CS
+\fBimage create photo\fR foo
+
+# Make a simple graduated fill varying in alpha for the shadow
+for {set i 14} {$i > 0} {incr i -1} {
+   set i2 [expr {$i + 30}]
+   foo \fBput\fR [format black#%x [expr {15-$i}]] -to $i $i $i2 $i2
+}
+
+# Put a solid green rectangle on top
+foo \fBput\fR #F080 -to 0 0 30 30
+.VE 8.7
+.CE
 .SH "SEE ALSO"
 image(n)
 .SH KEYWORDS
diff --git a/generic/tkImgListFormat.c b/generic/tkImgListFormat.c
new file mode 100644
index 0000000..2cf7a61
--- /dev/null
+++ b/generic/tkImgListFormat.c
@@ -0,0 +1,1033 @@
+/*
+ * tkImgListFormat.c --
+ *
+ *      Implements the default image data format. I.e. the format used for
+ *      [imageName data] and [imageName put] if no other format is specified.
+ *	
+ *      The default format consits of a list of scan lines (rows) with each
+ *      list element being itself a list of pixels (or columns). For details,
+ *      see the manpage photo.n
+ * 
+ *      This image format cannot read/write files, it is meant for string
+ *      data only. 
+ *
+ *
+ * Copyright (c) 1994 The Australian National University.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 2002-2003 Donal K. Fellows
+ * Copyright (c) 2003 ActiveState Corporation.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * Authors: 
+ *      Paul Mackerras (paulus@cs.anu.edu.au),
+ *	        Department of Computer Science,
+ *	        Australian National University.
+ *
+ *	    Simon Bachmann (simonbachmann@bluewin.ch)
+ */
+
+#include "tkImgPhoto.h"
+
+/*
+ * Message to generate when an attempt to allocate memory for an image fails.
+ */
+
+#define TK_PHOTO_ALLOC_FAILURE_MESSAGE \
+	"not enough free memory for image buffer"
+
+
+/*
+ * Color name length limit: do not attempt to parse as color strings that are
+ * longer than this limit
+ */
+
+#define TK_PHOTO_MAX_COLOR_CHARS 99
+
+/*
+ * "Names" for the different formats of a color string.
+ */
+
+enum ColorFormatType {
+    COLORFORMAT_TKCOLOR,
+    COLORFORMAT_EMPTYSTRING,
+    COLORFORMAT_LIST,
+    COLORFORMAT_RGB1,
+    COLORFORMAT_RGB2,
+    COLORFORMAT_ARGB1,
+    COLORFORMAT_ARGB2
+};
+
+/*
+ * Names for the color format types above.
+ * Order must match the one in enum ColorFormatType
+ */
+
+static const char *const colorFormatNames[] = {
+    "tkcolor",
+    "emptystring",
+    "list",
+    "rgb-short",
+    "rgb",
+    "argb-short",
+    "argb",
+    NULL
+};
+
+/*
+ * The following data structure is used to return information from
+ * ParseFormatOptions:
+ */
+
+struct FormatOptions {
+    int options;            /* Individual bits indicate which options were
+                             * specified - see below. */
+    Tcl_Obj *formatName;	/* Name specified without an option. */
+    enum ColorFormatType colorFormat;
+                            /* The color format type given with the
+                             * -colorformat option */
+};
+    
+/*
+ * Bit definitions for use with ParseFormatOptions: each bit is set in the
+ * allowedOptions parameter on a call to ParseFormatOptions if that option
+ * is allowed for the current photo image subcommand. On return, the bit is
+ * set in the options field of the FormatOptions structure if that option
+ * was specified.
+ *
+ * OPT_COLORFORMAT:         Set if -alpha option allowed/specified.
+ */
+
+#define OPT_COLORFORMAT     1
+
+/*
+ * List of format option names. The order here must match the order of
+ * declarations of the FMT_OPT_* constants above.
+ */
+
+static const char *const formatOptionNames[] = {
+    "-colorformat",
+    NULL
+};
+
+/*
+ * Forward declarations
+ */
+
+static int      ParseFormatOptions(Tcl_Interp *interp, int allowedOptions,
+                    int objc, Tcl_Obj *const objv[], int *indexPtr,
+                    struct FormatOptions *optPtr);
+static Tcl_Obj  *GetBadOptMsg(const char *badValue, int allowedOpts);
+static int      StringMatchDef(Tcl_Obj *data, Tcl_Obj *formatString,
+                    int *widthPtr, int *heightPtr, Tcl_Interp *interp);
+static int      StringReadDef(Tcl_Interp *interp, Tcl_Obj *data,
+                    Tcl_Obj *formatString, Tk_PhotoHandle imageHandle,
+                    int destX, int destY, int width, int height,
+                    int srcX, int srcY);
+static int      StringWriteDef(Tcl_Interp *interp,
+                    Tcl_Obj *formatString,
+                    Tk_PhotoImageBlock *blockPtr);
+static int      ParseColor(Tcl_Interp *interp, Tcl_Obj *specObj,
+                    Display *display, Colormap colormap, unsigned char *redPtr,
+                    unsigned char *greenPtr, unsigned char *bluePtr,
+                    unsigned char *alphaPtr);
+static int      ParseColorAsList(Tcl_Interp *interp, Tcl_Obj *specObj,
+                    unsigned char *redPtr, unsigned char *greenPtr, 
+                    unsigned char *bluePtr, unsigned char *alphaPtr);
+
+/*
+ * The format record for the default image handler
+ */
+
+Tk_PhotoImageFormat tkImgFmtDefault = {
+    "default",      /* name */
+    NULL,           /* fileMatchProc: format doesn't support file ops */
+    StringMatchDef, /* stringMatchProc */
+    NULL,           /* fileReadProc: format doesn't support file read */
+    StringReadDef,  /* stringReadProc */
+    NULL,           /* fileWriteProc: format doesn't support file write */
+    StringWriteDef  /* stringWriteProc */
+};
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ParseFormatOptions --
+ *
+ *      Parse the options passed to the image format handler.
+ *
+ * Results:
+ *      On success, the structure pointed to by optPtr is filled with the
+ *      values passed or with the defaults and TCL_OK returned.
+ *      If an error occurs, leaves an error message in interp and returns 
+ *      TCL_ERROR.
+ *
+ * Side effects: 
+ *      The value in *indexPtr is updated to the index of the fist
+ *      element in argv[] that does not look like an option/value, or to 
+ *      argc if parsing reached the end of argv[].
+ *
+ *----------------------------------------------------------------------
+ */
+static int
+ParseFormatOptions(
+    Tcl_Interp *interp,               /* For error messages */
+    int allowedOptions,               /* Bitfield specifying which options are
+                                       * to be considered allowed */
+    int objc,                         /* Number of elements in argv[] */
+    Tcl_Obj *const objv[],            /* The arguments to parse */
+    int *indexPtr,                    /* Index giving the first element to 
+                                       * parse. The value is updated to the
+                                       * index where parsing ended */
+    struct FormatOptions *optPtr)     /* Parsed option values are written to
+                                       * this struct */
+   
+{
+    int index, optIndex, typeIndex, first;
+    const char *option;
+
+    first = 1;
+
+    /*
+     * Fill in default values
+     */
+    optPtr->options = 0;
+    optPtr->formatName = NULL;
+    optPtr->colorFormat = COLORFORMAT_RGB2;
+    for (index = *indexPtr; index < objc; *indexPtr = ++index) {
+        int optionExists;
+
+        /*
+         * The first value can be the format handler's name. It goes to
+         * optPtr->name.
+         */
+        option = Tcl_GetString(objv[index]);
+        if (option[0] != '-') {
+            if (first) {
+                optPtr->formatName = objv[index];
+                first = 0;
+                continue;
+            } else {
+                break;
+            }
+        }
+        first = 0;
+        
+        /* 
+         * Check if option is known and allowed
+         */
+        
+        optionExists = 1;
+        if (Tcl_GetIndexFromObj(NULL, objv[index], formatOptionNames,
+                "format option", 0, &optIndex) != TCL_OK) {
+            optionExists = 0;
+        }
+        if (!optionExists || !((1 << optIndex) & allowedOptions)) {
+            Tcl_SetObjResult(interp, GetBadOptMsg(Tcl_GetString(objv[index]),
+                    allowedOptions));
+            Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "BAD_OPTION", NULL);
+            return TCL_ERROR;
+        }
+
+        /*
+         * Option-specific checks
+         */
+        
+        switch (1 << optIndex) {
+        case OPT_COLORFORMAT:
+            *indexPtr = ++index;
+            if (Tcl_GetIndexFromObj(NULL, objv[index], colorFormatNames, "",
+                    TCL_EXACT, &typeIndex) != TCL_OK
+                    || (typeIndex != COLORFORMAT_LIST
+                    && typeIndex != COLORFORMAT_RGB2
+                    && typeIndex != COLORFORMAT_ARGB2) ) {
+                Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad color format "
+                        "\"%s\": must be rgb, argb, or list",
+                        Tcl_GetString(objv[index])));
+                Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO",
+                        "BAD_COLOR_FORMAT", NULL);
+                return TCL_ERROR;
+            }
+            optPtr->colorFormat = typeIndex;
+            break;
+        default:
+            Tcl_Panic("ParseFormatOptions: unexpected switch fallthrough");
+        }
+
+        /*
+         * Add option to bitfield in optPtr
+         */
+        optPtr->options |= (1 << optIndex);
+    }
+    
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ *  GetBadOptMsg --
+ *
+ *      Build a Tcl_Obj containing an error message in the form "bad option
+ *      "xx": must be y, or z", based on the bits set in allowedOpts.
+ *
+ * Results:
+ *      A Tcl Object containig the error message. 
+ *
+ * Side effects:
+ *      None
+ *----------------------------------------------------------------------
+ */
+static Tcl_Obj *
+GetBadOptMsg(
+    const char *badValue,   /* the erroneous option */
+    int allowedOpts)        /* bitfield specifying the allowed options */
+{
+    int i, bit;
+    Tcl_Obj *resObj = Tcl_ObjPrintf("bad format option \"%s\": ", badValue);
+
+    if (allowedOpts == 0) {
+        Tcl_AppendToObj(resObj, "no options allowed", -1);
+    } else {
+        Tcl_AppendToObj(resObj, "must be ", -1);
+        bit = 1;
+        for (i = 0; formatOptionNames[i] != NULL; i++) {
+            if (allowedOpts & bit) {
+                if (allowedOpts & (bit -1)) {
+                    /* 
+                     * not the first option
+                     */
+                    if (allowedOpts & ~((bit << 1) - 1)) {
+                        /*
+                         * not the last option
+                         */
+                        Tcl_AppendToObj(resObj, ", ", -1);
+                    } else {
+                        Tcl_AppendToObj(resObj, ", or ", -1);
+                    }
+                }
+                Tcl_AppendToObj(resObj, formatOptionNames[i], -1);
+            }
+            bit <<=1;
+        }
+    }
+    return resObj;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringMatchDef --
+ *
+ *      Default string match function. Test if image data in string form 
+ *      appears to be in the default list-of-list-of-pixel-data format
+ *      accepted by the "<img> put" command.
+ *
+ * Results:
+ *      If thte data is in the default format, writes the size of the image 
+ *      to widthPtr and heightPtr and returns 1. Otherwise, leaves an error 
+ *      message in interp (if not NULL) and returns 0.
+ *      Note that this function does not parse all data points. A return 
+ *      value of 1 does not guarantee that the data can be read without 
+ *      errors.
+ *
+ * Side effects:
+ *      None
+ *----------------------------------------------------------------------
+ */
+static int
+StringMatchDef(
+    Tcl_Obj *data,          /* The data to check */
+    Tcl_Obj *formatString,  /* Value of the -format option, not used here */
+    int *widthPtr,          /* Width of image is written to this location */
+    int *heightPtr,         /* Height of image is written to this location */
+    Tcl_Interp *interp)     /* Error messages are left in this interpreter */
+{
+    int y, rowCount, colCount, curColCount;
+    unsigned char dummy;
+    Tcl_Obj **rowListPtr, *pixelData;
+
+    /*
+     * See if data can be parsed as a list, if every element is itself a valid
+     * list and all sublists have the same length.
+     */
+
+    if (Tcl_ListObjGetElements(interp, data, &rowCount, &rowListPtr)
+            != TCL_OK) {
+        return 0;
+    }
+    if (rowCount == 0) {
+        /* 
+         * empty list is valid data 
+         */
+        
+        *widthPtr = 0; 
+        *heightPtr = 0;
+        return 1;
+    }
+    colCount = -1;
+    for (y = 0; y < rowCount; y++) {
+        if (Tcl_ListObjLength(interp, rowListPtr[y], &curColCount) != TCL_OK) {
+            return 0;
+        }
+        if (colCount < 0) {
+            colCount = curColCount;
+        } else if (curColCount != colCount) {
+            if (interp != NULL) {
+                Tcl_SetObjResult(interp, Tcl_ObjPrintf("invalid row # %d: "
+                        "all rows must have the same number of elements", y));
+                Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO",
+                        "INVALID_DATA", NULL);
+            }
+            return 0;
+        }
+    }
+
+    /*
+     * Data in base64 encoding (or even binary data), might actually pass
+     * these tests. To avoid parsing it as list of lists format, check one
+     * pixel for validity.
+     */
+    if (Tcl_ListObjIndex(interp, rowListPtr[0], 0, &pixelData) != TCL_OK) {
+        return 0;
+    }
+    if (Tcl_GetCharLength(pixelData) > TK_PHOTO_MAX_COLOR_CHARS) {
+        return 0;
+    }
+    if (ParseColor(interp, pixelData, Tk_Display(Tk_MainWindow(interp)),
+            Tk_Colormap(Tk_MainWindow(interp)), &dummy, &dummy, &dummy, &dummy)
+            != TCL_OK) {
+        return 0;
+    }
+	
+    /*
+     * Looks like we have valid data for this format.
+     * We do not check any pixel values - that's the job of ImgStringRead()
+     */
+    
+    *widthPtr = colCount;
+    *heightPtr = rowCount;
+    
+    return 1;
+	    
+}
+ 
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringReadDef --
+ *
+ *      String read function for default format. (see manpage for details on
+ *      the format).
+ *
+ * Results:
+ *      A standard Tcl result.
+ *
+ * Side effects:
+ *      If the data has valid format, write it to the image identified by 
+ *      imageHandle.
+ *      If the image data cannot be parsed, an error message is left in 
+ *      interp.
+ *
+ *----------------------------------------------------------------------
+*/
+
+static int
+StringReadDef(
+    Tcl_Interp *interp,			/* leave error messages here */
+    Tcl_Obj *data,              /* the data to parse */
+    Tcl_Obj *formatString,		/* value of the -format option */
+    Tk_PhotoHandle imageHandle,	/* write data to this image */
+    int destX, int destY,		/* start writing data at this point
+                                 * in destination image*/
+    int width, int height,		/* dimensions of area to write to */
+    int srcX, int srcY)			/* start reading source data at these
+                                 * coordinates */ 
+{
+    Tcl_Obj **rowListPtr, **colListPtr;
+    Tcl_Obj **objv;
+    int objc;
+    unsigned char *curPixelPtr;
+    int x, y, rowCount, colCount, curColCount;
+    Tk_PhotoImageBlock srcBlock;
+    Display *display;
+    Colormap colormap;
+    struct FormatOptions opts;
+    int optIndex;
+    
+    /*
+     * Parse format suboptions 
+     * We don't use any format suboptions, but we still need to provide useful
+     * error messages if suboptions were specified.
+     */
+
+    memset(&opts, 0, sizeof(opts));
+    if (formatString != NULL) {
+        if (Tcl_ListObjGetElements(interp, formatString, &objc, &objv)
+                != TCL_OK) {
+            return TCL_ERROR;
+        }
+        optIndex = 0;
+        if (ParseFormatOptions(interp, 0, objc, objv, &optIndex, &opts)
+                != TCL_OK) {
+            return TCL_ERROR;
+        }
+        if (optIndex < objc) {
+            Tcl_SetObjResult(interp,
+                    GetBadOptMsg(Tcl_GetString(objv[optIndex]), 0));
+            Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "BAD_OPTION", NULL);
+            return TCL_ERROR;
+        }
+    }
+
+    /*
+     * Check input data
+     */
+
+    if (Tcl_ListObjGetElements(interp, data, &rowCount, &rowListPtr)
+            != TCL_OK ) {
+        return TCL_ERROR;
+    }
+    if ( rowCount > 0 && Tcl_ListObjLength(interp, rowListPtr[0], &colCount)
+            != TCL_OK) {
+        return TCL_ERROR;
+    }
+    if (width <= 0 || height <= 0 || colCount == 0 || rowCount == 0) {
+        /*
+         * No changes with zero sized input or zero sized output region
+         */
+
+        return TCL_OK;
+    }
+    if (srcX < 0 || srcY < 0 || srcX >= rowCount || srcY >= colCount) {
+        Tcl_SetObjResult(interp, Tcl_ObjPrintf("source coordinates out of range"));
+        Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "COORDINATES", NULL);
+        return TCL_ERROR;
+    }
+    
+    /*
+     * Memory allocation overflow protection.
+     * May not be able to trigger/ demo / test this.
+     */
+    
+    if (colCount > (int)(UINT_MAX / 4 / rowCount)) {
+        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+                        "photo image dimensions exceed Tcl memory limits"));
+        Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO",
+                "OVERFLOW", NULL);
+        return TCL_OK;
+    }
+    
+    /*
+     * Read data and put it to imageHandle
+     */
+    
+    srcBlock.width = colCount - srcX;
+    srcBlock.height = rowCount - srcY;
+    srcBlock.pixelSize = 4;
+    srcBlock.pitch = srcBlock.width * 4;
+    srcBlock.offset[0] = 0;
+    srcBlock.offset[1] = 1;
+    srcBlock.offset[2] = 2;
+    srcBlock.offset[3] = 3;
+    srcBlock.pixelPtr = attemptckalloc(srcBlock.pitch * srcBlock.height);
+    if (srcBlock.pixelPtr == NULL) {
+        Tcl_SetObjResult(interp, Tcl_ObjPrintf(TK_PHOTO_ALLOC_FAILURE_MESSAGE));
+        Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL);
+        return TCL_ERROR;
+    }
+    curPixelPtr = srcBlock.pixelPtr;
+    display = Tk_Display(Tk_MainWindow(interp));
+    colormap = Tk_Colormap(Tk_MainWindow(interp));
+    for (y = srcY; y < rowCount; y++) {
+        /*
+         * We don't test the length of row, as that's been done in
+         * ImgStringMatch()
+         */
+        
+        if (Tcl_ListObjGetElements(interp, rowListPtr[y], &curColCount, 
+                        &colListPtr) != TCL_OK) {
+            goto errorExit;
+        }
+        for (x = srcX; x < colCount; x++) {
+            if (ParseColor(interp, colListPtr[x], display, colormap,
+                    curPixelPtr, curPixelPtr + 1, curPixelPtr + 2,
+                    curPixelPtr + 3) != TCL_OK) {
+                goto errorExit;
+            }
+            curPixelPtr += 4;
+        }
+    }
+    
+    /*
+     * Write image data to destHandle
+     */
+    
+    if (Tk_PhotoPutBlock(interp, imageHandle, &srcBlock, destX, destY,
+            width, height, TK_PHOTO_COMPOSITE_SET) != TCL_OK) {
+        goto errorExit;
+    }
+    
+    ckfree(srcBlock.pixelPtr);
+    
+    return TCL_OK;		    
+	    
+  errorExit:
+    ckfree(srcBlock.pixelPtr);
+    
+    return TCL_ERROR;
+}
+ 
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringWriteDef --
+ *
+ *      String write function for default image data format. See the user
+ *      documentation for details.
+ *
+ * Results:
+ *      The converted data is set as the result of interp. Returns a standard 
+ *      Tcl result.
+ *
+ * Side effects:
+ *      None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+StringWriteDef(
+    Tcl_Interp *interp,
+    Tcl_Obj *formatString,
+    Tk_PhotoImageBlock *blockPtr)
+{
+    int greenOffset, blueOffset, alphaOffset, hasAlpha;
+    Tcl_Obj *data, **objv = NULL;
+    int objc, allowedOpts, optIndex;
+    struct FormatOptions opts;
+    
+    /*
+     * Parse format suboptions
+     */
+    if (Tcl_ListObjGetElements(interp, formatString, &objc, &objv)
+            != TCL_OK) {
+        return TCL_ERROR;
+    }
+    allowedOpts = OPT_COLORFORMAT;
+    optIndex = 0;
+    if (ParseFormatOptions(interp, allowedOpts, objc, objv, &optIndex, &opts)
+            != TCL_OK) {
+        return TCL_ERROR;
+    }
+    if (optIndex < objc) {
+        Tcl_SetObjResult(interp,
+                GetBadOptMsg(Tcl_GetString(objv[optIndex]), allowedOpts));
+        Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "BAD_OPTION", NULL);
+        return TCL_ERROR;
+    }
+    
+    greenOffset = blockPtr->offset[1] - blockPtr->offset[0];
+    blueOffset = blockPtr->offset[2] - blockPtr->offset[0];
+
+    /*
+     * A negative alpha offset signals that the image is fully opaque.
+     * That's not really documented anywhere, but it's the way it is!
+     */
+    
+    if (blockPtr->offset[3] < 0) {
+        hasAlpha = 0;
+    } else {
+        hasAlpha = 1;
+    }
+    alphaOffset = blockPtr->offset[3] - blockPtr->offset[0];
+
+    data = Tcl_NewObj();
+    if ((blockPtr->width > 0) && (blockPtr->height > 0)) {
+        int row, col;
+        Tcl_Obj *line, *colorList[4];
+        unsigned char *pixelPtr;
+        unsigned char alphaVal = 255;
+        
+        for (row=0; row<blockPtr->height; row++) {
+            line = Tcl_NewObj();
+            pixelPtr = blockPtr->pixelPtr + blockPtr->offset[0]
+                    + row * blockPtr->pitch;
+
+            for (col=0; col<blockPtr->width; col++) {
+                if (hasAlpha) {
+                    alphaVal = pixelPtr[alphaOffset];
+                }
+
+                /*
+                 * We don't build lines as a list for #ARGB and #RGB. Since 
+                 * these color formats look like comments, the first element
+                 * of the list would get quoted with an additional {} . 
+                 * While this is would not be a problem if the data is used as
+                 * a list, it will cause problems if someone decides to parse
+                 * it as a string.
+                 */
+
+                switch (opts.colorFormat) {
+                case COLORFORMAT_RGB2:
+                    Tcl_AppendPrintfToObj(line, "%s#%02x%02x%02x", 
+                            col == 0 ? "" : " ", pixelPtr[0],
+                            pixelPtr[greenOffset], pixelPtr[blueOffset]);
+                    break;
+                case COLORFORMAT_ARGB2:
+                    Tcl_AppendPrintfToObj(line, "%s#%02x%02x%02x%02x",
+                            col == 0 ? "" : " ", alphaVal, pixelPtr[0],
+                            pixelPtr[greenOffset], pixelPtr[blueOffset]);
+                    break;
+                case COLORFORMAT_LIST:
+                    colorList[0] = Tcl_NewIntObj(pixelPtr[0]);
+                    colorList[1] = Tcl_NewIntObj(pixelPtr[greenOffset]);
+                    colorList[2] = Tcl_NewIntObj(pixelPtr[blueOffset]);
+                    colorList[3] = Tcl_NewIntObj(alphaVal);
+                    if (Tcl_ListObjAppendElement(interp, line,
+                            Tcl_NewListObj(4, colorList)) != TCL_OK) {
+                        return TCL_ERROR;
+                    }
+                    break;
+                default:
+                    Tcl_Panic("unexpected switch fallthrough");
+                }
+                pixelPtr += blockPtr->pixelSize;
+            }
+            if (Tcl_ListObjAppendElement(interp, data, line) != TCL_OK) {
+                return TCL_ERROR;
+            }
+        }
+    }
+    Tcl_SetObjResult(interp, data);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ParseColor --
+ *
+ *      This function extracts color and alpha values from a string. It 
+ *      understands standard Tk color formats, alpha suffixes and the color 
+ *      formats specific to photo images, which include alpha data.
+ *
+ * Results:
+ *      On success, writes red, green, blue and alpha values to the 
+ *      corresponding pointers. If the color spec contains no alpha 
+ *      information, 255 is taken as transparency value. 
+ *      If the input cannot be parsed, leaves an error message in 
+ *      interp. Returns a standard Tcl result.
+ *
+ * Side effects:
+ *      None.
+ *
+ *----------------------------------------------------------------------
+ */
+static int
+ParseColor(
+    Tcl_Interp *interp,		/* error messages go there */
+    Tcl_Obj *specObj,		/* the color data to parse */
+    Display *display,       /* display of main window, needed to parse
+                             * standard Tk colors */
+    Colormap colormap,      /* colormap of current display */ 
+    unsigned char *redPtr, 	/* the result is written to these pointers */
+    unsigned char *greenPtr,
+    unsigned char *bluePtr,
+    unsigned char *alphaPtr)
+{
+    const char *specString, *suffixString, *colorString;
+    Tcl_Obj *colorObj = NULL;
+    unsigned int i, charCount;
+    XColor parsedColor;
+    int parsedAsList;
+    
+    /*
+     * If the string representation of color data is invalid, try to parse it
+     * as a list first, in order to avoid shimmering.
+     */
+
+    parsedAsList = 0;
+    if (specObj->bytes == NULL) {
+        if (ParseColorAsList(interp, specObj, redPtr, greenPtr, bluePtr,
+                alphaPtr) == TCL_OK) {
+            goto okExit;
+        } else {
+            Tcl_ResetResult(interp);
+        }
+        parsedAsList = 1;
+    }
+
+    /*
+     * Next, try the formats that have no suffix
+     */
+    specString = Tcl_GetString(specObj);
+    if (strlen(specString) == 0) {
+        /* Empty string */
+        *redPtr = *greenPtr = *bluePtr = *alphaPtr = 0;
+        goto okExit;
+    }
+    
+    charCount = strlen(specString);
+    if (specString[0] == '#'
+            && (charCount - 1 == 4 || charCount - 1 == 8)) {
+        int hexDigitsOnly = 1;
+        for (i = 1; i < charCount; i++) {
+            if ( ! isxdigit(UCHAR(specString[i]))) {
+                hexDigitsOnly = 0;
+                break;
+            }
+        }
+        
+        if (hexDigitsOnly) {
+            switch (charCount - 1) {
+            case 4:
+                /* #ARGB format */
+                sscanf(specString, "#%1hhx%1hhx%1hhx%1hhx", alphaPtr,
+                        redPtr, greenPtr, bluePtr);
+                *redPtr *= 0x11;
+                *greenPtr *= 0x11;
+                *bluePtr *= 0x11;
+                *alphaPtr *= 0x11;
+                goto okExit;
+                break;
+            case 8:
+                /* #AARRGGBB format */
+                sscanf(specString, "#%2hhx%2hhx%2hhx%2hhx", alphaPtr, redPtr,
+                        greenPtr, bluePtr);
+                goto okExit;
+                break;
+            default:
+                Tcl_Panic("unexpected switch fallthrough");
+            }
+        }
+    }
+    
+    /*
+     * Split color data string in color and suffix parts
+     */
+    
+    if ((suffixString = strrchr(specString, '@')) == NULL
+            && ((suffixString = strrchr(specString, '#')) == NULL
+            || suffixString == specString)) {
+        suffixString = specString + strlen(specString);
+        colorString = specString;
+        colorObj = specObj;
+    } else {
+        colorObj = Tcl_NewStringObj(specString, suffixString - specString);
+        colorString = Tcl_GetString(colorObj);
+    }
+    
+    /*
+     * Try to parse as standard Tk color.
+     * 
+     * We don't use Tk_GetColor() et al. here, as those functions
+     * migth return a color that does not exaxtly match the given name
+     * if the colormap is full. Also, we don't really want the color to be 
+     * added to the colormap.
+     */
+
+    if (TkParseColor(display, colormap, colorString, &parsedColor)) {
+        char *tmpString;
+        double fracAlpha;
+        unsigned int suffixAlpha;
+    
+        parsedColor.red >>= 8;
+        parsedColor.green >>= 8;
+        parsedColor.blue >>= 8;
+    
+        /*
+         * parse the Suffix
+         */
+
+        switch (suffixString[0]) {
+        case '\0': 
+            suffixAlpha = 255;
+            break;
+        case '@':
+            fracAlpha = strtod(suffixString + 1, &tmpString);
+            if (*tmpString != '\0') {
+                Tcl_SetObjResult(interp, Tcl_ObjPrintf("invalid alpha "
+                        "suffix \"%s\": expected floating-point value", 
+                        suffixString));
+                Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", 
+                        "INVALID COLOR", NULL);
+                goto errorExit;
+            }
+            if (fracAlpha < 0 || fracAlpha > 1) {
+                Tcl_SetObjResult(interp, Tcl_ObjPrintf("invalid alpha suffix" 
+                        " \"%s\": value must be in the range from 0 to 1", 
+                        suffixString));
+                Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO",
+                        "INVALID_COLOR", NULL);
+                goto errorExit;
+            }
+            suffixAlpha = round(fracAlpha * 255);
+            break;
+        case '#':
+            if (strlen(suffixString + 1) < 1 || strlen(suffixString + 1)> 2) {
+                Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+                        "invalid alpha suffix \"%s\"", suffixString));
+                Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", 
+                        "INVALID_COLOR", NULL);
+                goto errorExit;
+            }
+            for (i = 1; i <= strlen(suffixString + 1); i++) {
+                if ( ! isxdigit(UCHAR(suffixString[i]))) {
+                    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+                            "invalid alpha suffix \"%s\": expected hex digit",
+                             suffixString));
+                    Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO",
+                            "INVALID_COLOR", NULL);
+                    goto errorExit;
+                }
+            }
+            if (strlen(suffixString + 1) == 1) {
+                sscanf(suffixString, "#%1x", &suffixAlpha);
+                suffixAlpha *= 0x11;
+            } else {
+                sscanf(suffixString, "#%2x", &suffixAlpha);
+            }
+            break;
+        default:
+            Tcl_Panic("unexpected switch fallthrough");
+        }
+        *redPtr = parsedColor.red;
+        *greenPtr = parsedColor.green;
+        *bluePtr = parsedColor.blue;
+        *alphaPtr = suffixAlpha;
+
+        goto okExit;
+    }
+    
+    /*
+     * Last, try to parse as a list, if we didn't already.
+     */
+    if ( !parsedAsList && ParseColorAsList(interp, specObj, redPtr, greenPtr,
+            bluePtr, alphaPtr) == TCL_OK) {
+        goto okExit;
+    }
+    Tcl_ResetResult(interp);
+
+    /*
+     * Looks like we can't figure it out and must give up...
+     */
+    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+            "invalid color name \"%s\"", specString));
+    Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", 
+            "INVALID_COLOR", NULL);
+    goto errorExit;
+    
+  okExit:    
+    if (colorObj != NULL && colorObj != specObj) {
+        Tcl_DecrRefCount(colorObj);
+    }
+    
+    return TCL_OK;
+    
+  errorExit:
+    if (colorObj != NULL && colorObj != specObj) {
+        Tcl_DecrRefCount(colorObj);
+    }
+    
+    return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ParseColorAsList --
+ *
+ *      This function extracts color and alpha values from a list of 3 or 4
+ *      integers (the list color format).
+ *
+ * Results:
+ *      On success, writes red, green, blue and alpha values to the 
+ *      corresponding pointers. If the color spec contains no alpha 
+ *      information, 255 is taken as transparency value. 
+ *      If the input cannot be parsed, leaves an error message in 
+ *      interp. Returns a standard Tcl result.
+ *
+ * Side effects:
+ *      None.
+ *
+ *----------------------------------------------------------------------
+ */
+static int
+ParseColorAsList(
+    Tcl_Interp *interp,		/* error messages go there */
+    Tcl_Obj *specObj,		/* the color data to parse */
+    unsigned char *redPtr, 	/* the result is written to these pointers */
+    unsigned char *greenPtr,
+    unsigned char *bluePtr,
+    unsigned char *alphaPtr)
+{
+    int listLen;
+    unsigned int i;
+    int values[4];
+    Tcl_Obj *curValue;
+    const char *specString;
+	
+    
+    if (Tcl_ListObjLength(interp, specObj, &listLen) != TCL_OK
+            || listLen < 3 || listLen > 4) {
+        specString = Tcl_GetString(specObj);
+        Tcl_SetObjResult(interp, Tcl_ObjPrintf("invalid color name \"%s\"",
+                specString));
+        Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", 
+                "INVALID_COLOR", NULL);
+        return TCL_ERROR;
+    }
+    values[3] = -1;
+    for (i = 0; i < (unsigned)listLen; i++) {
+        if (Tcl_ListObjIndex(interp, specObj, i, &curValue) != TCL_OK) {
+            return TCL_ERROR;
+        }
+        if (Tcl_GetIntFromObj(interp, curValue, values + i) != TCL_OK) {
+            return TCL_ERROR;
+        }
+        if (values[i] < 0 || values[i] > 255) {
+            Tcl_SetObjResult(interp, Tcl_ObjPrintf("invalid color: "
+                    "expected integers in the range from 0 to 255"));
+            Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", 
+                    "INVALID_COLOR", NULL);
+            return TCL_ERROR;
+        }
+    }
+    *redPtr = values[0];
+    *greenPtr = values[1];
+    *bluePtr = values[2];
+    *alphaPtr = values[3] == -1 ? 255 : values[3];
+    
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkDebugStringMatchDef --
+ *
+ *      Debugging function for StringMatchDef. Basically just an alias for
+ *      that function, intended to expose it directly to tests, as
+ *      StirngMatchDef cannot be sufficiently tested otherwise.
+ *
+ * Results:
+ *      See StringMatchDef.
+ *
+ * Side effects:
+ *      None
+ *----------------------------------------------------------------------
+ */
+int
+TkDebugPhotoStringMatchDef(
+    Tcl_Interp *interp,     /* Error messages are left in this interpreter */
+    Tcl_Obj *data,          /* The data to check */
+    Tcl_Obj *formatString,  /* Value of the -format option, not used here */
+    int *widthPtr,          /* Width of image is written to this location */
+    int *heightPtr)         /* Height of image is written to this location */    
+{
+    return StringMatchDef(data, formatString, widthPtr, heightPtr, interp);
+}
+
diff --git a/generic/tkImgPhoto.c b/generic/tkImgPhoto.c
index 2eb674e..d6097e0 100644
--- a/generic/tkImgPhoto.c
+++ b/generic/tkImgPhoto.c
@@ -48,7 +48,9 @@ struct SubcommandOptions {
  * set in the options field of the SubcommandOptions structure if that option
  * was specified.
  *
+ * OPT_ALPHA:			Set if -alpha option allowed/specified.
  * OPT_BACKGROUND:		Set if -format option allowed/specified.
+ * OPT_BOOLEAN:			Set if -boolean option allowed/specified.
  * OPT_COMPOSITE:		Set if -compositingrule option allowed/spec'd.
  * OPT_FORMAT:			Set if -format option allowed/specified.
  * OPT_FROM:			Set if -from option allowed/specified.
@@ -56,18 +58,22 @@ struct SubcommandOptions {
  * OPT_SHRINK:			Set if -shrink option allowed/specified.
  * OPT_SUBSAMPLE:		Set if -subsample option allowed/spec'd.
  * OPT_TO:			Set if -to option allowed/specified.
+ * OPT_WITHALPHA:		Set if -withalpha option allowed/specified.
  * OPT_ZOOM:			Set if -zoom option allowed/specified.
  */
 
-#define OPT_BACKGROUND	1
-#define OPT_COMPOSITE	2
-#define OPT_FORMAT	4
-#define OPT_FROM	8
-#define OPT_GRAYSCALE	0x10
-#define OPT_SHRINK	0x20
-#define OPT_SUBSAMPLE	0x40
-#define OPT_TO		0x80
-#define OPT_ZOOM	0x100
+#define OPT_ALPHA	1
+#define OPT_BACKGROUND	2
+#define OPT_BOOLEAN	4
+#define OPT_COMPOSITE	8
+#define OPT_FORMAT	0x10
+#define OPT_FROM	0x20
+#define OPT_GRAYSCALE	0x40
+#define OPT_SHRINK	0x80
+#define OPT_SUBSAMPLE	0x100
+#define OPT_TO		0x200
+#define OPT_WITHALPHA	0x400
+#define OPT_ZOOM	0x800
 
 /*
  * List of option names. The order here must match the order of declarations
@@ -75,7 +81,9 @@ struct SubcommandOptions {
  */
 
 static const char *const optionNames[] = {
+    "-alpha",
     "-background",
+    "-boolean",
     "-compositingrule",
     "-format",
     "-from",
@@ -83,6 +91,7 @@ static const char *const optionNames[] = {
     "-shrink",
     "-subsample",
     "-to",
+    "-withalpha",
     "-zoom",
     NULL
 };
@@ -182,19 +191,6 @@ static int		ImgPhotoConfigureMaster(Tcl_Interp *interp,
 static int		ToggleComplexAlphaIfNeeded(PhotoMaster *mPtr);
 static int		ImgPhotoSetSize(PhotoMaster *masterPtr, int width,
 			    int height);
-static int		ImgStringMatch(Tcl_Obj *data, Tcl_Obj *format,
-			    int *widthPtr, int *heightPtr, Tcl_Interp *interp);
-static int		ImgStringRead(Tcl_Interp *interp, Tcl_Obj *data,
-			    Tcl_Obj *format, Tk_PhotoHandle imageHandle,
-			    int destX, int destY, int width, int height,
-			    int srcX, int srcY);
-static int		ImgStringWrite(Tcl_Interp *interp,
-			    Tcl_Obj *formatString,
-			    Tk_PhotoImageBlock *blockPtr);
-static int		ImgPhotoParseColor(Tcl_Interp *interp, 
-			    Tcl_Obj *specObj, unsigned char *redPtr, 
-			    unsigned char *greenPtr, unsigned char *bluePtr,
-			    unsigned char *alphaPtr);
 static char *		ImgGetPhoto(PhotoMaster *masterPtr,
 			    Tk_PhotoImageBlock *blockPtr,
 			    struct SubcommandOptions *optPtr);
@@ -661,7 +657,8 @@ ImgPhotoCmd(
 		options.compositingRule);
 
     case PHOTO_DATA: {
-	char *data;
+        char *data = NULL;
+        Tcl_Obj *freeObj = NULL;
 
 	/*
 	 * photo data command - first parse and check any options given.
@@ -669,7 +666,7 @@ ImgPhotoCmd(
 
 	Tk_ImageStringWriteProc *stringWriteProc = NULL;
 
-	index = 2;
+	index = 1;
 	memset(&options, 0, sizeof(options));
 	options.name = NULL;
 	options.format = NULL;
@@ -680,7 +677,7 @@ ImgPhotoCmd(
 		&index, objc, objv) != TCL_OK) {
 	    return TCL_ERROR;
 	}
-	if ((options.name != NULL) || (index < objc)) {
+	if ((options.name == NULL) || (index < objc)) {
 	    Tcl_WrongNumArgs(interp, 2, objv, "?-option value ...?");
 	    return TCL_ERROR;
 	}
@@ -702,50 +699,50 @@ ImgPhotoCmd(
 	    options.fromX2 = masterPtr->width;
 	    options.fromY2 = masterPtr->height;
 	}
+	if (!(options.options & OPT_FORMAT)) {
+            options.format = Tcl_NewStringObj("default", -1);
+            freeObj = options.format;
+	}
 
 	/*
 	 * Search for an appropriate image string format handler.
 	 */
 
-	if (options.options & OPT_FORMAT) {
-	    matched = 0;
-	    for (imageFormat = tsdPtr->formatList; 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) {
-		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_SetObjResult(interp, Tcl_ObjPrintf(
-			"image string format \"%s\" is %s",
-			Tcl_GetString(options.format),
-			(matched ? "not supported" : "unknown")));
-		Tcl_SetErrorCode(interp, "TK", "LOOKUP", "PHOTO_FORMAT",
-			Tcl_GetString(options.format), NULL);
-		return TCL_ERROR;
+	matched = 0;
+	for (imageFormat = tsdPtr->formatList; 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;
+                }
 	    }
-	} else {
-	    stringWriteProc = ImgStringWrite;
+	}
+	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_SetObjResult(interp, Tcl_ObjPrintf(
+                    "image string format \"%s\" is %s",
+                    Tcl_GetString(options.format),
+                    (matched ? "not supported" : "unknown")));
+	    Tcl_SetErrorCode(interp, "TK", "LOOKUP", "PHOTO_FORMAT",
+                    Tcl_GetString(options.format), NULL);
+	    goto dataErrorExit;
 	}
 
 	/*
@@ -782,7 +779,22 @@ ImgPhotoCmd(
 	if (data) {
 	    ckfree(data);
 	}
+        if (freeObj != NULL) {
+            Tcl_DecrRefCount(freeObj);
+        }
 	return result;
+
+      dataErrorExit:
+        if (options.background) {
+	    Tk_FreeColor(options.background);
+	}
+	if (data) {
+	    ckfree(data);
+	}
+        if (freeObj != NULL) {
+            Tcl_DecrRefCount(freeObj);
+        }
+	return TCL_ERROR;
     }
 
     case PHOTO_GET: {
@@ -791,11 +803,23 @@ ImgPhotoCmd(
 	 */
 
 	Tcl_Obj *channels[4];
-
-	if (objc != 4) {
-	    Tcl_WrongNumArgs(interp, 2, objv, "x y");
+	int channelCount = 3;
+    
+        index = 3;
+        memset(&options, 0, sizeof(options));
+        options.name = NULL;
+        if (ParseSubcommandOptions(&options, interp, OPT_WITHALPHA,
+                &index, objc, objv) != TCL_OK) {
+            return TCL_ERROR;
+        }
+        if (options.name == NULL || index < objc) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "x y ?-withalpha?");
 	    return TCL_ERROR;
 	}
+        if (options.options & OPT_WITHALPHA) {
+            channelCount = 4;
+        }
+ 
 	if ((Tcl_GetIntFromObj(interp, objv[2], &x) != TCL_OK)
 		|| (Tcl_GetIntFromObj(interp, objv[3], &y) != TCL_OK)) {
 	    return TCL_ERROR;
@@ -819,18 +843,21 @@ ImgPhotoCmd(
 	channels[1] = Tcl_NewIntObj(pixelPtr[1]);
 	channels[2] = Tcl_NewIntObj(pixelPtr[2]);
 	channels[3] = Tcl_NewIntObj(pixelPtr[3]);
-	Tcl_SetObjResult(interp, Tcl_NewListObj(4, channels));
+	Tcl_SetObjResult(interp, Tcl_NewListObj(channelCount, channels));
 	return TCL_OK;
     }
 
-    case PHOTO_PUT:
+    case PHOTO_PUT: {
+	Tcl_Obj *format, *data;
+
 	/*
-	 * photo put command - first parse the options and colors specified.
+	 * photo put command - first parse the options.
 	 */
 
 	index = 2;
 	memset(&options, 0, sizeof(options));
 	options.name = NULL;
+	options.format = NULL;
 	if (ParseSubcommandOptions(&options, interp, OPT_TO|OPT_FORMAT,
 		&index, objc, objv) != TCL_OK) {
 	    return TCL_ERROR;
@@ -839,73 +866,51 @@ ImgPhotoCmd(
 	    Tcl_WrongNumArgs(interp, 2, objv, "data ?-option value ...?");
 	    return TCL_ERROR;
 	}
-	
+
 	/*
 	 * See if there's a format that can read the data
 	 */
-
-	if (MatchStringFormat(interp, options.name ? objv[2]:NULL,
-		options.format, &imageFormat, &imageWidth,
-		&imageHeight, &oldformat) == TCL_OK) {
-	    Tcl_Obj *format, *data;
-
-	    if (!(options.options & OPT_TO) || (options.toX2 < 0)) {
-		options.toX2 = options.toX + imageWidth;
-		options.toY2 = options.toY + imageHeight;
-	    }
-	    if (imageWidth > options.toX2 - options.toX) {
-		imageWidth = options.toX2 - options.toX;
-	    }
-	    if (imageHeight > options.toY2 - options.toY) {
-		imageHeight = options.toY2 - options.toY;
-	    }
-	    format = options.format;
-	    data = objv[2];
-	    if (oldformat) {
-		if (format) {
-		    format = (Tcl_Obj *) Tcl_GetString(format);
-		}
-		data = (Tcl_Obj *) Tcl_GetString(data);
-	    }
-
-	    if (imageFormat->stringReadProc(interp, data, format,
-		    (Tk_PhotoHandle) masterPtr, options.toX, options.toY,
-		    imageWidth, imageHeight, 0, 0) != TCL_OK) {
-		return TCL_ERROR;
-	    }
-	    /*
-	     * SB: is the next line really needed? The stringReadProc 
-	     * writes image data with Tk_PhotoPutBlock(), which in turn
-	     * takes care to notify the changed image.
-	     */
-	    masterPtr->flags |= IMAGE_CHANGED;
-	    return TCL_OK;
-	}
 	
-	/*
-	 * Try with the default format
-	 */
-	if (options.options & OPT_FORMAT) {
+	if (MatchStringFormat(interp, objv[2], options.format, &imageFormat,
+		&imageWidth, &imageHeight, &oldformat) != TCL_OK) {
 	    return TCL_ERROR;
 	}
-	Tcl_ResetResult(interp);
-	if ( ! ImgStringMatch(objv[2], NULL, &imageWidth, &imageHeight,
-		interp)) {
-	    return TCL_ERROR;	    
-	}
+
 	if (!(options.options & OPT_TO) || (options.toX2 < 0)) {
 	    options.toX2 = options.toX + imageWidth;
 	    options.toY2 = options.toY + imageHeight;
 	}
-	if (ImgStringRead(interp, objv[2], NULL, (Tk_PhotoHandle) masterPtr,
-		options.toX, options.toY, 
+	if (imageWidth > options.toX2 - options.toX) {
+	    imageWidth = options.toX2 - options.toX;
+	}
+	if (imageHeight > options.toY2 - options.toY) {
+	    imageHeight = options.toY2 - options.toY;
+	}
+	format = options.format;
+	data = objv[2];
+	if (oldformat) {
+	    if (format) {
+		format = (Tcl_Obj *) Tcl_GetString(format);
+	    }
+	    data = (Tcl_Obj *) Tcl_GetString(data);
+	}
+
+	if (imageFormat->stringReadProc(interp, data, format,
+		(Tk_PhotoHandle) masterPtr, options.toX, options.toY,
 		options.toX2 - options.toX, 
 		options.toY2 - options.toY, 0, 0) != TCL_OK) {
 	    return TCL_ERROR;
 	}
-	
+	/*
+	 * SB: is the next line really needed? The stringReadProc 
+	 * writes image data with Tk_PhotoPutBlock(), which in turn
+	 * takes care to notify the changed image and to set/unset the
+	 * IMAGE_CHANGED bit.
+	 */
+	masterPtr->flags |= IMAGE_CHANGED;
+       
 	return TCL_OK;
-
+    }
     case PHOTO_READ: {
 	Tcl_Obj *format;
 
@@ -1075,8 +1080,11 @@ ImgPhotoCmd(
 
 	switch ((enum transOptions) index) {
 	case PHOTO_TRANS_GET: {
-	    const char *arg;
-	    int boolMode, strLength;
+	    int boolMode;
+
+	    /*
+	     * parse fixed args and option
+	     */
 	    
 	    if (objc > 6 || objc < 5) {
 		Tcl_WrongNumArgs(interp, 3, objv, "x y ?-option?");
@@ -1086,21 +1094,26 @@ ImgPhotoCmd(
 		    || (Tcl_GetIntFromObj(interp, objv[4], &y) != TCL_OK)) {
 		return TCL_ERROR;
 	    }
+
+	    index = 4;
+	    memset(&options, 0, sizeof(options));
+	    if (ParseSubcommandOptions(&options, interp,
+		    OPT_ALPHA | OPT_BOOLEAN, &index, objc, objv) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    if (index < objc) {
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"unknown option \"%s\": must be -alpha, or -boolean",
+			Tcl_GetString(objv[index])));
+		Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "BAD_OPTION",
+			NULL);
+		return TCL_ERROR;
+	    }
 	    boolMode = 1;
-	    if (objc == 6) {
-		arg = Tcl_GetStringFromObj(objv[5], &strLength);
-		if (strncmp(arg, "-boolean", (unsigned)strLength) == 0) {
-		    boolMode = 1;
-		} else if (strncmp(arg, "-alpha", (unsigned)strLength) == 0) {
-		    boolMode = 0;
-		} else {
-		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-			"unknown option \"%s\": must be -alpha or -boolean",
-			Tcl_GetString(objv[5])));
-		    Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "BAD_OPTION", NULL);
-		    return TCL_ERROR;
-		}
+	    if (options.options & OPT_ALPHA) {
+		boolMode = 0;
 	    }
+
 	    if ((x < 0) || (x >= masterPtr->width)
 		    || (y < 0) || (y >= masterPtr->height)) {
 		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
@@ -1111,15 +1124,9 @@ ImgPhotoCmd(
 		return TCL_ERROR;
 	    }
 
-	    /* What a way to do a test! */
-	    /* SB: indeed! Why don't we just get the information from image data? */
-	    /*
-		testRegion = TkCreateRegion();
-		TkUnionRectWithRegion(&testBox, testRegion, testRegion);
-		TkIntersectRegion(testRegion, masterPtr->validRegion, testRegion);
-		TkClipBox(testRegion, &testBox);
-		TkDestroyRegion(testRegion);
-	    */
+	    /* 
+	     * Extract and return the desired value
+	     */
 	    pixelPtr = masterPtr->pix32 + (y * masterPtr->width + x) * 4;
 	    if (boolMode) {
 		Tcl_SetObjResult(interp, Tcl_NewBooleanObj( ! pixelPtr[3]));
@@ -1130,64 +1137,75 @@ ImgPhotoCmd(
 	}
 
 	case PHOTO_TRANS_SET: {
-	    int newVal, boolMode, strLength;
-	    const char *arg;
+	    int newVal, boolMode;
+	    //const char *arg;
 	    XRectangle setBox;
 	    TkRegion modRegion;
 
+	    /* 
+	     * Parse args and option, check for valid values
+	     */
+	    
 	    if (objc < 6 || objc > 7) {
-		Tcl_WrongNumArgs(interp, 3, objv, "x y ?-option? newVal");
+		Tcl_WrongNumArgs(interp, 3, objv, "x y newVal ?-option?");
 		return TCL_ERROR;
 	    }
 	    if ((Tcl_GetIntFromObj(interp, objv[3], &x) != TCL_OK)
 		    || (Tcl_GetIntFromObj(interp, objv[4], &y) != TCL_OK)) {
 		return TCL_ERROR;
 	    }
+
+	    index = 5;
+	    memset(&options, 0, sizeof(options));
+	    if (ParseSubcommandOptions(&options, interp,
+		    OPT_ALPHA | OPT_BOOLEAN, &index, objc, objv) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    if (index < objc) {
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"unknown option \"%s\": must be -alpha, or -boolean",
+			Tcl_GetString(objv[index])));
+		Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "BAD_OPTION",
+			NULL);
+		return TCL_ERROR;
+	    }
 	    boolMode = 1;
-	    if (objc == 7) {
-		arg = Tcl_GetStringFromObj(objv[5], &strLength);
-		if (strncmp(arg, "-boolean", (unsigned) strLength) == 0) {
-		    boolMode = 1;
-		} else if (strncmp(arg, "-alpha", (unsigned) strLength) == 0) {
-		    boolMode = 0;
-		} else {
-		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-			"unknown option \"%s\": must be -alpha or -boolean",
-			Tcl_GetString(objv[5])));
-		    Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "BAD_OPTION", NULL);
-		    return TCL_ERROR;
-		}
+	    if (options.options & OPT_ALPHA) {
+		boolMode = 0;
 	    }
+
+	    if ((x < 0) || (x >= masterPtr->width)
+		|| (y < 0) || (y >= masterPtr->height)) {
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"%s transparency set: coordinates out of range",
+			Tcl_GetString(objv[0])));
+		Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "COORDINATES",
+			NULL);
+		return TCL_ERROR;
+	    }
+
 	    if (boolMode) {
-		if (Tcl_GetBooleanFromObj(interp, objv[objc-1], &newVal) != TCL_OK) {
+		if (Tcl_GetBooleanFromObj(interp, objv[5], &newVal) != TCL_OK) {
 		    return TCL_ERROR;
 		}
 	    } else {
-		if (Tcl_GetIntFromObj(interp, objv[objc-1], &newVal) != TCL_OK) {
+		if (Tcl_GetIntFromObj(interp, objv[5], &newVal) != TCL_OK) {
 		    return TCL_ERROR;
 		}
 		if (newVal < 0 || newVal > 255) {
 		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-			"invalid alpha value \"%d\": must be integer between 0 and 255",
-			newVal));
-		    Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "BAD_VALUE", NULL);
+			    "invalid alpha value \"%d\": "
+			    "must be integer between 0 and 255", newVal));
+		    Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO",
+			    "BAD_VALUE", NULL);
 		    return TCL_ERROR;
 		}
 	    }
-	    
-	    if ((x < 0) || (x >= masterPtr->width)
-		|| (y < 0) || (y >= masterPtr->height)) {
-		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-			"%s transparency set: coordinates out of range",
-			Tcl_GetString(objv[0])));
-		Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "COORDINATES",
-			NULL);
-		return TCL_ERROR;
-	    }
-
+	   
 	    /*
 	     * Set new alpha value for the pixel
 	     */
+	    
 	    pixelPtr = masterPtr->pix32 + (y * masterPtr->width + x) * 4;
 	    if (boolMode) {
 		pixelPtr[3] = newVal ? 0 : 255;
@@ -1198,6 +1216,7 @@ ImgPhotoCmd(
 	    /*
 	     * Update the validRegion of the image
 	     */
+
 	    setBox.x = x;
 	    setBox.y = y;
 	    setBox.width = 1;
@@ -1413,13 +1432,18 @@ GetExtension(
  *
  *	This function is invoked to process one of the options which may be
  *	specified for the photo image subcommands, namely, -from, -to, -zoom,
- *	-subsample, -format, -shrink, and -compositingrule.
+ *	-subsample, -format, -shrink, -compositingrule, -alpha, -boolean and
+ *	-withalpha.
+ *	Parsing starts at the index in *optIndexPtr and stops at the end of
+ *	objv[] or at the first value that does not belong to an option.
  *
  * Results:
  *	A standard Tcl result.
  *
  * Side effects:
- *	Fields in *optPtr get filled in.
+ *	Fields in *optPtr get filled in. The value of optIndexPtr is updated
+ *	to contain the index of the first element in argv[] that was not
+ *	parsed, or argc if the end of objv[] was reached.
  *
  *----------------------------------------------------------------------
  */
@@ -1544,7 +1568,8 @@ ParseSubcommandOptions(
 		return TCL_ERROR;
 	    }
 	    *optIndexPtr = index;
-	} else if ((bit != OPT_SHRINK) && (bit != OPT_GRAYSCALE)) {
+	} else if (bit == OPT_TO || bit == OPT_FROM 
+		|| bit == OPT_SUBSAMPLE || bit == OPT_ZOOM) {
 	    const char *val;
 
 	    maxValues = ((bit == OPT_FROM) || (bit == OPT_TO)) ? 4 : 2;
@@ -2500,7 +2525,7 @@ MatchStringFormat(
     int *oldformat)		/* Returns 1 if the old image API is used. */
 {
     int matched = 0, useoldformat = 0;
-    Tk_PhotoImageFormat *formatPtr;
+    Tk_PhotoImageFormat *formatPtr, *defaultFormatPtr = NULL;
     ThreadSpecificData *tsdPtr =
 	    Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
     const char *formatString = NULL;
@@ -2516,6 +2541,16 @@ MatchStringFormat(
 
     for (formatPtr = tsdPtr->formatList; formatPtr != NULL;
 	    formatPtr = formatPtr->nextPtr) {
+	/*
+	 * To keep the behaviour of older versions (Tk <= 8.6), the default
+	 * list-of-lists string format is checked last. Remember its position.
+	 */
+
+	if (strncasecmp("default", formatPtr->name, strlen(formatPtr->name))
+		== 0) {
+	    defaultFormatPtr = formatPtr;
+	}
+      
 	if (formatObj != NULL) {
 	    if (strncasecmp(formatString,
 		    formatPtr->name, strlen(formatPtr->name)) != 0) {
@@ -2531,6 +2566,16 @@ MatchStringFormat(
 		return TCL_ERROR;
 	    }
 	}
+	
+	/*
+	 * If this is the default format, and it was not passed as -format
+	 * option, skip the stringMatchProc test. It'll be done later
+	 */
+	
+	if (formatObj == NULL && formatPtr == defaultFormatPtr) {
+	    continue;
+	}
+
 	if ((formatPtr->stringMatchProc != NULL)
 		&& (formatPtr->stringReadProc != NULL)
 		&& formatPtr->stringMatchProc(data, formatObj,
@@ -2568,23 +2613,46 @@ MatchStringFormat(
 	    }
 	}
     }
+    
     if (formatPtr == NULL) {
-	if ((formatObj != NULL) && !matched) {
+	/* 
+	 * Try the default format as last resort (only if no -format option
+	 * was passed).
+	 */
+
+	if ( formatObj == NULL && defaultFormatPtr == NULL) {
+	    Tcl_Panic("default image format handler not registered");
+	}
+	if ( formatObj == NULL 
+		&& defaultFormatPtr->stringMatchProc != NULL
+		&& defaultFormatPtr->stringReadProc != NULL
+		&& defaultFormatPtr->stringMatchProc(data, formatObj,
+		widthPtr, heightPtr, interp) != 0) {
+	    useoldformat = 0;
+	    formatPtr = defaultFormatPtr;
+	} else if ((formatObj != NULL) && !matched) {
 	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
 		    "image format \"%s\" is not supported", formatString));
 	    Tcl_SetErrorCode(interp, "TK", "LOOKUP", "PHOTO_FORMAT",
 		    formatString, NULL);
+	    return TCL_ERROR;
 	} else {
 	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
 		    "couldn't recognize image data", -1));
 	    Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO",
 		    "UNRECOGNIZED_DATA", NULL);
+	    return TCL_ERROR;
 	}
-	return TCL_ERROR;
     }
 
     *imageFormatPtr = formatPtr;
     *oldformat = useoldformat;
+    
+    /*
+     * Some stringMatchProc might have left error messages and error codes in
+     * interp.	Clear them before return.
+     */
+    Tcl_ResetResult(interp);
     return TCL_OK;
 }
 
@@ -3799,549 +3867,6 @@ ImgGetPhoto(
     return NULL;
 }
 
-/*
- *----------------------------------------------------------------------
- * 
- * Default Photo Image Format
- * ===========================
- * 
- * We have a default (or fallback) image format that is used for the 
- * "<img> put", "<img> get", and "<img> data" commands. Image data is
- * specified as a list of lists of pixel data. For details see the description
- * of the "<img> put" command in the documentation of photo(n). 
- * 
- * This default image format cannot read/write files, it is meant for string
- * data only. 
- * 
- * The default format is not registerd with Tk_CreatePhotoImageFromat()
- * 
- *----------------------------------------------------------------------
- */
- 
-/*
- *----------------------------------------------------------------------
- *
- * ImgStringMatch --
- *
- *	Default string match function. Test if image data in string form 
- * 	appears to be in the default list-of-list-of-pixel-data format
- * 	accepted by the "<img> put" command.
- *
- * Results:
- *	If thte data is in the default format, writes the size of the image 
- *	to widthPtr and heightPtr and returns 1. Otherwise, leaves an error 
- * 	messate in interp (if not NULL) and returns 0.
- *	Note that this function does not parse all data points. A return 
- *	value of 1 does not guarantee that the data can be read without 
- * 	errors.
- *
- * Side effects:
- *	None
- *----------------------------------------------------------------------
- */
-static int
-ImgStringMatch(
-    Tcl_Obj *data,	/* The data to check */
-    Tcl_Obj *format, 	/* Value of the -format option, - NULL for this format */
-    int *widthPtr, 
-    int *heightPtr,	/* Size of the image in *data is written here */
-    Tcl_Interp *interp) /* ... */
-{
-    int y, rowCount, colCount, curColCount;
-    Tcl_Obj **rowListPtr;
-
-    /*
-     * See if data is a nonempty list and if each element has the same 
-     * length.
-     */
-
-    if (Tcl_ListObjGetElements(interp, data, &rowCount, &rowListPtr) 
-	    != TCL_OK) {
-	return 0;
-    }
-    if (rowCount == 0) {
-	/* empty list is actually valid data */
-	*widthPtr = 0; 
-	*heightPtr = 0;
-	return 1;
-    }
-    colCount = -1;
-    for (y = 0; y < rowCount; y++) {
-	if (Tcl_ListObjLength(interp, rowListPtr[y], &curColCount) != TCL_OK) {
-	    return 0;
-	}
-	if (colCount < 0) {
-	    colCount = curColCount;
-	} else if (curColCount != colCount) {
-	    if (interp != NULL) {
-		Tcl_SetObjResult(interp, Tcl_ObjPrintf("invalid row # %d: "
-			"all rows must have the same number of elements", y));
-		Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", 
-			"INVALID_DATA", NULL);
-	    }
-	    return 0;
-	}
-    }
-    
-    /*
-     * Looks like we have valid data for this format.
-     * We do not check any pixel values - that's the job of ImgStringRead()
-     */
-    
-    *widthPtr = colCount;
-    *heightPtr = rowCount;
-    
-    return 1;
-	    
-}
- 
-/*
- *----------------------------------------------------------------------
- *
- * ImgStringRead --
- *
- *	Default string read function. The data is formatted in the default
- *	format as accepted by the "<img> put" command.
- *
- * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- * 	If the data has valid format, write it to the image identified by 
- * 	imageHandle.
- * 	If the image data cannot be parsed, an error message is left in 
- *	interp.
- * 	See documentation for Tk_CreatePhotoImageFormat for further details.
- *
- *----------------------------------------------------------------------
-*/
-
-static int
-ImgStringRead(
-    Tcl_Interp *interp,			/* leave error messages here */
-    Tcl_Obj *data,			/* the data to parse */
-    Tcl_Obj *format, 			/* value of the -format option */
-    Tk_PhotoHandle imageHandle,		/* write data to this image */
-    int destX, int destY,		/* start writing data at this point
-					 * in destination image*/
-    int width, int height,		/* dimensions of area to write to */
-    int srcX, int srcY)			/* start reading source data at these
-					 * coordinates */ 
-{
-    Tcl_Obj **rowListPtr, **colListPtr;
-    unsigned char *curPixelPtr;
-    int x, y, rowCount, colCount, curColCount;
-    Tk_PhotoImageBlock srcBlock;
-   
-    /*
-     * Check if we have valid input data
-     */
-    
-    if (Tcl_ListObjGetElements(interp, data, &rowCount, &rowListPtr)
-	    != TCL_OK ) {
-	return TCL_ERROR;
-    }
-    if ( rowCount > 0 && Tcl_ListObjLength(interp, rowListPtr[0], &colCount) != TCL_OK) {
-	return TCL_ERROR;
-    }
-    if (width <= 0 || height <= 0 || colCount == 0 || rowCount == 0) {
-	/*
-	 * No changes with zero sized input or zero sized output region
-	 */
-	return TCL_OK;
-    }
-    if (srcX < 0 || srcY < 0 || srcX >= rowCount || srcY >= colCount) {
-	Tcl_SetObjResult(interp, Tcl_ObjPrintf("source coordinates out of range"));
-	Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "COORDINATES", NULL);
-	return TCL_ERROR;
-    }
-    
-    /*
-     * Memory allocation overflow protection.
-     * May not be able to trigger/ demo / test this.
-     */
-    
-    if (colCount > (int)(UINT_MAX / 4 / rowCount)) {
-	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-		"photo image dimensions exceed Tcl memory limits"));
-	Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO",
-		"OVERFLOW", NULL);
-	return TCL_OK;
-    }
-    
-    /*
-     * Read data and put it to imageHandle
-     */
-    
-    srcBlock.width = colCount - srcX;
-    srcBlock.height = rowCount - srcY;
-    srcBlock.pixelSize = 4;
-    srcBlock.pitch = srcBlock.width * 4;
-    srcBlock.offset[0] = 0;
-    srcBlock.offset[1] = 1;
-    srcBlock.offset[2] = 2;
-    srcBlock.offset[3] = 3;
-    srcBlock.pixelPtr = attemptckalloc(srcBlock.pitch * srcBlock.height);
-    if (srcBlock.pixelPtr == NULL) {
-	Tcl_SetObjResult(interp, Tcl_ObjPrintf(TK_PHOTO_ALLOC_FAILURE_MESSAGE));
-	Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL);
-	return TCL_ERROR;
-    }
-    curPixelPtr = srcBlock.pixelPtr;
-    for (y = srcY; y < rowCount; y++) {
-	/*
-	 * We don't test the length of row, as that's been done in
-	 * ImgStringMatch()
-	 */
-	if (Tcl_ListObjGetElements(interp, rowListPtr[y], &curColCount, 
-		&colListPtr) != TCL_OK) {
-	    goto errorExit;
-	}
-	for (x = srcX; x < colCount; x++) {
-	    if (ImgPhotoParseColor(interp, colListPtr[x], curPixelPtr, 
-		    curPixelPtr + 1, curPixelPtr + 2, curPixelPtr + 3) 
-		    != TCL_OK) {
-		goto errorExit;
-	    }
-	    curPixelPtr += 4;
-	}
-    }
-    
-    /*
-     * Write image data to destHandle
-     */
-    
-    if (Tk_PhotoPutBlock(interp, imageHandle, &srcBlock, destX, destY,
-	    width, height, TK_PHOTO_COMPOSITE_SET) != TCL_OK) {
-	goto errorExit;
-    }
-    
-    ckfree(srcBlock.pixelPtr);
-    
-    return TCL_OK;		    
-	    
-  errorExit:
-    ckfree(srcBlock.pixelPtr);
-    
-    return TCL_ERROR;
-}
- 
-/*
- *----------------------------------------------------------------------
- *
- * ImgStringWrite --
- *
- *	Default string write function. The data is formatted in the default
- *	format as accepted by the "<img> put" command.
- *
- * Results:
- *	The converted data is set as the result of interp. Returns a standard 
- * 	Tcl result.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-ImgStringWrite(
-    Tcl_Interp *interp,
-    Tcl_Obj *formatString,
-    Tk_PhotoImageBlock *blockPtr)
-{
-    int greenOffset, blueOffset;
-    Tcl_Obj *data;
-
-    greenOffset = blockPtr->offset[1] - blockPtr->offset[0];
-    blueOffset = blockPtr->offset[2] - blockPtr->offset[0];
-
-    data = Tcl_NewObj();
-    if ((blockPtr->width > 0) && (blockPtr->height > 0)) {
-	int row, col;
-
-	for (row=0; row<blockPtr->height; row++) {
-	    Tcl_Obj *line = Tcl_NewObj();
-	    unsigned char *pixelPtr = blockPtr->pixelPtr + blockPtr->offset[0]
-		    + row * blockPtr->pitch;
-
-	    for (col=0; col<blockPtr->width; col++) {
-		Tcl_AppendPrintfToObj(line, "%s#%02x%02x%02x",
-			col ? " " : "", *pixelPtr,
-			pixelPtr[greenOffset], pixelPtr[blueOffset]);
-		pixelPtr += blockPtr->pixelSize;
-	    }
-	    Tcl_ListObjAppendElement(NULL, data, line);
-	}
-    }
-    Tcl_SetObjResult(interp, data);
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ImgPhotoParseColor --
- *
- *	This function extracts color and alpha values from a string. It 
- *	understands standard Tk color formats, alpha suffixes and the color 
- *	formats specific to photo images, which include alpha data.
- *
- * Results:
- *	On success, writes red, green, blue and alpha values to the 
- *	corresponding pointers. If the color spec contains no alpha 
- *	information, 255 is taken as transparency value. 
- * 	If the input cannot be parsed, leaves an error message in 
- *	interp. Returns a standard Tcl result.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-static int
-ImgPhotoParseColor(
-    Tcl_Interp *interp,		/* error messages go there */
-    Tcl_Obj *specObj,		/* the color data to parse */
-    unsigned char *redPtr, 	/* the result is written to these pointers */
-    unsigned char *greenPtr,
-    unsigned char *bluePtr,
-    unsigned char *alphaPtr)
-{
-    const char *specString, *suffixString, *colorString;
-    Tcl_Obj *colorObj = NULL;
-    char *tmpString;
-    unsigned int i, charCount;
-    double fracAlpha;
-    unsigned int colorAlpha, suffixAlpha;
-    XColor parsedColor;
-    Display *display;
-    Colormap colormap;
-    enum FormatType {
-	PHOTO_COLORFORMAT_TKCOLOR,
-	PHOTO_COLORFORMAT_EMPTYSTRING,
-	PHOTO_COLORFORMAT_LIST,
-	PHOTO_COLORFORMAT_ARGB1,
-	PHOTO_COLORFORMAT_ARGB2
-    } formatType;
-
-    /*
-     * Split color data string in color and suffix parts
-     */
-    
-    specString = Tcl_GetString(specObj);
-    if ((suffixString = strrchr(specString, '@')) == NULL
-	    && ((suffixString = strrchr(specString, '#')) == NULL
-	    || suffixString == specString)) {
-	suffixString = specString + strlen(specString);
-    }
-    colorObj = Tcl_NewStringObj(specString, suffixString - specString);
-    colorString = Tcl_GetString(colorObj);
-    
-    /*
-     * Parse the color.
-     * 
-     * We don't use Tk_GetColor() et al. here, as those functions
-     * migth return a color that does not exaxtly match the given name
-     * if the colormap is full. Also, we don't really want the color to be 
-     * added to the colormap.
-     */
-    
-    display = Tk_Display(Tk_MainWindow(interp));
-    colormap = Tk_Colormap(Tk_MainWindow(interp));
-    if (TkParseColor(display, colormap, colorString, &parsedColor)) {
-	formatType = PHOTO_COLORFORMAT_TKCOLOR;
-	parsedColor.red >>= 8;
-	parsedColor.green >>= 8;
-	parsedColor.blue >>= 8;
-    } else if (colorString[0] == '#') {
-	charCount = strlen(colorString);
-	if (charCount - 1 != 4 && charCount - 1 != 8) {
-	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-		    "invalid color name \"%s\"", colorString));
-	    Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", 
-		    "INVALID_COLOR", NULL);
-	    goto errorExit;
-	}
-	for (i = 1; i < charCount; i++) {
-	    if ( ! isxdigit(UCHAR(colorString[i]))) {
-		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-			"invalid color name \"%s\"", colorString));
-		Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", 
-			"INVALID_COLOR", NULL);
-		goto errorExit;
-	    }
-	}
-	switch (charCount - 1) {
-	    case 4:
-		/* #ARGB format */
-		formatType = PHOTO_COLORFORMAT_ARGB1;
-		sscanf(colorString, "#%1x%1hx%1hx%1hx", &colorAlpha,
-			&parsedColor.red, &parsedColor.green, 
-			&parsedColor.blue);
-		parsedColor.red *= 0x11;
-		parsedColor.green *= 0x11;
-		parsedColor.blue *= 0x11;
-		colorAlpha *= 0x11;
-		break;
-	    case 8:
-		/* #AARRGGBB format */
-		formatType = PHOTO_COLORFORMAT_ARGB2;
-		sscanf(colorString, "#%2x%2hx%2hx%2hx", &colorAlpha,
-			&parsedColor.red, &parsedColor.green, 
-			&parsedColor.blue);
-		break;
-	    default:
-		Tcl_Panic("unexpected switch fallthrough");
-	}
-    } else if (strlen(colorString) == 0) {
-	formatType = PHOTO_COLORFORMAT_EMPTYSTRING;
-	parsedColor.red = 0;
-	parsedColor.green = 0;
-	parsedColor.blue = 0;
-	colorAlpha = 0;
-    } else {
-	int listLen;
-	int values[4];
-	Tcl_Obj *curValue;
-	
-	/* 
-	 * Last, try to interpret color as a tcl list 
-	 */
-	
-	if (Tcl_ListObjLength(interp, colorObj, &listLen) != TCL_OK
-		|| listLen < 3 || listLen > 4) {
-	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-		    "can't parse color \"%s\"", colorString));
-	    Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", 
-		    "INVALID_COLOR", NULL);
-	    goto errorExit;
-	}
-	values[3] = -1;
-	for (i = 0; i < (unsigned)listLen; i++) {
-	    if (Tcl_ListObjIndex(interp, colorObj, i, &curValue) != TCL_OK) {
-		goto errorExit;
-	    }
-	    if (Tcl_GetIntFromObj(interp, curValue, values + i) != TCL_OK) {
-		goto errorExit;
-	    }
-	    if (values[i] < 0 || values[i] > 255) {
-		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-			"invalid color \"%s\": expected integers "
-			"in the range from 0 to 255", colorString));
-		Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", 
-			"INVALID_COLOR", NULL);
-		goto errorExit;
-	    }
-	}
-	formatType = PHOTO_COLORFORMAT_LIST;
-	parsedColor.red = values[0];
-	parsedColor.green = values[1];
-	parsedColor.blue = values[2];
-	if (values[3] != -1) {
-	    colorAlpha = values[3];
-	} else {
-	    colorAlpha = 255;
-	}
-    }
-    
-    /*
-     * parse the Suffix
-     */
-    if (formatType != PHOTO_COLORFORMAT_TKCOLOR
-	    && suffixString[0] != '\0') {
-	Tcl_SetObjResult(interp, Tcl_ObjPrintf("invalid color \"%s\": "
-		"format does not allow alpha suffix", specString));
-	Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", 
-		"INVALID_COLOR", NULL);
-	goto errorExit;
-    }
-    switch (suffixString[0]) {
-	case '\0': 
-	    suffixAlpha = 255;
-	    break;
-	case '@':
-	    fracAlpha = strtod(suffixString + 1, &tmpString);
-	    if (*tmpString != '\0') {
-		Tcl_SetObjResult(interp, Tcl_ObjPrintf("invalid alpha "
-			"suffix \"%s\": expected floating-point value", 
-			suffixString));
-		Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", 
-			"INVALID COLOR", NULL);
-		goto errorExit;
-	    }
-	    if (fracAlpha < 0 || fracAlpha > 1) {
-		Tcl_SetObjResult(interp, Tcl_ObjPrintf("invalid alpha suffix" 
-			" \"%s\": value must be in the range from 0 to 1", 
-			suffixString));
-		Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO",
-			"INVALID_COLOR", NULL);
-		goto errorExit;
-	    }
-	    suffixAlpha = round(fracAlpha * 255);
-	    break;
-	case '#':
-	    if (strlen(suffixString + 1) < 1 || strlen(suffixString + 1)> 2) {
-		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-			"invalid alpha suffix \"%s\"", suffixString));
-		Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", 
-			"INVALID_COLOR", NULL);
-		goto errorExit;
-	    }
-	    for (i = 1; i <= strlen(suffixString + 1); i++) {
-		if ( ! isxdigit(UCHAR(suffixString[i]))) {
-		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-			    "invalid alpha suffix \"%s\": expected hex digit",
-			    suffixString));
-		    Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO",
-			    "INVALID_COLOR", NULL);
-		    goto errorExit;
-		}
-	    }
-	    if (strlen(suffixString + 1) == 1) {
-		sscanf(suffixString, "#%1x", &suffixAlpha);
-		suffixAlpha *= 0x11;
-	    } else {
-		sscanf(suffixString, "#%2x", &suffixAlpha);
-	    }
-	    break;
-	default:
-	    Tcl_Panic("unexpected switch fallthrough");
-    }
-    
-    /*
-     * Put the pieces togegher and clean up
-     */
-    
-    *redPtr = parsedColor.red;
-    *greenPtr = parsedColor.green;
-    *bluePtr = parsedColor.blue;
-    if (formatType == PHOTO_COLORFORMAT_TKCOLOR) {
-	/* 
-	 * there was no alpha value in the color spec. use the one
-	 * from suffix, which is 255 if no suffix was passed.
-	 */
-	
-	*alphaPtr = suffixAlpha;
-    } else {
-	*alphaPtr = colorAlpha;
-    }
-    
-    if (colorObj != NULL) {
-	Tcl_DecrRefCount(colorObj);
-    }
-    
-    return TCL_OK;
-    
-  errorExit:
-    if (colorObj != NULL) {
-	Tcl_DecrRefCount(colorObj);
-    }
-    
-    return TCL_ERROR;
-    
-}
-
 /*
  *----------------------------------------------------------------------
  *
@@ -4524,5 +4049,6 @@ Tk_PhotoSetSize_Panic(
  * mode: c
  * c-basic-offset: 4
  * fill-column: 78
+ * tab-width: 8
  * End:
  */
diff --git a/generic/tkInt.decls b/generic/tkInt.decls
index a13d8d7..19deb98 100644
--- a/generic/tkInt.decls
+++ b/generic/tkInt.decls
@@ -634,6 +634,13 @@ declare 184 {
 	    Tk_Font tkfont, const char *source, int numBytes, double x,
 	    double y, double angle)
 }
+
+# Debugging / testing functions for photo images
+declare 185 {
+    int TkDebugPhotoStringMatchDef(Tcl_Interp *inter, Tcl_Obj *data, 
+            Tcl_Obj *formatString, int *widthPtr, int *heightPtr)
+}
+
 
 ##############################################################################
 
diff --git a/generic/tkInt.h b/generic/tkInt.h
index 3138ffc..a52339d 100644
--- a/generic/tkInt.h
+++ b/generic/tkInt.h
@@ -945,6 +945,7 @@ MODULE_SCOPE const Tk_SmoothMethod tkBezierSmoothMethod;
 MODULE_SCOPE Tk_ImageType	tkBitmapImageType;
 MODULE_SCOPE Tk_PhotoImageFormat tkImgFmtGIF;
 MODULE_SCOPE void		(*tkHandleEventProc) (XEvent* eventPtr);
+MODULE_SCOPE Tk_PhotoImageFormat tkImgFmtDefault;
 MODULE_SCOPE Tk_PhotoImageFormat tkImgFmtPNG;
 MODULE_SCOPE Tk_PhotoImageFormat tkImgFmtPPM;
 MODULE_SCOPE TkMainInfo		*tkMainWindowList;
diff --git a/generic/tkIntDecls.h b/generic/tkIntDecls.h
index b8addbd..0ffe157 100644
--- a/generic/tkIntDecls.h
+++ b/generic/tkIntDecls.h
@@ -550,6 +550,10 @@ EXTERN void		TkDrawAngledChars(Display *display,
 				Drawable drawable, GC gc, Tk_Font tkfont,
 				const char *source, int numBytes, double x,
 				double y, double angle);
+/* 185 */
+EXTERN int		TkDebugPhotoStringMatchDef(Tcl_Interp *inter,
+				Tcl_Obj *data, Tcl_Obj *formatString,
+				int *widthPtr, int *heightPtr);
 
 typedef struct TkIntStubs {
     int magic;
@@ -767,6 +771,7 @@ typedef struct TkIntStubs {
     void (*tkUnderlineAngledTextLayout) (Display *display, Drawable drawable, GC gc, Tk_TextLayout layout, int x, int y, double angle, int underline); /* 182 */
     int (*tkIntersectAngledTextLayout) (Tk_TextLayout layout, int x, int y, int width, int height, double angle); /* 183 */
     void (*tkDrawAngledChars) (Display *display, Drawable drawable, GC gc, Tk_Font tkfont, const char *source, int numBytes, double x, double y, double angle); /* 184 */
+    int (*tkDebugPhotoStringMatchDef) (Tcl_Interp *inter, Tcl_Obj *data, Tcl_Obj *formatString, int *widthPtr, int *heightPtr); /* 185 */
 } TkIntStubs;
 
 extern const TkIntStubs *tkIntStubsPtr;
@@ -1139,6 +1144,8 @@ extern const TkIntStubs *tkIntStubsPtr;
 	(tkIntStubsPtr->tkIntersectAngledTextLayout) /* 183 */
 #define TkDrawAngledChars \
 	(tkIntStubsPtr->tkDrawAngledChars) /* 184 */
+#define TkDebugPhotoStringMatchDef \
+	(tkIntStubsPtr->tkDebugPhotoStringMatchDef) /* 185 */
 
 #endif /* defined(USE_TK_STUBS) */
 
diff --git a/generic/tkStubInit.c b/generic/tkStubInit.c
index 7f5b3be..f760677 100644
--- a/generic/tkStubInit.c
+++ b/generic/tkStubInit.c
@@ -467,6 +467,7 @@ static const TkIntStubs tkIntStubs = {
     TkUnderlineAngledTextLayout, /* 182 */
     TkIntersectAngledTextLayout, /* 183 */
     TkDrawAngledChars, /* 184 */
+    TkDebugPhotoStringMatchDef, /* 185 */
 };
 
 static const TkIntPlatStubs tkIntPlatStubs = {
diff --git a/generic/tkTest.c b/generic/tkTest.c
index 1f801be..bd7b948 100644
--- a/generic/tkTest.c
+++ b/generic/tkTest.c
@@ -203,6 +203,9 @@ static int		TrivialConfigObjCmd(ClientData dummy,
 			    Tcl_Obj * const objv[]);
 static void		TrivialEventProc(ClientData clientData,
 			    XEvent *eventPtr);
+static int              TestPhotoStringMatchCmd(ClientData dummy,
+                            Tcl_Interp *interp, int objc, 
+                            Tcl_Obj * const objv[]);
 
 /*
  *----------------------------------------------------------------------
@@ -265,6 +268,9 @@ Tktest_Init(
 	    (ClientData) Tk_MainWindow(interp), NULL);
     Tcl_CreateObjCommand(interp, "testtext", TkpTesttextCmd,
 	    (ClientData) Tk_MainWindow(interp), NULL);
+    Tcl_CreateObjCommand(interp, "testphotostringmatch", 
+            TestPhotoStringMatchCmd, (ClientData) Tk_MainWindow(interp),
+            NULL);
 
 #if defined(_WIN32) || defined(MAC_OSX_TK)
     Tcl_CreateObjCommand(interp, "testmetrics", TestmetricsObjCmd,
@@ -2066,6 +2072,54 @@ CustomOptionFree(
 	ckfree(*(char **)internalPtr);
     }
 }
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestPhotoStringMatchCmd --
+ *
+ *	This function implements the "testphotostringmatch" command. It
+ *	provides a way from Tcl to call the string match function for the
+ *	default image handler directly.
+ *
+ * Results:
+ *	A standard Tcl result. If data is in the proper format, the result in
+ *	interp will contain width and height as a list. If the data cannot be
+ *	parsed as default image format, returns TCL_ERROR and leaves an
+ *	appropriate error message in interp.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+static int
+TestPhotoStringMatchCmd(
+    ClientData clientData,	/* Main window for application. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])		/* Argument strings. */
+{
+    Tcl_Obj *dummy = NULL;
+    Tcl_Obj *resultObj[2];
+    int width, height;
+
+    if (objc != 2) {
+        Tcl_WrongNumArgs(interp, 1, objv, "imageData");
+        return TCL_ERROR;
+    }
+    if (TkDebugPhotoStringMatchDef(interp, objv[1], dummy, &width, &height)) {
+        resultObj[0] = Tcl_NewIntObj(width);
+        resultObj[1] = Tcl_NewIntObj(height);
+        Tcl_SetObjResult(interp, Tcl_NewListObj(2, resultObj));
+        return TCL_OK;
+    } else {
+        return TCL_ERROR;
+    }
+}
+            
+    
 
 /*
  * Local Variables:
diff --git a/generic/tkWindow.c b/generic/tkWindow.c
index ed57280..81d4f0d 100644
--- a/generic/tkWindow.c
+++ b/generic/tkWindow.c
@@ -334,6 +334,7 @@ CreateTopLevelWindow(
 	 * Create built-in photo image formats.
 	 */
 
+        Tk_CreatePhotoImageFormat(&tkImgFmtDefault);
 	Tk_CreatePhotoImageFormat(&tkImgFmtGIF);
 	Tk_CreatePhotoImageFormat(&tkImgFmtPNG);
 	Tk_CreatePhotoImageFormat(&tkImgFmtPPM);
diff --git a/tests/imgListFormat.test b/tests/imgListFormat.test
new file mode 100644
index 0000000..b371421
--- /dev/null
+++ b/tests/imgListFormat.test
@@ -0,0 +1,600 @@
+# This file is a Tcl script to test out the default image data format
+# ("list format") implementend in the file tkImgListFormat.c.
+# It is organized in the standard fashion for Tcl tests.
+#
+# Copyright (c) ???
+# All rights reserved.
+#
+# Author: Simon Bachmann (simonbachmann@bluewin.ch)
+
+package require tcltest 2.2
+namespace import ::tcltest::*
+tcltest::configure {*}$argv
+tcltest::loadTestedCommands
+
+imageInit
+
+# find the teapot.ppm file for use in these tests
+set teapotPhotoFile [file join [file dirname [info script]] teapot.ppm]
+testConstraint hasTeapotPhoto [file exists $teapotPhotoFile]
+# let's see if we have the semi-transparent one as well
+set transpTeapotPhotoFile [file join [file dirname [info script]] teapotTransparent.png]
+testConstraint hasTranspTeapotPhoto [file exists $transpTeapotPhotoFile]
+
+# ---------------------------------------------------------------------
+
+
+test imgListFormat-1.1 {ParseFormatOptions: default values} -setup {
+    image create photo photo1
+} -body {
+    photo1 put {{red green} {blue black}}
+    lindex [photo1 data] 1 1
+} -cleanup {
+    imageCleanup
+} -result {#000000}
+test imgListFormat-1.2 {ParseFormatOptions: format name as first arg} -setup {
+    image create photo photo1
+} -body {
+    photo1 put #1256ef -format {default} -to 0 0 10 10
+} -cleanup {
+    imageCleanup
+} -result {}
+test imgListFormat-1.3 {ParseFormatOptions: unknown option} -setup {
+    image create photo photo1
+} -body {
+    photo1 data -format {default -bogus}
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result {bad format option "-bogus": must be -colorformat}
+test imgListFormat-1.4 {ParseFormatOptions: option not allowed} -setup {
+    image create photo photo1
+} -body {
+    photo1 put yellow -format {default -colorformat rgb}
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result \
+    {bad format option "-colorformat": no options allowed}
+test imgListFormat-1.5 {ParseFormatOptions: bad -colorformat val #1} -setup {
+    image create photo photo1
+} -body {
+    photo1 put yellow
+    photo1 data -format {default -colorformat bogus}
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result \
+    {bad color format "bogus": must be rgb, argb, or list}
+test imgListFormat-1.6 {ParseFormatOptions: bad -colorformat val #2} -setup {
+    image create photo photo1
+} -body {
+    photo1 data -format {default -colorformat tkcolor}
+} -returnCodes error -result \
+    {bad color format "tkcolor": must be rgb, argb, or list}
+test imgListFormat-1.7 {ParseFormatOptions: bad -colorformat #3} -setup {
+    image create photo photo1
+} -body {
+    photo1 data -format {default -colorformat emptystring}
+} -returnCodes error -result \
+    {bad color format "emptystring": must be rgb, argb, or list}
+test imgListFormat-1.8 {ParseFormatOptions: bad -colorformat #4} -setup {
+    image create photo photo1
+} -body {
+    photo1 data -format {default -colorformat rgb-short}
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result \
+    {bad color format "rgb-short": must be rgb, argb, or list}
+test imgListFormat-1.9 {ParseFormatOptions: bad -colorformat #5} -setup {
+    image create photo photo1
+} -body {
+    photo1 data -format {default -colorformat argb-short}
+} -returnCodes error -result \
+    {bad color format "argb-short": must be rgb, argb, or list}
+test imgListFormat-1.10 {valid colorformats} -setup {
+    image create photo photo1
+} -body {
+    photo1 put white#78
+    set result {}
+    lappend result [photo1 data -format {default -colorformat rgb}]
+    lappend result [photo1 data -format {default -colorformat argb}]
+    lappend result [photo1 data -format {default -colorformat list}]
+    set result
+} -cleanup {
+    imageCleanup
+    unset result
+} -result {{{#ffffff}} {{#78ffffff}} {{{255 255 255 120}}}}
+
+# GetBadOptMsg: only use case already tested with imgListFormat-1.4
+    
+test imgListFormat-3.1 {StringMatchDef: data is not a list} -body {
+    testphotostringmatch {not a " proper list}
+    # " (this comment is here only for editor highlighting)
+} -returnCodes error -result {unmatched open quote in list}
+# empty data case tested with imgPhoto-4.95 (imgPhoto.test)
+test imgListFormat-3.2 {StringMatchDef: \
+        list element not a proper list} -body {
+    testphotostringmatch {{red white} {not "} {blue green}}
+    # "
+} -returnCodes error -result {unmatched open quote in list} 
+test imgListFormat-3.3 {StringMatchDef: \
+        sublists with differen lengths} -body {
+    testphotostringmatch {{#001122 #334455 #667788} 
+		{#99AABB #CCDDEE} 
+		{#FF0011 #223344 #556677}}
+} -returnCodes error -result \
+    {invalid row # 1: all rows must have the same number of elements}
+test imgListFormat-3.4 {StringMatchDef: base64 data is not parsed as valid \
+} -setup {
+    image create photo photo1
+} -body {
+    photo1 put {
+	iVBORw0KGgoAAAANSUhEUgAAAAIAAAACCA
+	YAAAEFsT2yAAAABGdBTUEAAYagMeiWXwAA
+	ABdJREFUCJkFwQEBAAAAgiD6P9pACRoqDk
+	fUBvt1wUFKAAAAAElFTkSuQmCC
+    } -format default
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result {couldn't recognize image data}
+test imgListFormat-3.5 {StringMatchDef: valid data} -setup {
+    image create photo photo1
+} -body {
+    photo1 put {{blue green}
+		{yellow magenta} 
+	        {#000000 #FFFFFFFF}}
+    list [image width photo1] [image height photo1] \
+	[photo1 get 0 2 -withalpha]
+} -cleanup {
+    imageCleanup
+} -result {2 3 {0 0 0 255}}
+
+# ImgStringRead: most of the error cases cannot be tested with current code, 
+# as the errors are detected by StringMatchDef	
+test imgListFormat-4.1 {StringReadDef: use with -format opt} -setup {
+    image create photo photo1
+} -body {
+    photo1 put white -format "default"
+    photo1 get 0 0
+} -cleanup {
+    imageCleanup
+} -result {255 255 255}
+test imgListFormat-4.2 {StringReadDef: suboptions to format} -setup {
+    image create photo photo1
+} -body {
+    photo1 put white -format {default -bogus}
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result \
+    {bad format option "-bogus": no options allowed}
+test imgListFormat-4.3 {StringReadDef: erroneous non-option argument} -setup {
+    image create photo photo1
+} -body {
+    photo1 put orange -format {default bogus}
+} -returnCodes error -result {bad format option "bogus": no options allowed}
+test imgListFormat-4.4 {StringReadDef: normal use case} -constraints {
+    hasTeapotPhoto
+} -setup {
+    image create photo photo1 -file $teapotPhotoFile
+    image create photo photo2
+} -body {
+    set imgData [photo1 data]
+    photo2 put $imgData
+    string equal [photo1 data] [photo2 data]
+} -cleanup {
+    imageCleanup
+    unset imgData
+} -result {1}
+test imgListFormat-4.5 {StringReadDef: correct compositing rule} -constraints {
+    hasTranspTeapotPhoto
+} -setup {
+    image create photo photo1 -file $transpTeapotPhotoFile
+    image create photo photo2
+} -body {
+    photo2 put #FF0000 -to 0 0 50 50
+    photo2 put [photo1 data -format {default -colorformat argb}] -to 10 10 40 40
+    list [photo2 get 0 0 -withalpha] [photo2 get 20 25 -withalpha] \
+	[photo2 get 49 49 -withalpha]
+} -cleanup {
+    imageCleanup
+} -result {{255 0 0 255} {0 78 185 225} {255 0 0 255}}
+
+test imgListFormat-5.1 {StringWriteDef: format options not a list} -setup {
+    image create photo photo1
+} -body {
+    photo1 data -format {default " bogus}
+    # "
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result {unmatched open quote in list}
+test imgListFormat-5.2 {StringWriteDef: invalid format option} -setup {
+    image create photo photo1
+} -body {
+    photo1 data -format {default -bogus}
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result {bad format option "-bogus": must be -colorformat}
+test imgListFormat-5.3 {StringWriteDef: non-option arg in format} -setup {
+    image create photo photo1
+} -body {
+    photo1 data -format {default -colorformat list bogus}
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result {bad format option "bogus": must be -colorformat}
+test imgListFormat-5.4 {StringWriteDef: empty image} -setup {
+    image create photo photo1
+} -body {
+    photo1 data -format {default -colorformat argb}
+} -cleanup {
+    imageCleanup
+} -result {}
+test imgListFormat-5.5 {StirngWriteDef: size of data} -setup {
+    image create photo photo1
+} -body {
+    photo1 put blue -to 0 0 35 64
+    set imgData [photo1 data]
+    list [llength [lindex $imgData 0]] [llength $imgData]
+} -cleanup {
+    unset imgData
+    imageCleanup
+} -result {35 64}
+test imgListFormat-5.6 {StringWriteDef: test some pixels #1} -constraints {
+    hasTeapotPhoto
+} -setup {
+    set result {}
+    image create photo photo1 -file $teapotPhotoFile
+} -body {
+    set imgData [photo1 data]
+    # note: with [lindex], the coords are inverted (y x)
+    lappend result [lindex $imgData 0 0]
+    lappend result [lindex $imgData 3 2]
+    lappend result [lindex $imgData 107 53]
+    lappend result [lindex $imgData 203 157]
+    lappend result [lindex $imgData 255 255]
+    set result 
+} -cleanup {
+    unset result
+    unset imgData
+    imageCleanup
+} -result {{#135cc0} #135cc0 #a06d52 #e1c8ba #135cc0}
+test imgListFormat-5.7 {StringWriteDef: test some pixels #2} -constraints {
+    hasTeapotPhoto
+} -setup {
+    set result {}
+    image create photo photo1 -file $teapotPhotoFile
+} -body {
+    set imgData [photo1 data -format {default -colorformat argb}]
+    # note: with [lindex], the coords are inverted (y x)
+    lappend result [lindex $imgData 0 0]
+    lappend result [lindex $imgData 3 2]
+    lappend result [lindex $imgData 107 53]
+    lappend result [lindex $imgData 203 157]
+    lappend result [lindex $imgData 255 255]
+    set result 
+} -cleanup {
+    unset result
+    unset imgData
+    imageCleanup
+} -result {{#ff135cc0} #ff135cc0 #ffa06d52 #ffe1c8ba #ff135cc0}
+test imgListFormat-5.8 {StringWriteDef: test some pixels #3} -constraints {
+    hasTranspTeapotPhoto
+} -setup {
+    image create photo photo1 -file $transpTeapotPhotoFile
+} -body {
+    set imgData [photo1 data -format {default -colorformat rgb}]
+    set result {}
+    lappend result [lindex $imgData 3 2]
+    lappend result [lindex $imgData 107 53]
+    lappend result [lindex $imgData 203 157]
+    set result
+} -cleanup {
+    unset result
+    unset imgData
+    imageCleanup
+} -result {{#004eb9} #a14100 #ffca9f}
+test imgListFormat-5.9 {StringWriteDef: test some pixels #4} -constraints {
+    hasTranspTeapotPhoto
+} -setup {
+    image create photo photo1 -file $transpTeapotPhotoFile
+} -body {
+    set imgData [photo1 data -format {default -colorformat argb}]
+    set result [lindex $imgData 3 2]
+    lappend result [lindex $imgData 107 53]
+    lappend result [lindex $imgData 203 157]
+    set result
+} -cleanup {
+    unset result
+    unset imgData
+    imageCleanup
+} -result {{#e1004eb9} #aaa14100 #afffca9f}
+test imgListFormat-5.10 {StringWriteDef: test some pixels #5} -constraints {
+    hasTranspTeapotPhoto
+} -setup {
+    image create photo photo1 -file $transpTeapotPhotoFile
+} -body {
+    set imgData [photo1 data -format {default -colorformat list}]
+    set result {}
+    lappend result [lindex $imgData 3 2]
+    lappend result [lindex $imgData 107 53]
+    lappend result [lindex $imgData 203 157]
+    set result
+} -cleanup {
+    unset imgData
+    unset result
+    imageCleanup
+} -result {{0 78 185 225} {161 65 0 170} {255 202 159 175}}
+
+test imgListFormat-6.1 {ParseColor: list format} -setup {
+    image create photo photo1
+} -body {
+    photo1 put [list [list [list 255 255 255]]]
+    photo1 get 0 0 -withalpha
+} -cleanup {
+    imageCleanup
+} -result {255 255 255 255}
+test imgListFormat-6.2 {ParseColor: string format in list rep} -setup {
+    image create photo photo1
+} -body {
+    photo1 put [list [list [list white]]]
+    photo1 get 0 0 -withalpha
+} -cleanup {
+    imageCleanup
+} -result {255 255 255 255}
+test imgListFormat-6.3 {ParseColor: empty string} -setup {
+    image create photo photo1
+    set result {}
+} -body {
+    photo1 put {{"" ""} {"" ""}}
+    lappend result [image width photo1]
+    lappend result [image height photo1]
+    lappend result [photo1 get 1 1 -withalpha]
+    set result
+} -cleanup {
+    unset result
+    imageCleanup
+} -result {2 2 {0 0 0 0}}
+test imgListFormat-6.4 {ImgPhotoParsecolor: empty string, mixed} -setup {
+    image create photo photo1
+} -body {
+    photo1 put {{black white} {{} white}}
+    list [photo1 get 0 0 -withalpha] [photo1 get 0 1 -withalpha]
+} -cleanup {
+    imageCleanup
+} -result {{0 0 0 255} {0 0 0 0}}
+test imgListFormat-6.5 {ParseColor: invalid hex digit} -setup {
+    image create photo photo1
+} -body {
+    photo1 put {#ABCD #ABCZ}
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result {invalid color name "#ABCZ"}
+test imgListFormat-6.6 {ParseColor: valid #ARGB color} -setup {
+    image create photo photo1
+} -body {
+    photo1 put {{#0d9bd502 #F7ac}}
+    list [photo1 get 0 0 -withalpha] [photo1 get 1 0 -withalpha]
+} -cleanup {
+    imageCleanup
+} -result {{155 213 2 13} {119 170 204 255}}
+test imgListFormat-6.7 {ParseColor: Tk color, valid suffixes} -setup {
+    image create photo photo1 
+    set result {}
+} -body {
+    photo1 put {{blue@0.711 #114433#C} {#8D4#1A magenta}}
+    lappend result [photo1 get 0 0 -withalpha]
+    lappend result [photo1 get 1 0 -withalpha]
+    lappend result [photo1 get 0 1 -withalpha]
+    lappend result [photo1 get 1 1 -withalpha]
+    set result
+} -cleanup {
+    unset result
+    imageCleanup
+} -result {{0 0 255 181} {17 68 51 204} {136 221 68 26} {255 0 255 255}}
+test imgListFormat-6.8 {ParseColor: Tk color with and w/o suffixes} -setup {
+    image create photo photo1
+    set result {}
+} -body {
+    photo1 put {{#52D8a0 #2B5} {#E47@0.01 maroon#4}}
+    lappend result [photo1 get 0 0 -withalpha]
+    lappend result [photo1 get 1 0 -withalpha]
+    lappend result [photo1 get 0 1 -withalpha]
+    lappend result [photo1 get 1 1 -withalpha]
+    set result
+} -cleanup {
+    unset result
+    imageCleanup
+} -result {{82 216 160 255} {34 187 85 255} {238 68 119 3} {128 0 0 68}}
+test imgListFormat-6.9 {ParseColor: @A suffix, not a float} -setup {
+    image create photo photo1
+} -body {
+    photo1 put {{blue@0.5 blue@bogus}}
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result \
+    {invalid alpha suffix "@bogus": expected floating-point value}
+test imgListFormat-6.10 {ParseColor: @A, value too low} -setup {
+    image create photo photo1 
+} -body {
+    photo1 put {green@.1 green@-0.1}
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result \
+    {invalid alpha suffix "@-0.1": value must be in the range from 0 to 1}
+test imgListFormat-6.11 {ParseColor: @A, value too high} -setup {
+    image create photo photo1
+} -body {
+    photo1 put {#000000@0 #000000@1.0001}
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result \
+    {invalid alpha suffix "@1.0001": value must be in the range from 0 to 1}
+test imgListFormat-6.12 {ParseColor: @A suffix, edge values} -setup {
+    imageCleanup
+    image create photo photo1
+} -body {
+    photo1 put {{yellow@1e-22 yellow@0.12352941 yellow@0.12352942 \
+		 yellow@0.9999999}}
+    list [photo1 get 0 0 -withalpha] [photo1 get 1 0 -withalpha] \
+	[photo1 get 2 0 -withalpha] [photo1 get 3 0 -withalpha]
+} -cleanup {
+    imageCleanup
+} -result {{255 255 0 0} {255 255 0 31} {255 255 0 32} {255 255 0 255}}
+test imgListFormat-6.13 {ParseColor: # suffix, no hex digits} -setup {
+    image create photo photo1
+} -body {
+    photo1 put {{black#f} {black#}}
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result {invalid alpha suffix "#"}
+test imgListFormat-6.14 {ParseColor: # suffix, too many digits} -setup {
+    image create photo photo1
+} -body {
+    photo1 put {{#ABC#12 #ABC#123}}
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result \
+    {invalid alpha suffix "#123"}
+test imgListFormat-6.15 {ParseColor: invalid digit in #X suffix} -setup {
+    image create photo photo1
+} -body {
+    photo1 put {#000#a #000#g}
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result {invalid alpha suffix "#g": expected hex digit}
+test imgListFormat-6.16 {ParseColor: invalid digit in #XX suffix} -setup {
+    image create photo photo1
+} -body {
+    photo1 put {green#2 green#2W}
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result {invalid alpha suffix "#2W": expected hex digit}
+test imgListFormat-6.17 {ParseColor: list format, string rep} -setup {
+	image create photo photo1
+} -body {
+	photo1 put {{"111 222 33 44"}}
+	photo1 get 0 0 -withalpha
+} -cleanup {
+	imageCleanup
+} -result {111 222 33 44}
+test imgListFormat-6.18 {ParseColor: invalid color: wrong digit #} -setup {
+    image create photo photo1
+} -body {
+    photo1 put {{#000 #00}}
+} -returnCodes error -result {invalid color name "#00"}
+test imgListFormat-6.19 {ParseColor: invalid color: not a hex digit} -setup {
+    image create photo photo1
+} -body {
+    photo1 put {#ABCDEF@.99 #ABCDEG@.99}
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result {invalid color name "#ABCDEG@.99"}
+test imgListFormat-6.20 {ParseColor: suffix not allowed #1} -setup {
+    image create photo photo1
+} -body {
+    photo1 put {#ABC@.5 #ABCD@0.5}
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result \
+    {invalid color name "#ABCD@0.5"}
+test imgListFormat-6.21 {ParseColor: suffix not allowed #2} -setup {
+    image create photo photo1
+} -body {
+    photo1 put {{{100 100 100} {100 100 100#FE}}}
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result \
+    {invalid color name "100 100 100#FE"}
+test imgListFormat-6.22 {ParseColor: suffix not allowed #3} -setup {
+    image create photo photo1
+} -body {
+    photo1 put {#1111 #1111#1}
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result \
+    {invalid color name "#1111#1"}
+test imgListFormat-6.23 {ParseColor: overall test} -setup {
+    image create photo photo1
+    set result {}
+} -body {
+    photo1 put {
+		{snow@0.5 snow#80 snow#8 #fffffafafafa@0.5 #fffffabbfacc#8}
+		{#fffffafffaff#80 #ffffaafaa@.5 #ffffaafaa#8 #ffffaafaa#80 #fee#8}
+		{#fee#80 #fee@0.5 #fffafa@0.5 #fffafa#8 #fffafa#80}
+		{{0xff 250 0xfa 128} {255 250 250} #8fee #80fffafa snow}}
+    for {set y 0} {$y < 4} {incr y} {
+		for {set x 0} {$x < 5} {incr x} {
+			lappend result [photo1 get $x $y -withalpha]
+		}
+    }
+    set result
+} -cleanup {
+    imageCleanup
+    unset result
+} -result \
+{{255 250 250 128} {255 250 250 128} {255 250 250 136} {255 250 250 128}\
+{255 250 250 136} {255 250 250 128} {255 250 250 128} {255 250 250 136}\
+{255 250 250 128} {255 238 238 136} {255 238 238 128} {255 238 238 128}\
+{255 250 250 128} {255 250 250 136} {255 250 250 128} {255 250 250 128}\
+{255 250 250 255} {255 238 238 136} {255 250 250 128} {255 250 250 255}}
+
+# Note: the error messages from ParseColorAsList are currently discarded. All
+# we'll ever get is a "invalid color mame xx" message.
+test imgListFormat-7.1 {ParseColorAsListAsList: invalid list} -setup {
+    image create photo photo1
+} -body {
+    photo1 put {{{123 45 67 89} {123 45 " 67}}}
+	#"
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result {invalid color name "123 45 " 67"}
+#"
+test imgListFormat-7.2 {ParseColorAsList: too few elements in list} -setup {
+    image create photo photo1
+} -body {
+    photo1 put {{{0 255 0 255} {0 255}}}
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result {invalid color name "0 255"}
+test imgListFormat-7.3 {ParseColorAsList: too many elements in list} -setup {
+    image create photo photo1
+} -body {
+    photo1 put {{{0 100 200 255} {0 100 200 255 0}}}
+} -returnCodes error -result {invalid color name "0 100 200 255 0"}
+test imgListFormat-7.4 {ParseColorAsList: not an integer value} -setup {
+    image create photo photo1
+} -body {
+    photo1 put {{{9 0xf3 87 65} {43 21 10 1.0}}}
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result {invalid color name "43 21 10 1.0"}
+test imgListFormat-7.5 {ParseColorAsList: negative value in list} -setup {
+    image create photo photo1
+} -body {
+    photo1 put {{{121 121 121} {121 121 -1}}}
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result {invalid color name "121 121 -1"}
+test imgListFormat-7.6 {ParseColorAsList: value in list too large} -setup {
+    image create photo photo1
+} -body {
+    photo1 put {{{0 1 2 3} {254 255 256}}}
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result {invalid color name "254 255 256"}
+test imgListFormat-7.7 {ParseColorAsList: valid list form} -setup {
+    image create photo photo1
+} -body {
+    photo1 put {{{0x0 0x10 0xfe 0xff} {0 100 254}}
+		{{30 30 30 0} {1 1 254 1}}}
+    list [photo1 get 0 0 -withalpha] [photo1 get 1 0 -withalpha] \
+	[photo1 get 0 1 -withalpha] [photo1 get 1 1 -withalpha]
+} -cleanup {
+    imageCleanup
+} -result {{0 16 254 255} {0 100 254 255} {30 30 30 0} {1 1 254 1}}
+
+
+# ---------------------------------------------------------------------
+
+imageFinish
+
+# cleanup
+cleanupTests
+return
diff --git a/tests/imgPhoto.test b/tests/imgPhoto.test
index 268700a..d1692a8 100644
--- a/tests/imgPhoto.test
+++ b/tests/imgPhoto.test
@@ -10,14 +10,82 @@
 #
 # Author: Paul Mackerras (paulus@cs.anu.edu.au)
 
+#
+# This file is somewhat caothic: the order of the tests does not
+# really follow the order of the corresponding functions in
+# tkImgPhoto.c. Probably, because early versions had only a few tests
+# and over time test cases were added in bits and pieces.
+# To be noted, also, that this file is not complete: large portions of
+# code in tkImgPhoto.c have no test coverage.
+#
+# To help keeping the overview, the table below lists where to find
+# tests for each of the functions in tkImgPhoto.c. The function are
+# listed in the order as they appear in the source file.
+# 
+
+#
+# Function name                         Tests for function
+#--------------------------------------------------------------------------
+# PhotoFormatThreadExitProc             no tests
+# Tk_Create*PhotoImageFormat            no tests
+# ImgPhotoCreate                        imgPhoto-2.*
+# ImgPhotoCmd                           imgPhoto-4.*, imgPhoto-17.*
+# GetExtension:                         no tests
+# ParseSubcommandOptions:               imgPhoto-1.*
+# ImgPhotoConfigureMaster:              imgPhoto-3.*, imgPhoto-15.*
+# toggleComplexAlphaIfNeeded:           no tests
+# ImgPhotoDelete:                       imgPhoto-8.*
+# ImgPhotoCmdDeleteProc:                imgPhoto-9.*
+# ImgPhotoSetSize:                      no tests
+# MatchFileFormat:                      imgPhoto-18.*
+# MatchSringFormat:                     imgPhoto-19.*
+# Tk_FindPhoto:                         imgPhoto-11.*
+# Tk_PhotoPutBlock:                     imgPhoto-10.*, imgPhoto-16.*
+# Tk_PhotoPutZoomedBlock:               imgPhoto-12.*
+# Tk_DitherPhoto:                       no tets
+# Tk_PhotoBlank:                        no tests
+# Tk_PhotoExpand:                       no tests
+# Tk_PhotoGetSize:                      no tests
+# Tk_PhotoSetSize:                      no tests
+# TkGetPhotoValidRegion:                no tests
+# ImgGetPhoto:                          no tests
+# Tk_PhotoGetImage                      no tests
+# ImgPostscriptPhoto                    no tests
+# Tk_PhotoPutBlock_NoComposite          no tests, probably none needed
+# Tk_PhotoPutZoomedBlock_NoComposite    no tests, probably none needed
+# Tk_PhotoExpand_Panic                  no tests, probably none needed
+# Tk_PhotoPutBlock_Panic                no tests, probably none needed
+# Tk_PhotoPutZoomedBlock_Panic          no tests, probably none needed
+# Tk_PhotoSetSize_Panic                 no tests, probably none needed
+#--------------------------------------------------------------------------
+#
+
+#
+# Some tests are not specific to a function in tkImgPhoto.c. They are:
+#
+
+#
+# Test name(s)          Description
+#--------------------------------------------------------------------------
+# imgPhoto-5.*          Do not really belong to this file. ImgPhotoGet and
+#                       ImgPhotoFree are defined in tkImgPhInstance.c.
+# imgPhoto-6.*          Do not really belong to this file. ImgPhotoDisplay
+#                       is defined in tkImgPhInstance.c.
+# imgPhoto-7.*          Do not really belong to this file. ImgPhotoFree is
+#                       defined in tkImgPhInstance.c.
+# imgPhoto-13.*         Tests for separation in different interpreters
+# imgPhoto-14.*         Test GIF format. Would belong to imgGIF.test
+#                       - which does not exist.
+#
+
 package require tcltest 2.2
 namespace import ::tcltest::*
 tcltest::configure {*}$argv
 tcltest::loadTestedCommands
-
-# Used for 4.65 - 4.73 tests
-# Now for some heftier testing, checking that setting and resetting of pixels'
-# transparency status doesn't "leak" with any one-off errors.
+
+# 
+# Used for imgPhoto-4.65 - imgPhoto-4.73
+#
 proc foreachPixel {img xVar yVar script} {
     upvar 1 $xVar x $yVar y
     set width [image width $img]
@@ -61,7 +129,7 @@ testConstraint hasTeapotPhoto [file exists $teapotPhotoFile]
 # let's see if we have the semi-transparent one as well
 set transpTeapotPhotoFile [file join [file dirname [info script]] teapotTransparent.png]
 testConstraint hasTranspTeapotPhoto [file exists $transpTeapotPhotoFile]
-
+
 # ----------------------------------------------------------------------
 
 test imgPhoto-1.1 {options for photo images} -body {
@@ -112,7 +180,31 @@ test imgPhoto-1.10 {options for photo images - error case} -body {
 test imgPhoto-1.11 {options for photo images - error case} -body {
     image create photo photo1 -format
 } -returnCodes error -result {value for "-format" missing}
-
+test imgPhoto-1.12 {option -alpha, normal use} -setup {
+    image create photo photo1
+} -body {
+    photo1 put "white" -to 0 0
+    photo1 transparency get 0 0 -alpha
+} -cleanup {
+    imageCleanup
+} -result {255}
+test imgPhoto-1.13 {option -boolean, normal use} -setup {
+    image create photo photo1
+} -body {
+    photo1 put "green" -to 0 0 
+    photo1 transparency set 0 0 1 -boolean
+} -cleanup {
+    imageCleanup
+} -result {}
+test imgPhoto-1.14 {option -withalpha, normal use} -setup {
+    image create photo photo1
+} -body {
+    photo1 put {{blue green}}
+    photo1 get 1 0 -withalpha
+} -cleanup {
+    imageCleanup
+} -result {0 128 0 255}
+
 test imgPhoto-2.1 {ImgPhotoCreate procedure} -setup {
     imageCleanup
 } -body {
@@ -135,7 +227,7 @@ test imgPhoto-2.2 {ImgPhotoCreate procedure} -setup {
 #     photo1 copy photo2
 #     set msg
 # } {couldn't open "bogus.img": no such file or directory}
-
+
 test imgPhoto-3.1 {ImgPhotoConfigureMaster procedure} -constraints {
     hasTeapotPhoto
 } -body {
@@ -171,7 +263,40 @@ test imgPhoto-3.3 {ImgPhotoConfigureMaster procedure} -constraints {
     destroy .c
     image delete photo1
 } -result {256 256 {10 10 266 266} {300 10 556 266}}
-
+test imgPhoto-3.4 {ImgPhotoConfigureMaster: -data <ppm>} -constraints {
+    hasTeapotPhoto
+} -setup {
+    image create photo photo1 -file $teapotPhotoFile
+    image create photo photo2
+} -body {
+    photo2 configure -data [photo1 data -format ppm -from 100 100 120 120]
+    list [image width photo2] [image height photo2]
+} -cleanup {
+    imageCleanup
+} -result {20 20}
+test imgPhoto-3.5 {ImgPhotoConfigureMaster: -data <png>} -constraints {
+    hasTeapotPhoto
+} -setup {
+    image create photo photo1 -file $teapotPhotoFile
+    image create photo photo2
+} -body {
+    photo2 configure -data [photo1 data -format png -from 120 120 140 140]
+    list [image width photo2] [image height photo2]
+} -cleanup {
+    imageCleanup
+} -result {20 20}
+test imgPhoto-3.6 {ImgPhotoConfigureMaster: -data <default>} -constraints {
+    hasTeapotPhoto
+} -setup {
+    image create photo photo1 -file $teapotPhotoFile
+    image create photo photo2
+} -body {
+    photo2 configure -data [photo1 data -from 80 90 100 110]
+    list [image width photo2] [image height photo2]
+} -cleanup {
+    imageCleanup
+} -result {20 20}
+
 test imgPhoto-4.1 {ImgPhotoCmd procedure} -setup {
     image create photo photo1
 } -body {
@@ -249,7 +374,7 @@ test imgPhoto-4.10 {ImgPhotoCmd procedure: copy option} -constraints {
     list [image width photo1] [image height photo1] [photo1 get 100 100]
 } -cleanup {
     image delete photo1 photo2
-} -result {256 256 {169 117 90 255}}
+} -result {256 256 {169 117 90}}
 test imgPhoto-4.11 {ImgPhotoCmd procedure: copy option} -setup {
     image create photo photo1
 } -body {
@@ -291,7 +416,7 @@ test imgPhoto-4.15 {ImgPhotoCmd procedure: copy option} -constraints {
     list [image width photo1] [image height photo1] [photo1 get 20 10]
 } -cleanup {
     image delete photo1 photo2
-} -result {60 50 {215 154 120 255}}
+} -result {60 50 {215 154 120}}
 test imgPhoto-4.16 {ImgPhotoCmd procedure: copy option} -constraints {
     hasTeapotPhoto
 } -setup {
@@ -302,7 +427,7 @@ test imgPhoto-4.16 {ImgPhotoCmd procedure: copy option} -constraints {
     list [image width photo1] [image height photo1] [photo1 get 40 80]
 } -cleanup {
     image delete photo1 photo2
-} -result {80 100 {19 92 192 255}}
+} -result {80 100 {19 92 192}}
 test imgPhoto-4.17 {ImgPhotoCmd procedure: copy option} -constraints {
     hasTeapotPhoto
 } -setup {
@@ -313,7 +438,7 @@ test imgPhoto-4.17 {ImgPhotoCmd procedure: copy option} -constraints {
     list [image width photo1] [image height photo1] [photo1 get 80 60]
 } -cleanup {
     image delete photo1 photo2
-} -result {100 100 {215 154 120 255}}
+} -result {100 100 {215 154 120}}
 test imgPhoto-4.18 {ImgPhotoCmd procedure: copy option} -constraints {
     hasTeapotPhoto
 } -setup {
@@ -324,7 +449,7 @@ test imgPhoto-4.18 {ImgPhotoCmd procedure: copy option} -constraints {
     list [image width photo1] [image height photo1] [photo1 get 100 50]
 } -cleanup {
     image delete photo1 photo2
-} -result {120 100 {169 99 47 255}}
+} -result {120 100 {169 99 47}}
 test imgPhoto-4.19 {ImgPhotoCmd procedure: copy option} -constraints {
     hasTeapotPhoto
 } -setup {
@@ -335,7 +460,7 @@ test imgPhoto-4.19 {ImgPhotoCmd procedure: copy option} -constraints {
     list [image width photo1] [image height photo1] [photo1 get 100 50]
 } -cleanup {
     image delete photo1 photo2
-} -result {120 100 {169 99 47 255}}
+} -result {120 100 {169 99 47}}
 test imgPhoto-4.20 {ImgPhotoCmd procedure: copy option} -constraints {
     hasTeapotPhoto
 } -setup {
@@ -346,7 +471,7 @@ test imgPhoto-4.20 {ImgPhotoCmd procedure: copy option} -constraints {
     list [image width photo1] [image height photo1] [photo1 get 50 30]
 } -cleanup {
     image delete photo1 photo2
-} -result {90 80 {207 146 112 255}}
+} -result {90 80 {207 146 112}}
 test imgPhoto-4.21 {ImgPhotoCmd procedure: copy option} -constraints {
     hasTeapotPhoto
 } -setup {
@@ -370,16 +495,19 @@ test imgPhoto-4.21 {ImgPhotoCmd procedure: copy option} -constraints {
 } -cleanup {
     image delete photo1 photo2
 } -result {256 256 49 51 49 51 49 51 10 51 10 10}
+# tests for <imageName> data: imgPhoto-4.
 test imgPhoto-4.22 {ImgPhotoCmd procedure: get option} -constraints {
     hasTranspTeapotPhoto
 } -setup {
     image create photo photo1
 } -body {
     photo1 read $transpTeapotPhotoFile
-    list [photo1 get 100 100] [photo1 get 150 100] [photo1 get 100 150]
+    list [photo1 get 100 100 -withalpha] \
+	[photo1 get 150 100 -withalpha] \
+	[photo1 get 100 150] [photo1 get 150 150]
 } -cleanup {
     image delete photo1
-} -result {{175 71 0 162} {179 73 0 168} {14 8 0 219}}
+} -result {{175 71 0 162} {179 73 0 168} {14 8 0} {0 0 0}}
 test imgPhoto-4.23 {ImgPhotoCmd procedure: get option} -setup {
     image create photo photo1
 } -body {
@@ -397,10 +525,12 @@ test imgPhoto-4.24 {ImgPhotoCmd procedure: get option} -setup {
 test imgPhoto-4.25 {ImgPhotoCmd procedure: get option} -setup {
     image create photo photo1
 } -body {
-    photo1 get
+    photo1 get 0
 } -cleanup {
     image delete photo1
-} -returnCodes error -result {wrong # args: should be "photo1 get x y"}
+} -returnCodes error -result \
+    {wrong # args: should be "photo1 get x y ?-withalpha?"}
+# more test for image get: 4.101-4.102
 test imgPhoto-4.26 {ImgPhotoCmd procedure: put option} -setup {
     image create photo photo1
 } -body {
@@ -414,27 +544,28 @@ test imgPhoto-4.27 {ImgPhotoCmd procedure: put option} -setup {
     photo1 put {{white} {white white}}
 } -returnCodes error -cleanup {
     image delete photo1
-} -result {invalid row # 1: all rows must have the same number of elements}
+} -result {couldn't recognize image data}
 test imgPhoto-4.28 {ImgPhotoCmd procedure: put option} -setup {
     image create photo photo1
 } -body {
     photo1 put {{blahgle}}
 } -cleanup {
     image delete photo1
-} -returnCodes error -result {can't parse color "blahgle"}
+} -returnCodes error -result {couldn't recognize image data}
 test imgPhoto-4.29 {ImgPhotoCmd procedure: put option} -setup {
     image create photo photo1
 } -body {
     # SB: odd thing - this test passed with tk 8.6.6, even if the data
-    # is in the wrong position!
+    # is in the wrong position:
     #photo1 put -to 10 10 20 20 {{white}}
+
     # this is how it's supposed to be:
     photo1 put {{white}} -to 10 10 20 20
     photo1 get 19 19
 } -cleanup {
     image delete photo1
-} -result {255 255 255 255}
-# more tests for image put: 4.90-4.94
+} -result {255 255 255}
+# more tests for image put: 4.90-4.100
 test imgPhoto-4.30 {ImgPhotoCmd procedure: read option} -setup {
     image create photo photo1
 } -body {
@@ -483,7 +614,7 @@ test imgPhoto-4.35 {ImgPhotoCmd procedure: read option} -constraints {
     list [image width photo1] [image height photo1] [photo1 get 120 120]
 } -cleanup {
     image delete photo1
-} -result {256 256 {161 109 82 255}}
+} -result {256 256 {161 109 82}}
 test imgPhoto-4.36 {ImgPhotoCmd procedure: read option} -constraints {
     hasTeapotPhoto
 } -setup {
@@ -493,7 +624,7 @@ test imgPhoto-4.36 {ImgPhotoCmd procedure: read option} -constraints {
     list [image width photo1] [image height photo1] [photo1 get 29 19]
 } -cleanup {
     image delete photo1
-} -result {70 60 {244 180 144 255}}
+} -result {70 60 {244 180 144}}
 test imgPhoto-4.37 {ImgPhotoCmd procedure: redither option} -setup {
     image create photo photo1
 } -body {
@@ -516,6 +647,7 @@ test imgPhoto-4.39 {ImgPhotoCmd procedure: write option} -setup {
 } -cleanup {
     image delete photo1
 } -returnCodes error -result {image file format "bogus" is unknown}
+# more tests on "imageName write": imgPhoto-17.*
 test imgPhoto-4.40 {ImgPhotoCmd procedure: transparency option} -setup {
     image create photo photo1
 } -body {
@@ -540,7 +672,7 @@ test imgPhoto-4.42 {ImgPhotoCmd procedure: transparency get option} -setup {
 test imgPhoto-4.43 {ImgPhotoCmd procedure: transparency get option} -setup {
     image create photo photo1
 } -body {
-    photo1 transparency get 0 0 -boolean 0
+    photo1 transparency get 0 0 0 -boolean
 } -returnCodes error -cleanup {
     image delete photo1
 } -result {wrong # args: should be "photo1 transparency get x y ?-option?"}
@@ -603,35 +735,39 @@ test imgPhoto-4.51 {ImgPhotoCmd procedure: transparency get option} -setup {
 } -cleanup {
     image delete photo1
 } -result 1
-# more tests for transparency get: 4.65, 4.66, 4.75-4.80
+# more tests for transparency get: 4.65, 4.66, 4.76-4.81
 test imgPhoto-4.52 {ImgPhotoCmd procedure: transparency set option} -setup {
     image create photo photo1
 } -body {
     photo1 transparency set
 } -returnCodes error -cleanup {
     image delete photo1
-} -result {wrong # args: should be "photo1 transparency set x y ?-option? newVal"}
+} -result \
+    {wrong # args: should be "photo1 transparency set x y newVal ?-option?"}
 test imgPhoto-4.53 {ImgPhotoCmd procedure: transparency set option} -setup {
     image create photo photo1
 } -body {
     photo1 transparency set 0
 } -returnCodes error -cleanup {
     image delete photo1
-} -result {wrong # args: should be "photo1 transparency set x y ?-option? newVal"}
+} -result \
+    {wrong # args: should be "photo1 transparency set x y newVal ?-option?"}
 test imgPhoto-4.54 {ImgPhotoCmd procedure: transparency set option} -setup {
     image create photo photo1
 } -body {
     photo1 transparency set 0 0
 } -returnCodes error -cleanup {
     image delete photo1
-} -result {wrong # args: should be "photo1 transparency set x y ?-option? newVal"}
+} -result \
+    {wrong # args: should be "photo1 transparency set x y newVal ?-option?"}
 test imgPhoto-4.55 {ImgPhotoCmd procedure: transparency set option} -setup {
     image create photo photo1
 } -body {
-    photo1 transparency set 0 0 -boolean 0 0
+    photo1 transparency set 0 0 0 0 -boolean
 } -returnCodes error -cleanup {
     image delete photo1
-} -result {wrong # args: should be "photo1 transparency set x y ?-option? newVal"}
+} -result \
+    {wrong # args: should be "photo1 transparency set x y newVal ?-option?"}
 test imgPhoto-4.56 {ImgPhotoCmd procedure: transparency set option} -setup {
     image create photo photo1
 } -body {
@@ -648,6 +784,7 @@ test imgPhoto-4.57 {ImgPhotoCmd procedure: transparency set option} -setup {
 } -returnCodes error -result {expected integer but got "bogus"}
 test imgPhoto-4.58 {ImgPhotoCmd procedure: transparency set option} -setup {
     image create photo photo1
+    photo1 put blue
 } -body {
     photo1 transparency set 0 0 bogus
 } -cleanup {
@@ -699,7 +836,7 @@ test imgPhoto-4.64 {ImgPhotoCmd procedure: transparency set option} -setup {
 } -cleanup {
     image delete photo1
 } -result 1
-# more tests for transparency set: 4.67, 4.68, 4.81-4.88
+# more tests for transparency set: 4.67, 4.68, 4.82-4.89
 # Now for some heftier testing, checking that setting and resetting of pixels'
 # transparency status doesn't "leak" with any one-off errors.
 test imgPhoto-4.65 {ImgPhotoCmd procedure: transparency get option} -setup {
@@ -824,9 +961,7 @@ test imgPhoto-4.75 {<photo> read command: filename starting with '-'} -constrain
     image delete photo1
     file delete ./-teapotPhotoFile
 } -result {}
-
-test imgPhoto-4.75 {ImgPhotoCmd procedure: transparancy get} -setup {
-    imageCleanup
+test imgPhoto-4.76 {ImgPhotoCmd, transparancy get: too many options} -setup {
     image create photo photo1
 } -body {
     photo1 put white -to 0 0 1 1
@@ -835,8 +970,7 @@ test imgPhoto-4.75 {ImgPhotoCmd procedure: transparancy get} -setup {
     imageCleanup
 } -returnCodes error -result \
     {wrong # args: should be "photo1 transparency get x y ?-option?"}
-test imgPhoto-4.76 {ImgPhotoCmd procedure: transparency get} -setup {
-    imageCleanup
+test imgPhoto-4.77 {ImgPhotoCmd, transparency get: invalid option} -setup {
     image create photo photo1
 } -body {
     photo1 put white -to 0 0 1 1
@@ -844,9 +978,8 @@ test imgPhoto-4.76 {ImgPhotoCmd procedure: transparency get} -setup {
 } -cleanup {
     imageCleanup
 } -returnCodes error -result \
-    {unknown option "-bogus": must be -alpha or -boolean}
-test imgPhoto-4.77 {ImgPhotoCmd procedure: transparency get} -setup {
-    imageCleanup
+    {unrecognized option "-bogus": must be -alpha, or -boolean}
+test imgPhoto-4.78 {ImgPhotoCmd, transparency get: normal use} -setup {
     image create photo photo1
 } -body {
     photo1 put white -to 0 0 1 1
@@ -855,7 +988,7 @@ test imgPhoto-4.77 {ImgPhotoCmd procedure: transparency get} -setup {
 } -cleanup {
     imageCleanup
 } -result {0 255}
-test imgPhoto-4.78 {ImgPhotoCmd procedure: transparency get} -constraints {
+test imgPhoto-4.79 {ImgPhotoCmd, transparency get: no option} -constraints {
     hasTranspTeapotPhoto
 } -setup {
     image create photo photo1 -file $transpTeapotPhotoFile
@@ -869,7 +1002,8 @@ test imgPhoto-4.78 {ImgPhotoCmd procedure: transparency get} -constraints {
 } -cleanup {
     imageCleanup
 } -result {0 1 0 0 0}
-test imgPhoto-4.79 {ImgPhotoCmd procedure: transparency get} -constraints {
+test imgPhoto-4.80 {ImgPhotoCmd, transparency get: -boolean option\
+} -constraints {
     hasTranspTeapotPhoto
 } -setup {
     image create photo photo1 -file $transpTeapotPhotoFile
@@ -883,7 +1017,7 @@ test imgPhoto-4.79 {ImgPhotoCmd procedure: transparency get} -constraints {
 } -cleanup {
     imageCleanup
 } -result {0 1 0 0 0}
-test imgPhoto-4.80 {ImgPhotoCmd procedure: transparency get} -constraints {
+test imgPhoto-4.81 {ImgPhotoCmd, transparency get: -alpha} -constraints {
     hasTranspTeapotPhoto
 } -setup {
     image create photo photo1 -file $transpTeapotPhotoFile
@@ -897,135 +1031,170 @@ test imgPhoto-4.80 {ImgPhotoCmd procedure: transparency get} -constraints {
 } -cleanup {
     imageCleanup
 } -result {255 0 1 254 206}
-test imgPhoto-4.81 {ImgPhotoCmd procedure: transparency set} -setup {
+test imgPhoto-4.82 {ImgPhotoCmd, transparency set: too many opts} -setup {
     image create photo photo1
 } -body {
     photo1 transparency set 0 0 -alpha -boolean 1
 } -cleanup {
     imageCleanup
 } -returnCodes error -result \
-    {wrong # args: should be "photo1 transparency set x y ?-option? newVal"}
-test imgPhoto-4.82 {ImgPhotoCmd procedure: transparency set} -setup {
-    image create photo photo1
+    {wrong # args: should be "photo1 transparency set x y newVal ?-option?"}
+test imgPhoto-4.83 {ImgPhotoCmd, transparency set: invalid opt} -setup {
+    image create photo photo1 -data black
 } -body {
-    photo1 transparency set 0 0 -bogus 0
+    photo1 transparency set 0 0 0 -bogus
 } -cleanup {
     imageCleanup
-} -returnCodes error -result {unknown option "-bogus": must be -alpha or -boolean}
-test imgPhoto-4.83 {ImgPhotoCmd procedure: transparency set} -setup {
-    image create photo photo1
+} -returnCodes error -result \
+    {unrecognized option "-bogus": must be -alpha, or -boolean}
+test imgPhoto-4.84 {ImgPhotoCmd, transparency set: invalid newVal} -setup {
+    image create photo photo1 -data white
 } -body {
-    photo1 transparency set 0 0 -alpha bogus
+    photo1 transparency set 0 0 bogus -alpha
 } -cleanup {
     imageCleanup
 } -returnCodes error -result {expected integer but got "bogus"}
-test imgPhoto-4.84 {ImgPhotoCmd procedure: transparency set} -setup {
-    image create photo photo1
+test imgPhoto-4.85 {ImgPhotoCmd, transparency set: invalid newVal} -setup {
+    image create photo photo1 -data red
 } -body {
-    photo1 transparency set 0 0 -alpha -1
+    photo1 transparency set 0 0 -1 -alpha
 } -returnCodes error -result \
     {invalid alpha value "-1": must be integer between 0 and 255}
-test imgPhoto-4.85 {ImgPhotoCmd procedure: transparency set} -setup {
-    image create photo photo1
+test imgPhoto-4.86 {ImgPhotoCmd, transparency set: invalid newVal} -setup {
+    image create photo photo1 -data green
 } -body {
-    photo1 transparency set 0 0 -alpha 256
+    photo1 transparency set 0 0 256 -alpha
 } -cleanup {
     imageCleanup
 } -returnCodes error -result \
     {invalid alpha value "256": must be integer between 0 and 255}
-test imgPhoto-4.86 {ImgPhotoCmd procedure: transparency set} -setup {
+test imgPhoto-4.87 {ImgPhotoCmd, transparency set: no opt} -setup {
     image create photo photo1
 } -body {
     photo1 put white -to 0 0 2 1
     photo1 transparency set 0 0 0
     photo1 transparency set 1 0 1
-    list [photo1 transparency get 0 0 -alpha] [photo1 transparency get 1 0 -alpha]
+    list [photo1 transparency get 0 0 -alpha] \
+        [photo1 transparency get 1 0 -alpha]
 } -cleanup {
     imageCleanup
 } -result {255 0}
-test imgPhoto-4.87 {ImgPhotoCmd procedure: transparency set} -setup {
+test imgPhoto-4.88 {ImgPhotoCmd, transparency set: -boolean} -setup {
     image create photo photo1
 } -body {
     photo1 put white -to 0 0 2 1
-    photo1 transparency set 0 0 -boolean 0
-    photo1 transparency set 1 0 -boolean 1
-    list [photo1 transparency get 0 0 -alpha] [photo1 transparency get 1 0 -alpha]
+    photo1 transparency set 0 0 0 -boolean
+    photo1 transparency set 1 0 1 -boolean
+    list [photo1 transparency get 0 0 -alpha] \
+        [photo1 transparency get 1 0 -alpha]
 } -cleanup {
     imageCleanup
 } -result {255 0}
-test imgPhoto-4.88 {ImgPhotoCmd procedure: transparency set} -setup {
+test imgPhoto-4.89 {ImgPhotoCmd, transparency set: -alpha} -setup {
     image create photo photo1
 } -body {
     photo1 put white -to 0 0 2 2
-    photo1 transparency set 0 0 -alpha 0
-    photo1 transparency set 1 0 -alpha 1
-    photo1 transparency set 0 1 -alpha 254
-    photo1 transparency set 1 1 -alpha 255
+    photo1 transparency set 0 0 0 -alpha 
+    photo1 transparency set 1 0 1 -alpha
+    photo1 transparency set 0 1 254 -alpha
+    photo1 transparency set 1 1 255 -alpha
     list [photo1 transparency get 0 0] [photo1 transparency get 1 0] \
 	[photo1 transparency get 0 1] [photo1 transparency get 1 1]
 } -cleanup {
     imageCleanup
 } -result {1 0 0 0}
-test imgPhoto-4.89 {ImgPhotoCmd procdeure: put option} -constraints {
+test imgPhoto-4.90 {ImgPhotoCmd put: existing but not allowed opt} -setup {
+    image create photo photo1
+} -body {
+    photo1 put yellow -from 0 0 1 1
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result \
+    {unrecognized option "-from": must be -format, or -to}
+test imgPhoto-4.91 {ImgPhotoCmd put: invalid option} -setup {
+    image create photo photo1
+} -body {
+    photo1 put {{0 1 2 3}} -bogus x
+} -returnCodes error -result \
+    {unrecognized option "-bogus": must be -format, or -to}
+test imgPhoto-4.92 {ImgPhotocmd put: missing data} -setup {
+    image create photo photo1
+} -body {
+    photo1 put -to 0 0
+} -returnCodes error -result \
+    {wrong # args: should be "photo1 put data ?-option value ...?"}
+test imgPhoto-4.93 {ImgPhotoCmd put: data in ppm format} -constraints {
     hasTeapotPhoto
 } -setup {
     image create photo photo1 -file $teapotPhotoFile
     image create photo photo2
 } -body {
-    # put data in a registered format
     set imgdata [photo1 data -format ppm]
     photo2 put $imgdata -format ppm
     set result {}
     if {[image width photo1] != [image width photo2] \
-	    || [image height photo1] != [image height photo2]} {
-	lappend result [list [image width photo2] [image height photo2]]
+            || [image height photo1] != [image height photo2]} {
+        lappend result [list [image width photo2] [image height photo2]]
     } else {
-	lappend result 1
+        lappend result 1
     }
     foreach point {{206 125} {67 12} {13 46} {19 184}} {
-	if {[photo1 get {*}$point] ne [photo2 get {*}$point]} {
-	    lappend result [photo2 get {*}$point]
-	} else {
-	    lappend result 1
-	}
+        if {[photo1 get {*}$point] ne [photo2 get {*}$point]} {
+            lappend result [photo2 get {*}$point]
+        } else {
+            lappend result 1
+        }
     }
     set result
 } -cleanup {
     imageCleanup
 } -result {1 1 1 1 1}
-test imgPhoto-4.90 {ImgPhotoCmd procedure: put option} -setup {
-    imageCleanup
+test imgPhoto-4.94 {ImgPhotoCmd put: unknown format} -setup {
     image create photo photo1
 } -body {
-    # unknown format
     photo1 put {no real data} -format bogus
 } -cleanup {
     imageCleanup
 } -returnCodes error -result {image format "bogus" is not supported}
-test imgPhoto-4.91 {ImgPhotoCmd procedure: put option} -setup {
-    imageCleanup
+test imgPhoto-4.95 {ImgPhotoCmd put: default fmt, invalid data} -setup {
     image create photo photo1
 } -body {
-    # default format, invalid data error case
-    photo1 put "not a \{ proper list" 
+    photo1 put {{red green blue} {red " blue}}
+    #"
 } -cleanup {
     imageCleanup
-} -returnCodes error -result {unmatched open brace in list}
-test imgPhoto-4.92 {ImgPhotoCmd procedure: put option} -setup {
+} -returnCodes error -result {couldn't recognize image data}
+test imgPhoto-4.96 {ImgPhotoCmd put: "default" handler is selected} -setup {
+    image create photo photo1
+    image create photo photo2
+    set imgData {{{1 2 3 4} {5 6 7 8} {9 10 11 12}}
+        {{13 14 15 15} {17 18 19 20} {21 22 23 24}}}
+} -body {
+    photo1 put $imgData
+    photo2 put $imgData -format default
+    set result {}
+    lappend result [list [image width photo1] [image height photo1]]
+    lappend result [list [image width photo2] [image height photo2]]
+    lappend result [string equal \
+        [photo1 data -format "default -colorformat argb"] \
+        [photo2 data -format "default -colorformat argb"]]
+    set result
+} -cleanup {
     imageCleanup
+    unset result
+    unset imgData
+} -result {{3 2} {3 2} 1}
+test imgPhoto-4.97 {ImgPhotoCmd put: image size} -setup {
     image create photo photo1
 } -body {
-    # no -to option, image size is data size
     photo1 put {{red green blue} {blue red green}}
     list [image width photo1] [image height photo1]
 } -cleanup {
     imageCleanup
 } -result {3 2}
-test imgPhoto-4.93 {ImgPhotoCmd procedure: put option} -setup {
-    imageCleanup
+test imgPhoto-4.98 {ImgPhotoCmd put: -to with 2 coords} -setup {
     image create photo photo1
 } -body {
-    # two coordinates for -to option
     photo1 put {{"alice blue" "blanched almond"}
 		{"deep sky blue" "ghost white"}
 		{#AABBCC #AABBCCDD}} -to 5 6
@@ -1033,14 +1202,12 @@ test imgPhoto-4.93 {ImgPhotoCmd procedure: put option} -setup {
 } -cleanup {
     imageCleanup
 } -result {7 9}
-test imgPhoto-4.94 {ImgPhotoCmd procedure: put option} -setup {
-    imageCleanup
+test imgPhoto-4.99 {ImgPhotoCmd put: -to with 4 coords} -setup {
     image create photo photo1
 } -body {
-    # 4 coordinates for -to option, data gets tiled
     photo1 put {{#123 #456 #678} {#9AB #CDE #F01}} -to 1 2 20 21
     set result {}
-    lappend result [photo1 get 19 20]
+    lappend result [photo1 get 19 20 -withalpha]
     lappend result [string equal \
 	[photo1 data -from 1 2 4 4] [photo1 data -from 4 2 7 4]]
     lappend result [string equal \
@@ -1049,11 +1216,9 @@ test imgPhoto-4.94 {ImgPhotoCmd procedure: put option} -setup {
 } -cleanup {
     imageCleanup
 } -result {{17 34 51 255} 1 1}
-test imgPhoto-4.95 {ImgPhotoCmd procedure: put option} -setup {
-    imageCleanup
+test imgPhoto-4.100 {ImgPhotoCmd put: no changes on empty data} -setup {
     image create photo photo1
 } -body {
-    # empty data does not cause changes
     photo1 put {{brown blue} {cyan coral}}
     set imgData [photo1 data]
     photo1 put {}
@@ -1061,7 +1226,170 @@ test imgPhoto-4.95 {ImgPhotoCmd procedure: put option} -setup {
 } -cleanup {
     imageCleanup
 } -result {1}
-    
+test imgPhoto-4.101 {ImgPhotoCmd get: too many args} -setup {
+    image create photo photo1
+} -body {
+    photo1 get 0 0 -withalpha bogus
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result \
+    {wrong # args: should be "photo1 get x y ?-withalpha?"}
+test imgPhoto-4.102 {ImgPhotoCmd get: invalid option} -setup {
+    image create photo photo1
+} -body {
+    photo1 get 0 0 -bogus
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result \
+    {unrecognized option "-bogus": must be -withalpha}
+test imgPhoto-4.103 {ImgPhotoCmd data: accepted opts} -setup {
+    image create photo photo1 -data black
+} -body {
+    photo1 data -format default -from 0 0 -grayscale -background blue
+} -cleanup {
+    imageCleanup
+} -result {{#000000}}
+test imgPhoto-4.104 {ImgPhotoCmd data: existing but not accepted opt} -setup {
+    image create photo photo1
+} -body {
+    photo1 data -to
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result \
+{unrecognized option "-to": must be -background, -format, -from, or -grayscale}
+test imgPhoto-4.105 {ImgPhotoCmd data: invalid option} -setup {
+    image create photo photo1
+} -body {
+    photo1 data -bogus
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result \
+{unrecognized option "-bogus": must be -background, -format, -from, or -grayscale}
+test imgPhoto-4.106 {ImgPhotoCmd data: extra arg before options} -setup {
+    image create photo photo1 
+} -body {
+    photo1 data bogus -grayscale
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result \
+    {wrong # args: should be "photo1 data ?-option value ...?"}
+test imgPhoto-4.107 {ImgPhotoCmd data: extra arg after options} -setup {
+    image create photo photo1
+} -body {
+    photo1 data -format default bogus
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result \
+    {wrong # args: should be "photo1 data ?-option value ...?"}
+test imgPhoto-4.108 {ImgPhotoCmd data: invalid -from coords #1} -setup {
+    image create photo photo1 -data blue
+} -body {
+    photo1 data -from 2 0
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result \
+    {coordinates for -from option extend outside image}
+test imgPhoto-4.109 {ImgPhotoCmd data: invalid -from coords #2} -setup {
+    image create photo photo1 -data blue
+} -body {
+    photo1 data -from 0 2
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result \
+    {coordinates for -from option extend outside image}
+test imgPhoto-4.110 {ImgPhotoCmd data: invalid -from coords #3} -setup {
+    image create photo photo1 -data blue
+} -body {
+    photo1 data -from 0 0 2 1
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result \
+    {coordinates for -from option extend outside image}
+test imgPhoto-4.111 {ImgPhotoCmd data: invalid -from coords #4} -setup {
+    image create photo photo1 -data blue
+} -body {
+    photo1 data -from 0 0 1 2
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result \
+    {coordinates for -from option extend outside image}
+test imgPhoto-4.112 {ImgPhotoCmd data: -from with 2 coords} -setup {
+    image create photo photo1 -data {
+        {black black black black black}
+        {white white white white white}
+        {green green green green green}}
+} -body {
+    set imgData [photo1 data -from 2 1]
+    list [llength [lindex $imgData 0]] [llength $imgData]
+} -cleanup {
+    imageCleanup
+    unset imgData
+} -result {3 2}
+test imgPhoto-4.113 {ImgPhotoCmd data: default is rgb format} -setup {
+    image create photo photo1 -data red
+} -body {
+    photo1 data
+} -cleanup {
+    imageCleanup
+} -result {{#ff0000}}
+test imgPhoto-4.114 {ImgPhotoCmd data: unknown format} -setup {
+    image create photo photo1
+} -body {
+    photo1 data -format bogus
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result {image string format "bogus" is unknown}
+test imgPhoto-4.115 {ImgPhotoCmd data: rgb colorformat} -setup {
+    image create photo photo1 -data {{red#a green#b} {blue#c white}}
+} -body {
+    photo1 data -format {default -colorformat rgb}
+} -result {{#ff0000 #008000} {#0000ff #ffffff}}
+test imgPhoto-4.116 {ImgPhotoCmd data: argb colorformat} -setup {
+    image create photo photo1 -data {{red green} {blue white}}
+} -body {
+    photo1 data -format {default -colorformat argb}
+} -result {{#ffff0000 #ff008000} {#ff0000ff #ffffffff}}
+test imgPhoto-4.117 {ImgPhotoCmd data: list colorformat} -setup {
+    image create photo photo1 -data {{red#a green} {blue#c white#d}}
+} -body {
+    photo1 data -format {default -colorformat list}
+} -result {{{255 0 0 170} {0 128 0 255}} {{0 0 255 204} {255 255 255 221}}}
+test imgPhoto-4.118 {ImgPhotoCmd data: using data for new image 
+    results in same image as orignial } -constraints {
+        hasTeapotPhoto
+        hasTranspTeapotPhoto
+} -setup {
+    image create photo teapot -file $teapotPhotoFile
+    teapot copy teapot -from 50 60 70 80 -shrink
+    image create photo teapotTransp -file $transpTeapotPhotoFile
+    teapotTransp copy teapotTransp -from 100 110 120 130 -shrink
+    image create photo photo1
+} -body {
+    set result {}
+    # We don't test gif here, as there seems to be a problem with 
+    # <imgName> data and gif format ("too many colors", probably a bug)
+    foreach fmt {ppm png {default -colorformat argb} \
+            {default -colorformat list}} {
+        set imgData [teapotTransp data -format $fmt]
+        photo1 blank
+        photo1 put $imgData
+        if { ! [string equal [photo1 data] [teapotTransp data]]} {
+            lappend result $fmt
+        }
+    }
+    set imgData [teapot data -format default]
+    photo1 blank
+    photo1 put $imgData
+    if { ! [string equal [photo1 data] [teapot data]]} {
+        lappend result default
+    }
+    set result
+} -cleanup {
+    unset imgData
+    unset result
+    imageCleanup
+} -result {}
+
 test imgPhoto-5.1 {ImgPhotoGet/Free procedures, shared instances} -constraints {
     hasTeapotPhoto
 } -setup {
@@ -1084,7 +1412,7 @@ test imgPhoto-5.1 {ImgPhotoGet/Free procedures, shared instances} -constraints {
 } -cleanup {
     destroy .c
 } -result {}
-
+
 test imgPhoto-6.1 {ImgPhotoDisplay procedure, blank display} -setup {
     destroy .c
     pack [canvas .c]
@@ -1098,7 +1426,7 @@ test imgPhoto-6.1 {ImgPhotoDisplay procedure, blank display} -setup {
     destroy .c
     image delete photo1
 } -result {}
-
+
 test imgPhoto-7.1 {ImgPhotoFree procedure, resource freeing} -constraints {
     hasTeapotPhoto
 } -setup {
@@ -1159,7 +1487,7 @@ test imgPhoto-7.3 {ImgPhotoFree procedures, multiple visuals} -constraints {
     destroy .f
     image delete photo1
 } -result {}
-
+
 test imgPhoto-8.1 {ImgPhotoDelete procedure} -constraints hasTeapotPhoto -body {
     image create photo photo2 -file $teapotPhotoFile
     image delete photo2
@@ -1183,7 +1511,7 @@ test imgPhoto-8.3 {ImgPhotoDelete procedure, name cleanup} -body {
 } -returnCodes error -cleanup {
     imageCleanup
 } -result {image "photo2" doesn't exist or is not a photo image}
-
+
 test imgPhoto-9.1 {ImgPhotoCmdDeletedProc procedure} -constraints {
     hasTeapotPhoto
 } -body {
@@ -1191,7 +1519,7 @@ test imgPhoto-9.1 {ImgPhotoCmdDeletedProc procedure} -constraints {
     rename photo2 {}
     list [lsearch -exact [imageNames] photo2] [catch {photo2 foo} msg] $msg
 } -result {-1 1 {invalid command name "photo2"}}
-
+
 test imgPhoto-10.1 {Tk_ImgPhotoPutBlock procedure} -setup {
     imageCleanup
 } -body {
@@ -1199,8 +1527,8 @@ test imgPhoto-10.1 {Tk_ImgPhotoPutBlock procedure} -setup {
     photo1 put "{#ff0000 #ff0000 #ff0000 #ff0000 #ff0000 #ff0000 #ff0000 #ff0000}" -to 0 0
     photo1 put "{#00ff00 #00ff00}" -to 2 0
     list [photo1 get 2 0] [photo1 get 3 0] [photo1 get 4 0]
-} -result {{0 255 0 255} {0 255 0 255} {255 0 0 255}}
-
+} -result {{0 255 0} {0 255 0} {255 0 0}}
+
 test imgPhoto-11.1 {Tk_FindPhoto} -setup {
     imageCleanup
 } -body {
@@ -1210,7 +1538,7 @@ test imgPhoto-11.1 {Tk_FindPhoto} -setup {
 } -cleanup {
     imageCleanup
 } -returnCodes error -result {image "i1" doesn't exist or is not a photo image}
-
+
 test imgPhoto-12.1 {Tk_PhotoPutZoomedBlock} -constraints hasTeapotPhoto -body {
     image create photo p3 -file $teapotPhotoFile
     set result [list [p3 get 50 50] [p3 get 100 100]]
@@ -1218,8 +1546,8 @@ test imgPhoto-12.1 {Tk_PhotoPutZoomedBlock} -constraints hasTeapotPhoto -body {
     lappend result [image width p3] [image height p3] [p3 get 100 100]
 } -cleanup {
     image delete p3
-} -result {{19 92 192 255} {169 117 90 255} 512 512 {19 92 192 255}}
-
+} -result {{19 92 192} {169 117 90} 512 512 {19 92 192}}
+
 test imgPhoto-13.1 {check separation of images in different interpreters} -setup {
     imageCleanup
     set data {
@@ -1264,7 +1592,7 @@ test imgPhoto-13.1 {check separation of images in different interpreters} -setup
     interp delete x1
     interp delete x2
 } -result T1_data
-
+
 test imgPhoto-14.1 {GIF writes work correctly} -setup {
     set data {
 	R0lGODlhYwA5APcAAAAAAIAAAACAAICAAAAAgIAAgACAgICAgAysnGy8hKzM
@@ -1357,7 +1685,7 @@ test imgPhoto-14.4 {GIF buffer overflow} -setup {
 } -cleanup {
     image delete $i
 } -returnCodes error -result {malformed image}
-
+
 test imgPhoto-15.1 {photo images can fail to allocate memory gracefully} -constraints {
     nonPortable
 } -body {
@@ -1365,7 +1693,7 @@ test imgPhoto-15.1 {photo images can fail to allocate memory gracefully} -constr
     # free memory available...
     image create photo -width 32000 -height 32000
 } -returnCodes error -result {not enough free memory for image buffer}
-
+
 test imgPhoto-16.1 {copying to self doesn't access freed memory} -setup {
     set i [image create photo]
 } -body {
@@ -1376,7 +1704,7 @@ test imgPhoto-16.1 {copying to self doesn't access freed memory} -setup {
 } -cleanup {
     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]
@@ -1415,364 +1743,110 @@ test imgPhoto-17.3 {photo write: format guessing from filename} -setup {
     image delete $i
     catch {removeFile $f}
 } -result "P6\n"
-
-test imgPhoto-18.1 {ImgStringMatch: data is not a list} -setup {
-    imageCleanup
-    image create photo photo1
+test imgPhoto-17.4 {photo write: default format not supported} -setup {
+    image create photo photo1 -data {{blue blue} {red red} {green green}}
+    set f [makeFile {} test.txt]
 } -body {
-    photo1 put {not a " proper list}
-    # " (this comment is here only for editor highlighting)
+    photo1 write $f -format default
 } -cleanup {
     imageCleanup
-} -returnCodes error -result {unmatched open quote in list}
-# empty data case tested with imgPhoto-4.95
-test imgPhoto-18.2 {ImgStringMatch: list element not a proper list} -setup {
-    imageCleanup
-    image create photo photo1
+    catch {removeFile $f}
+    unset f
+} -returnCodes error -result \
+    {image file format "default" has no file writing capability}
+test imgPhoto-17.5 {photo write: file with extension .default} -setup {
+    image create photo photo1 -data {{black}}
+    set f [makeFile {} test.default]
 } -body {
-    photo1 put {{red white} {not "} {blue green}}
-    # "
+    photo1 write $f
 } -cleanup {
-    imageCleanup 
-} -returnCodes error -result {unmatched open quote in list} 
-test imgPhoto-18.3 {ImgStringMatch: sublists with differen lengths} -setup {
     imageCleanup
+    catch {removeFile $f}
+    unset f
+} -returnCodes error -result \
+    {image file format "default" has no file writing capability}
+
+test imgPhoto-18.1 {MatchFileFormat: "default" format not supported} -setup {
     image create photo photo1
+    set f [makeFile {} test.txt]
 } -body {
-    photo1 put {{#001122 #334455 #667788} 
-		{#99AABB #CCDDEE} 
-		{#FF0011 #223344 #556677}}
+    photo1 read $f -format default
 } -cleanup {
     imageCleanup
-} -returnCodes error -result \
-    {invalid row # 1: all rows must have the same number of elements}
-test imgPhoto-18.4 {ImgStringMatch: valid data} -setup {
-    imageCleanup
+    catch {removeFile $f}
+    unset f
+} -returnCodes error -result {-file option isn't supported for default images}
+
+test imgPhoto-19.1 {MatchStringFormat: with "-format default"} -setup {
     image create photo photo1
 } -body {
-    photo1 put {{blue green}
-		{yellow magenta} 
-		{#000000 #FFFFFFFF}}
-    list [image width photo1] [image height photo1] [photo1 get 0 2]
+    photo1 put {{red blue red} {yellow green yellow}} -format default
+    list [image width photo1] [image height photo1]
 } -cleanup {
     imageCleanup
-} -result {2 3 {0 0 0 255}}
-# ImgStringRead: most of the error cases cannot be tested with current code, 
-# as the errors are detected by ImgStringMatch
-test imgPhoto-19.1 {ImgStringRead: normal use case} -constraints {
-    hasTeapotPhoto
-} -setup {
-    imageCleanup
-    image create photo photo1 -file $teapotPhotoFile
-    image create photo photo2
-} -body {
-    set imgData [photo1 data]
-    photo2 put $imgData
-    string equal [photo1 data] [photo2 data]
+} -result {3 2}
+test imgPhoto-19.2 {MatchStringFormat: without -format option,
+        default fmt} -body {
+    image create photo photo1 
+    photo1 put {{red} {green}}
+    list [image width photo1] [image height photo1]
 } -cleanup {
     imageCleanup
-    unset imgData
-} -result {1}
-test imgPhoto-19.2 {ImgStringRead: correct compositing rule} -constraints {
-    hasTranspTeapotPhoto
-} -setup {
-    imageCleanup
-    image create photo photo1 -file $transpTeapotPhotoFile
+} -result {1 2}
+test imgPhoto-19.3 {MatchStringFormat: "-format ppm"} -setup {
+    image create photo photo1
     image create photo photo2
+    photo2 put {cyan cyan}
+    set imgData [photo2 data -format ppm]
 } -body {
-    # currently, this test is pointless, as [imageName data] does not include 
-    # transparency information. To be considered as a placeholder.
-    photo2 put #FF0000 -to 0 0 50 50
-    photo2 put [photo1 data] -to 10 10 40 40
-    list [photo2 get 0 0] [photo2 get 20 25] [photo2 get 49 49]
+    photo1 put $imgData -format ppm
+    list [image width photo1] [image height photo1]
 } -cleanup {
+    unset imgData
     imageCleanup
-} -result {{255 0 0 255} {0 78 185 255} {255 0 0 255}}
-test imgPhoto-20.1 {ImgStringWrite: test some pixels} -constraints { 
+} -result {1 2}
+test imgPhoto-19.4 {MatchStringFormat: ppm fmt, without opt} -constraints {
     hasTeapotPhoto
 } -setup {
-    set result {}
-    imageCleanup
     image create photo photo1 -file $teapotPhotoFile
+    image create photo photo2 
 } -body {
-    set imgData [photo1 data]
-    # note: with [lindex], the coords are inverted (y x)
-    lappend result [lindex $imgData 3 2]
-    lappend result [lindex $imgData 107 53]
-    lappend result [lindex $imgData 203 157]
-    set result 
-} -cleanup {
-    unset result
-    unset imgData
-    imageCleanup
-} -result {{#135cc0} #a06d52 #e1c8ba}
-test imgPhoto-21.1 {ImgPhotoParseColor: valid suffixes} -setup {
-    imageCleanup
-    image create photo photo1 
-    set result {}
-} -body {
-    photo1 put {{blue@0.711 #114433#C} {#8D4#1A magenta}}
-    lappend result [photo1 get 0 0]
-    lappend result [photo1 get 1 0]
-    lappend result [photo1 get 0 1]
-    lappend result [photo1 get 1 1]
-    set result
-} -cleanup {
-    unset result
-    imageCleanup
-} -result {{0 0 255 181} {17 68 51 204} {136 221 68 26} {255 0 255 255}}
-test imgPhoto-21.2 {ImgPhotoParseColor: valid suffixes, no suffix} -setup {
-    imageCleanup
-    image create photo photo1
-    set result {}
-} -body {
-    photo1 put {{#52D8a0 #2B5} {#E47@0.01 maroon#4}}
-    lappend result [photo1 get 0 0]
-    lappend result [photo1 get 1 0]
-    lappend result [photo1 get 0 1]
-    lappend result [photo1 get 1 1]
-    set result
-} -cleanup {
-    unset result
-    imageCleanup
-} -result {{82 216 160 255} {34 187 85 255} {238 68 119 3} {128 0 0 68}}
-test imgPhoto-21.3 {ImgPhotoParseColor: # suffix, no hex digits} -setup {
-    imageCleanup
-    image create photo photo1
-} -body {
-    photo1 put {{black#}}
-} -cleanup {
-    imageCleanup
-} -returnCodes error -result {invalid alpha suffix "#"}
-test imgPhoto-21.4 {ImgPhotoParseColor: # suffix, too many digists} -setup {
-    imageCleanup
-    image create photo photo1
-} -body {
-    photo1 put {{#ABC#123}}
-} -cleanup {
-    imageCleanup
-} -returnCodes error -result \
-    {invalid alpha suffix "#123"}
-test imgPhoto-21.5 {ImgPhotoParseColor: wrong digit count for color} -setup {
-    imageCleanup
-    image create photo photo1
-} -body {
-    photo1 put {{#00}}
-} -returnCodes error -result {invalid color name "#00"}
-test imgPhoto-21.6 {ImgPhotoParseColor: invalid hex digit #1} -setup {
-    imageCleanup
-    image create photo photo1
-} -body {
-    photo1 put #ABCDEG@.99
-} -cleanup {
-    imageCleanup
-} -returnCodes error -result {invalid color name "#ABCDEG"}
-test imgPhoto-21.7 {ImgPhotoParseColor: invalid hex digit #2} -setup {
-    imageCleanup
-    image create photo photo1
-} -body {
-    photo1 put {#ABCZ}
-} -cleanup {
-    imageCleanup
-} -returnCodes error -result {invalid color name "#ABCZ"}
-test imgPhoto-21.8 {ImgPhotoParseColor: valid #ARGB color} -setup {
-    imageCleanup
-    image create photo photo1
-} -body {
-    photo1 put {{#0d9bd502 #F7ac}}
-    list [photo1 get 0 0] [photo1 get 1 0]
-} -cleanup {
-    imageCleanup
-} -result {{155 213 2 13} {119 170 204 255}}
-test imgPhoto-21.9 {ImgPhotoParseColor: empty string} -setup {
-    imageCleanup
-    image create photo photo1
-    set result {}
-} -body {
-    photo1 put {{"" ""} {"" ""}}
-    lappend result [image width photo1]
-    lappend result [image height photo1]
-    lappend result [photo1 get 1 1]
-    set result
-} -cleanup {
-    unset result
-    imageCleanup
-} -result {2 2 {0 0 0 0}}
-test imgPhoto-21.10 {ImgPhotoParsecolor: empty string, mixed} -setup {
-    imageCleanup
-    image create photo photo1
-} -body {
-    photo1 put {{black white} {{} white}}
-    list [photo1 get 0 0] [photo1 get 0 1]
-} -cleanup {
-    imageCleanup
-} -result {{0 0 0 255} {0 0 0 0}}
-test imgPhoto-21.9 {ImgPhotoParseColor: list form, invalid list} -setup {
-    imageCleanup
-    image create photo photo1
-} -body {
-    photo1 put {{{123 45 67 "}}}
-    # "
-} -cleanup {
-    imageCleanup
-} -returnCodes error -result {can't parse color "123 45 67 ""}
-test imgPhoto-21.10 {ImgPhotoParseColor: too few elements in list} -setup {
-    imageCleanup
-    image create photo photo1
-} -body {
-    photo1 put {{{0 255}}}
-} -cleanup {
-    imageCleanup
-} -returnCodes error -result {can't parse color "0 255"}
-test imgPhoto-21.11 {ImgPhotoParseColor: too many elements in list} -setup {
-    imageCleanup
-    image create photo photo1
-} -body {
-    photo1 put {{{0 100 200 255 0}}}
-} -returnCodes error -result {can't parse color "0 100 200 255 0"}
-test imgPhoto-21.12 {ImgPhotoParseColor: not an integer value} -setup {
-    imageCleanup
-    image create photo photo1
-} -body {
-    photo1 put {{{9 0xf3 87 65} {43 21 10 1.0}}}
-} -cleanup {
-    imageCleanup
-} -returnCodes error -result {expected integer but got "1.0"}
-test imgPhoto-21.13 {ImgPhotoParseColor: negative value in list} -setup {
-    imageCleanup
-    image create photo photo1
-} -body {
-    photo1 put {{{121 121 -1}}}
-} -cleanup {
-    imageCleanup
-} -returnCodes error -result \
-    {invalid color "121 121 -1": expected integers in the range from 0 to 255}
-test imgPhoto-21.14 {ImgPhotoParseColor: value in list too large} -setup {
-    imageCleanup
-    image create photo photo1
-} -body {
-    photo1 put {{{254 255 256}}}
-} -cleanup {
-    imageCleanup
-} -returnCodes error -result \
-   {invalid color "254 255 256": expected integers in the range from 0 to 255}
-test imgPhoto-21.15 {ImgPhotoParseColor: valid list form} -setup {
-    imageCleanup
-    image create photo photo1
-} -body {
-    photo1 put {{{0x0 0x10 0xfe 0xff} {0 100 254}}
-		{{30 30 30 0} {1 1 254 1}}}
-    list [photo1 get 0 0] [photo1 get 1 0] [photo1 get 0 1] [photo1 get 1 1]
-} -cleanup {
-    imageCleanup
-} -result {{0 16 254 255} {0 100 254 255} {30 30 30 0} {1 1 254 1}}
-test imgPhoto-21.16 {ImgPhotoParseColor: suffix not allowed #1} -setup {
-    imageCleanup
-    image create photo photo1
-} -body {
-    photo1 put #ABCD@0.5
-} -cleanup {
-    imageCleanup
-} -returnCodes error -result \
-    {invalid color "#ABCD@0.5": format does not allow alpha suffix}
-test imgPhoto-21.17 {ImgPhotoParseColor: suffix not allowed #2} -setup {
-    imageCleanup
-    image create photo photo1
-} -body {
-    photo1 put {{{100 100 100#FE}}}
-} -cleanup {
-    imageCleanup
-} -returnCodes error -result \
-    {invalid color "100 100 100#FE": format does not allow alpha suffix}
-test ImgPoto-21.18 {ImgPhotoParseColor: suffix not allowed #3} -setup {
-    imageCleanup
-    image create photo photo1
-} -body {
-    photo1 put #1111#1
-} -cleanup {
-    imageCleanup
-} -returnCodes error -result \
-    {invalid color "#1111#1": format does not allow alpha suffix}
-test imgPhoto-21.19 {ImgPhotoParseColor: @A, not a float} -setup {
-    imageCleanup
-    image create photo photo1
-} -body {
-    photo1 put blue@bogus
-} -cleanup {
-    imageCleanup
-} -returnCodes error -result \
-    {invalid alpha suffix "@bogus": expected floating-point value}
-test imgPhoto-21.20 {ImgPhotoParseColor: @A, value too low} -setup {
-    imageCleanup
-    image create photo photo1 
-} -body {
-    photo1 put green@-0.1
-} -cleanup {
-    imageCleanup
-} -returnCodes error -result \
-    {invalid alpha suffix "@-0.1": value must be in the range from 0 to 1}
-test imgPhoto-21.21 {ImgPhotoParseColor: @A, value too high} -setup {
-    imageCleanup
-    image create photo photo1
-} -body {
-    photo1 put #000000@1.0001
+    set imgData [photo1 data -format ppm]
+    photo2 put $imgData
+    list [image width photo2] [image height photo2]
 } -cleanup {
     imageCleanup
-} -returnCodes error -result \
-    {invalid alpha suffix "@1.0001": value must be in the range from 0 to 1}
-test imgPhoto-21.22 {ImgPhotoParseColor: @A, edge values} -setup {
-    imageCleanup
+    unset imgData
+} -result {256 256}
+test imgPhoto-19.5 {MatchStirngFormat: unknown -format} -setup {
     image create photo photo1
 } -body {
-    photo1 put {{yellow@1e-22 yellow@0.12352941 yellow@0.12352942 \
-		 yellow@0.9999999}}
-    list [photo1 get 0 0] [photo1 get 1 0] [photo1 get 2 0] [photo1 get 3 0]
+    photo1 put {} -format bogus
 } -cleanup {
     imageCleanup
-} -result {{255 255 0 0} {255 255 0 31} {255 255 0 32} {255 255 0 255}}
-test imgPhoto-21.23 {ImgPhotoParseColor: invalid digit in #X suffix} -setup {
-    imageCleanup
+} -returnCodes error -result {image format "bogus" is not supported}
+test imgPhoto-19.6 {MatchStringFormat: invalid data for default} -setup {
     image create photo photo1
 } -body {
-    photo1 put #000#g
+    photo1 put bogus
 } -cleanup {
     imageCleanup
-} -returnCodes error -result {invalid alpha suffix "#g": expected hex digit}
-test imgPhoto-21.24 {ImgPhotoParseColor: invalid digit in #XX suffix} -setup {
-    imageCleanup
+} -returnCodes error -result {couldn't recognize image data}
+test imgPhoto-19.7 {MatchStringFormat: invalid data for default} -setup {
     image create photo photo1
 } -body {
-    photo1 put green#2W
+    photo1 put bogus -format dEFault
 } -cleanup {
     imageCleanup
-} -returnCodes error -result {invalid alpha suffix "#2W": expected hex digit}
-test imgPhoto-21.25 {ImgPhotoParseColor: overall test - all color / suffix 
-	combinations} -setup {
-    imageCleanup
+} -returnCodes error -result {couldn't recognize image data}
+test imgPhoto-19.8 {MatchStirngFormat: invalid data for gif} -setup {
     image create photo photo1
-    set result {}
 } -body {
-    photo1 put {
-	{snow@0.5 snow#80 snow#8 #fffffafafafa@0.5 #fffffabbfacc#8}
-	{#fffffafffaff#80 #ffffaafaa@.5 #ffffaafaa#8 #ffffaafaa#80 #fee#8}
-	{#fee#80 #fee@0.5 #fffafa@0.5 #fffafa#8 #fffafa#80}
-	{{0xff 250 0xfa 128} {255 250 250} #8fee #80fffafa snow}}
-    for {set y 0} {$y < 4} {incr y} {
-	for {set x 0} {$x < 5} {incr x} {
-	    lappend result [photo1 get $x $y]
-	}
-    }
-    set result
+    photo1 put bogus -format giF
 } -cleanup {
     imageCleanup
-    unset result
-} -result \
-{{255 250 250 128} {255 250 250 128} {255 250 250 136} {255 250 250 128}\
-{255 250 250 136} {255 250 250 128} {255 250 250 128} {255 250 250 136}\
-{255 250 250 128} {255 238 238 136} {255 238 238 128} {255 238 238 128}\
-{255 250 250 128} {255 250 250 136} {255 250 250 128} {255 250 250 128}\
-{255 250 250 255} {255 238 238 136} {255 250 250 128} {255 250 250 255}}
-    
+} -returnCodes error -result {couldn't recognize image data}
+
 # ----------------------------------------------------------------------
 
 catch {rename foreachPixel {}}
diff --git a/unix/Makefile.in b/unix/Makefile.in
index 1b8677e..db6cc2c 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -356,7 +356,7 @@ CANV_OBJS = tkCanvas.o tkCanvArc.o tkCanvBmap.o tkCanvImg.o \
 	tkCanvUtil.o tkCanvWind.o tkRectOval.o tkTrig.o
 
 IMAGE_OBJS = tkImage.o tkImgBmap.o tkImgGIF.o tkImgPNG.o tkImgPPM.o \
-	tkImgPhoto.o tkImgPhInstance.o
+	tkImgPhoto.o tkImgPhInstance.o tkImgListFormat.o
 
 TEXT_OBJS = tkText.o tkTextBTree.o tkTextDisp.o tkTextImage.o tkTextIndex.o \
 	tkTextMark.o tkTextTag.o tkTextWind.o
@@ -450,7 +450,7 @@ GENERIC_SRCS = \
 	$(GENERIC_DIR)/tkImgBmap.c $(GENERIC_DIR)/tkImgGIF.c \
 	$(GENERIC_DIR)/tkImgPNG.c $(GENERIC_DIR)/tkImgPPM.c \
 	$(GENERIC_DIR)/tkImgPhoto.c $(GENERIC_DIR)/tkImgPhInstance.c \
-	$(GENERIC_DIR)/tkText.c \
+	$(GENERIC_DIR)/tkImgListFormat.c $(GENERIC_DIR)/tkText.c \
 	$(GENERIC_DIR)/tkTextBTree.c $(GENERIC_DIR)/tkTextDisp.c \
 	$(GENERIC_DIR)/tkTextImage.c \
 	$(GENERIC_DIR)/tkTextIndex.c $(GENERIC_DIR)/tkTextMark.c \
@@ -1105,6 +1105,9 @@ tkImage.o: $(GENERIC_DIR)/tkImage.c
 tkImgBmap.o: $(GENERIC_DIR)/tkImgBmap.c
 	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkImgBmap.c
 
+tkImgListFormat.o: $(GENERIC_DIR)/tkImgListFormat.c
+	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkImgListFormat.c
+
 tkImgGIF.o: $(GENERIC_DIR)/tkImgGIF.c
 	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkImgGIF.c
 
diff --git a/win/Makefile.in b/win/Makefile.in
index 80d616b..3c1c9e3 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -317,6 +317,7 @@ TK_OBJS = \
 	tkGrid.$(OBJEXT) \
 	tkImage.$(OBJEXT) \
 	tkImgBmap.$(OBJEXT) \
+	tkImgListFormat.$(OBJEXT) \
 	tkImgGIF.$(OBJEXT) \
 	tkImgPNG.$(OBJEXT) \
 	tkImgPPM.$(OBJEXT) \
diff --git a/win/makefile.vc b/win/makefile.vc
index c8c42a2..e60593b 100644
--- a/win/makefile.vc
+++ b/win/makefile.vc
@@ -325,6 +325,7 @@ TKOBJS = \
 	$(TMP_DIR)\tkGrid.obj \

 	$(TMP_DIR)\tkImage.obj \

 	$(TMP_DIR)\tkImgBmap.obj \

+	$(TMP_DIR)\tkImgListFormat.obj \

 	$(TMP_DIR)\tkImgGIF.obj \

 	$(TMP_DIR)\tkImgPNG.obj \

 	$(TMP_DIR)\tkImgPPM.obj \