Index: generic/tk.decls
==================================================================
--- generic/tk.decls
+++ generic/tk.decls
@@ -1000,10 +1000,15 @@
 # TIP #264
 declare 271 {
     Tcl_Interp *Tk_Interp(Tk_Window tkwin)
 }
 
+# TIP #714
+declare 273 {
+    int Tk_SetTypeInfoProc(Tk_ImageType *typePtr,
+	    Tk_ImageInfoProc *typeInfo)
+}
 
 # ----- BASELINE -- FOR -- 8.6.0 ----- #
 
 
 # TIP#580

Index: generic/tk.h
==================================================================
--- generic/tk.h
+++ generic/tk.h
@@ -1217,10 +1217,11 @@
 typedef void (Tk_ImageChangedProc) (void *clientData, int x, int y,
 	int width, int height, int imageWidth, int imageHeight);
 typedef int (Tk_ImagePostscriptProc) (void *clientData,
 	Tcl_Interp *interp, Tk_Window tkwin, Tk_PostscriptInfo psinfo,
 	int x, int y, int width, int height, int prepass);
+typedef int (Tk_ImageInfoProc) (Tcl_Interp *interp);
 
 /*
  * The following structure represents a particular type of image (bitmap, xpm
  * image, etc.). It provides information common to all images of that type,
  * such as the type name and a collection of procedures in the image manager

Index: generic/tkDecls.h
==================================================================
--- generic/tkDecls.h
+++ generic/tkDecls.h
@@ -837,11 +837,13 @@
 /* 270 */
 EXTERN void		Tk_ResetUserInactiveTime(Display *dpy);
 /* 271 */
 EXTERN Tcl_Interp *	Tk_Interp(Tk_Window tkwin);
 /* Slot 272 is reserved */
-/* Slot 273 is reserved */
+/* 273 */
+EXTERN int		Tk_SetTypeInfoProc(Tk_ImageType *typePtr,
+				Tk_ImageInfoProc *typeInfo);
 /* 274 */
 EXTERN int		Tk_AlwaysShowSelection(Tk_Window tkwin);
 /* 275 */
 EXTERN unsigned		Tk_GetButtonMask(unsigned button);
 /* 276 */
@@ -1189,11 +1191,11 @@
     int (*tk_PhotoSetSize) (Tcl_Interp *interp, Tk_PhotoHandle handle, int width, int height); /* 268 */
     long (*tk_GetUserInactiveTime) (Display *dpy); /* 269 */
     void (*tk_ResetUserInactiveTime) (Display *dpy); /* 270 */
     Tcl_Interp * (*tk_Interp) (Tk_Window tkwin); /* 271 */
     void (*reserved272)(void);
-    void (*reserved273)(void);
+    int (*tk_SetTypeInfoProc) (Tk_ImageType *typePtr, Tk_ImageInfoProc *typeInfo); /* 273 */
     int (*tk_AlwaysShowSelection) (Tk_Window tkwin); /* 274 */
     unsigned (*tk_GetButtonMask) (unsigned button); /* 275 */
     int (*tk_GetDoublePixelsFromObj) (Tcl_Interp *interp, Tk_Window tkwin, Tcl_Obj *objPtr, double *doublePtr); /* 276 */
     Tcl_Obj * (*tk_NewWindowObj) (Tk_Window tkwin); /* 277 */
     void (*tk_SendVirtualEvent) (Tk_Window tkwin, const char *eventName, Tcl_Obj *detail); /* 278 */
@@ -1755,11 +1757,12 @@
 #define Tk_ResetUserInactiveTime \
 	(tkStubsPtr->tk_ResetUserInactiveTime) /* 270 */
 #define Tk_Interp \
 	(tkStubsPtr->tk_Interp) /* 271 */
 /* Slot 272 is reserved */
-/* Slot 273 is reserved */
+#define Tk_SetTypeInfoProc \
+	(tkStubsPtr->tk_SetTypeInfoProc) /* 273 */
 #define Tk_AlwaysShowSelection \
 	(tkStubsPtr->tk_AlwaysShowSelection) /* 274 */
 #define Tk_GetButtonMask \
 	(tkStubsPtr->tk_GetButtonMask) /* 275 */
 #define Tk_GetDoublePixelsFromObj \
@@ -1824,7 +1827,13 @@
 
 #undef TCL_STORAGE_CLASS
 #define TCL_STORAGE_CLASS DLLIMPORT
 
 #undef TkUnusedStubEntry
+
+#if defined(USE_TK_STUBS)
+#   undef Tk_SetTypeInfoProc
+#   define Tk_SetTypeInfoProc(t,i) \
+	if (!tkStubsPtr->tk_SetTypeInfoProc) {/* NOP */} else tkStubsPtr->tk_SetTypeInfoProc(t,i)
+#endif
 
 #endif /* _TKDECLS */

Index: generic/tkImage.c
==================================================================
--- generic/tkImage.c
+++ generic/tkImage.c
@@ -75,10 +75,11 @@
 typedef struct {
     Tk_ImageType *imageTypeList;/* First in a list of all known image
 				 * types. */
     int initialized;		/* Set to 1 if we've initialized the
 				 * structure. */
+    Tcl_HashTable *infoCmdTable;
 } ThreadSpecificData;
 static Tcl_ThreadDataKey dataKey;
 
 /*
  * Prototypes for local functions:
@@ -116,10 +117,35 @@
     while (tsdPtr->imageTypeList != NULL) {
 	freePtr = tsdPtr->imageTypeList;
 	tsdPtr->imageTypeList = tsdPtr->imageTypeList->nextPtr;
 	ckfree(freePtr);
     }
+    /* Cleanup the infoCmdTable hash table */
+    Tcl_HashEntry *entryPtr;
+    Tcl_HashSearch search;
+    for (entryPtr = Tcl_FirstHashEntry(tsdPtr->infoCmdTable, &search);
+	    entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&search)) {
+	Tcl_DeleteHashEntry(entryPtr);
+    }
+    Tcl_DeleteHashTable(tsdPtr->infoCmdTable);
+    ckfree(tsdPtr->infoCmdTable);
+}
+
+int Tk_SetTypeInfoProc(
+    Tk_ImageType *typePtr,
+    Tk_ImageInfoProc *infoProc)
+{
+    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+	    Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+    Tcl_HashEntry *entryPtr;
+    int isNew;
+
+    entryPtr = Tcl_CreateHashEntry(tsdPtr->infoCmdTable, typePtr->name, &isNew);
+    if (isNew) {
+	Tcl_SetHashValue(entryPtr, infoProc);
+    } /* else? */
+    return TCL_OK;
 }
 
 /*
  *----------------------------------------------------------------------
  *
@@ -151,10 +177,12 @@
 	    Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
 
     if (!tsdPtr->initialized) {
 	tsdPtr->initialized = 1;
 	Tcl_CreateThreadExitHandler(ImageTypeThreadExitProc, NULL);
+	tsdPtr->infoCmdTable = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
+	Tcl_InitHashTable(tsdPtr->infoCmdTable, TCL_STRING_KEYS);
     }
     copyPtr = (Tk_ImageType *)ckalloc(sizeof(Tk_ImageType));
     *copyPtr = *typePtr;
     copyPtr->nextPtr = tsdPtr->imageTypeList;
     tsdPtr->imageTypeList = copyPtr;
@@ -375,21 +403,32 @@
 		    (const char *)Tcl_GetHashKey(&winPtr->mainPtr->imageTable, hPtr), TCL_INDEX_NONE));
 	}
 	Tcl_SetObjResult(interp, resultObj);
 	break;
     case IMAGE_TYPES:
-	if (objc != 2) {
-	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
+	if (objc != 2 && objc != 3) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "?type?");
 	    return TCL_ERROR;
 	}
+if (objc == 2) {
 	resultObj = Tcl_NewObj();
 	for (typePtr = tsdPtr->imageTypeList; typePtr != NULL;
 		typePtr = typePtr->nextPtr) {
 	    Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj(
 		    typePtr->name, TCL_INDEX_NONE));
 	}
 	Tcl_SetObjResult(interp, resultObj);
+} else {
+	Tk_ImageInfoProc *proc;
+	Tcl_HashEntry *entryPtr;
+
+	entryPtr = Tcl_FindHashEntry(tsdPtr->infoCmdTable, Tcl_GetString(objv[2]));
+	if (entryPtr) {
+	    proc = (Tk_ImageInfoProc *) Tcl_GetHashValue(entryPtr);
+	    proc(interp);
+	}
+}
 	break;
 
     case IMAGE_HEIGHT:
     case IMAGE_INUSE:
     case IMAGE_TYPE:

Index: generic/tkImgPhoto.c
==================================================================
--- generic/tkImgPhoto.c
+++ generic/tkImgPhoto.c
@@ -4375,10 +4375,109 @@
     Tk_PhotoGetImage(clientData, &block);
     block.pixelPtr += y * block.pitch + x * block.pixelSize;
 
     return Tk_PostscriptPhoto(interp, &block, psInfo, width, height);
 }
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkPhotoInfoProc --
+ *
+ *	This function is called to return an information dict on
+ *	all photo images.
+ *	It is called by the command "image types photo".
+ *
+ * Results:
+ *	Returns a standard Tcl return value.
+ *
+ * Side effects:
+ *	None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkPhotoInfoProc(Tcl_Interp *interp) {
+
+    Tcl_Obj *resultObj, *formatValueObj, *fileValueObj, *writeValueObj;
+    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+	    Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+    Tk_PhotoImageFormat *formatPtr;
+    Tk_PhotoImageFormatVersion3 *formatVersion3Ptr;
+    const char * defaultFormatName = NULL;
+
+    formatValueObj = Tcl_NewListObj(0, NULL);
+    fileValueObj = Tcl_NewListObj(0, NULL);
+    writeValueObj = Tcl_NewListObj(0, NULL);
+
+    /*
+     * Scan through the table of file format handlers and collect the
+     * data.
+     */
+
+    for (formatPtr = tsdPtr->formatList; formatPtr != NULL;
+	    formatPtr = formatPtr->nextPtr) {
+
+	/*
+	 * Default will be evaluated last, so put it at the end of the
+	 * evaluation list
+	 */
+
+	if (strncasecmp("default", formatPtr->name,
+		strlen(formatPtr->name)) == 0) {
+	    defaultFormatName = formatPtr->name;
+
+	    /*
+	     * The default format does not implement any file operations.
+	     * So no need to check for fileMatchProc or fileWriteProc
+	     */
+
+	} else {
+	    Tcl_Obj *formatNameObj = Tcl_NewStringObj(formatPtr->name,-1);
+	    Tcl_ListObjAppendElement(NULL, formatValueObj, formatNameObj);
+	    if (NULL != formatPtr->fileMatchProc) {
+		Tcl_ListObjAppendElement(NULL, fileValueObj, formatNameObj);
+	    }
+	    if (NULL != formatPtr->fileWriteProc) {
+		Tcl_ListObjAppendElement(NULL, writeValueObj, formatNameObj);
+	    }
+	}
+    }
+
+    for (formatVersion3Ptr = tsdPtr->formatListVersion3;
+	    formatVersion3Ptr != NULL;
+	    formatVersion3Ptr = formatVersion3Ptr->nextPtr) {
+	Tcl_Obj *formatNameObj = Tcl_NewStringObj(formatVersion3Ptr->name,-1);
+	Tcl_ListObjAppendElement(NULL, formatValueObj, formatNameObj);
+	if (NULL != formatVersion3Ptr->fileMatchProc) {
+	    Tcl_ListObjAppendElement(NULL, fileValueObj, formatNameObj);
+	}
+	if (NULL != formatVersion3Ptr->fileWriteProc) {
+	    Tcl_ListObjAppendElement(NULL, writeValueObj, formatNameObj);
+	}
+    }
+
+    if (NULL != defaultFormatName) {
+	Tcl_ListObjAppendElement(interp, formatValueObj,
+		Tcl_NewStringObj(defaultFormatName, -1));
+    }
+
+    /*
+     * set the format key in the result dictionary
+     */
+
+    resultObj = Tcl_NewObj();
+    Tcl_DictObjPut(NULL, resultObj, Tcl_NewStringObj("format", -1),
+	    formatValueObj);
+    Tcl_DictObjPut(NULL, resultObj, Tcl_NewStringObj("file", -1),
+	    fileValueObj);
+    Tcl_DictObjPut(NULL, resultObj, Tcl_NewStringObj("write", -1),
+	    writeValueObj);
+    Tcl_SetObjResult(interp, resultObj);
+    return TCL_OK;
+}
 
 /*
  * Local Variables:
  * mode: c
  * c-basic-offset: 4

Index: generic/tkInt.h
==================================================================
--- generic/tkInt.h
+++ generic/tkInt.h
@@ -1069,10 +1069,11 @@
 MODULE_SCOPE Tk_ImageType	tkPhotoImageType;
 MODULE_SCOPE Tcl_HashTable	tkPredefBitmapTable;
 
 MODULE_SCOPE const char *const tkWebColors[20];
 
+MODULE_SCOPE Tk_ImageInfoProc TkPhotoInfoProc;
 /*
  * The definition of pi, at least from the perspective of double-precision
  * floats.
  */
 

Index: generic/tkStubInit.c
==================================================================
--- generic/tkStubInit.c
+++ generic/tkStubInit.c
@@ -1222,11 +1222,11 @@
     Tk_PhotoSetSize, /* 268 */
     Tk_GetUserInactiveTime, /* 269 */
     Tk_ResetUserInactiveTime, /* 270 */
     Tk_Interp, /* 271 */
     0, /* 272 */
-    0, /* 273 */
+    Tk_SetTypeInfoProc, /* 273 */
     Tk_AlwaysShowSelection, /* 274 */
     Tk_GetButtonMask, /* 275 */
     Tk_GetDoublePixelsFromObj, /* 276 */
     Tk_NewWindowObj, /* 277 */
     Tk_SendVirtualEvent, /* 278 */

Index: generic/tkWindow.c
==================================================================
--- generic/tkWindow.c
+++ generic/tkWindow.c
@@ -341,10 +341,12 @@
 	 * Create built-in image types.
 	 */
 
 	Tk_CreateImageType(&tkBitmapImageType);
 	Tk_CreateImageType(&tkPhotoImageType);
+
+	Tk_SetTypeInfoProc(&tkPhotoImageType, TkPhotoInfoProc);
 
 	/*
 	 * Create built-in photo image formats.
 	 */
 

Index: tests/image.test
==================================================================
--- tests/image.test
+++ tests/image.test
@@ -285,15 +285,18 @@
 
 
 test image-6.1 {Tk_ImageCmd procedure, "types" option} -constraints {
     testImageType
 } -body {
-    image types x
-} -returnCodes error -result {wrong # args: should be "image types"}
+    image types x y
+} -returnCodes error -result {wrong # args: should be "image types ?type?"}
 test image-6.2 {Tk_ImageCmd procedure, "types" option} -body {
     lsort [image types]
 } -match glob -result {bitmap*photo test}
+test image-6.3 {Tk_ImageCmd procedure, "types" argument} -body {
+    image types x
+} -result {}
 
 
 test image-7.1 {Tk_ImageCmd procedure, "width" option} -body {
     image width
 } -returnCodes error -result {wrong # args: should be "image width name"}

Index: tests/imgPhoto.test
==================================================================
--- tests/imgPhoto.test
+++ tests/imgPhoto.test
@@ -2697,10 +2697,26 @@
     list $msg [image width png1] [image height png1]
 } -cleanup {
     catch {image delete png1}
 } -result {{coordinates for -from option extend outside source image} 0 0}
 unset ousterPhotoFile
+
+# test 26.x: ImgPhotoInfo, command "image types photo"
+
+test image-26.1 {ImgPhotoDriver/image types photo: format key} -body {
+    dict get [image types photo] format
+} -match glob -result {svg ppm png gif *default}
+# take into account, that the list of formats may extend
+# Any new format may be inserted between our own ones and the default format.
+
+test image-26.2 {ImgPhotoDriver/image types photo: format file} -body {
+    dict get [image types photo] file
+} -match glob -result {svg ppm png gif*}
+
+test image-26.3 {ImgPhotoDriver/image types photo: format write} -body {
+    dict get [image types photo] write
+} -match glob -result {ppm png gif*}
 
 catch {rename foreachPixel {}}
 catch {rename checkImgTrans {}}
 catch {rename checkImgTransLoop {}}
 imageFinish