Tk Source Code

Check-in [af5db475]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Corrected indents and formatting
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | tip-529-image-metadata
Files: files | file ages | folders
SHA3-256: af5db475e41e97177b6e20d005646e0a22b0643cb0396755c788784770815b90
User & Date: oehhar 2018-12-11 10:35:53
Context
2018-12-14
14:09
Implemented metadata output of gif comment - crashes test image-15.1 - megadata write with Tk_PhotoGetMetadata does not work, as the photo handle is not available within the write function. check-in: fa1a2028 user: oehhar tags: tip-529-image-metadata
2018-12-11
10:35
Corrected indents and formatting check-in: af5db475 user: oehhar tags: tip-529-image-metadata
10:21
TIP529 image metadata: create -metadata option check-in: b40491a5 user: oehhar tags: tip-529-image-metadata
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tkImgPhoto.c.

457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
...
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
...
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
...
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
...
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
....
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
....
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
....
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
....
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
	    if (masterPtr->dataString) {
		Tcl_SetObjResult(interp, masterPtr->dataString);
	    }
	} else if (strncmp(arg,"-format", length) == 0) {
	    if (masterPtr->format) {
		Tcl_SetObjResult(interp, masterPtr->format);
	    }
        } else if (strncmp(arg, "-metadata", length) == 0) {
            if (masterPtr->metadata) {
                Tcl_SetObjResult(interp, masterPtr->metadata);
            }
        } else {
	    Tk_ConfigureValue(interp, Tk_MainWindow(interp), configSpecs,
		    (char *) masterPtr, Tcl_GetString(objv[2]), 0);
	}
	return TCL_OK;
    }

    case PHOTO_CONFIGURE:
................................................................................
	    subobj = Tcl_NewStringObj("-format {} {} {}", 16);
	    if (masterPtr->format) {
		Tcl_ListObjAppendElement(NULL, subobj, masterPtr->format);
	    } else {
		Tcl_AppendStringsToObj(subobj, " {}", NULL);
	    }
	    Tcl_ListObjAppendElement(interp, obj, subobj);
            subobj = Tcl_NewStringObj("-metadata {} {} {}", 16);
            if (masterPtr->metadata) {
                Tcl_ListObjAppendElement(NULL, subobj, masterPtr->metadata);
            } else {
                Tcl_AppendStringsToObj(subobj, " {}", NULL);
            }
            Tcl_ListObjAppendElement(interp, obj, subobj);
            Tcl_ListObjAppendList(interp, obj, Tcl_GetObjResult(interp));
	    Tcl_SetObjResult(interp, obj);
	    return TCL_OK;

	} else if (objc == 3) {
	    const char *arg = TkGetStringFromObj(objv[2], &length);

	    if (length > 1 && !strncmp(arg, "-data", length)) {
................................................................................

		    Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp),
			    masterPtr->format);
		} else {
		    Tcl_AppendResult(interp, " {}", NULL);
		}
		return TCL_OK;
            } else if (length > 1 &&
                !strncmp(arg, "-metadata", length)) {
                Tcl_AppendResult(interp, "-metadata {} {} {}", NULL);
                if (masterPtr->metadata) {
                    /*
                    * TODO: Modifying result is bad!
                    */

                    Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp),
                        masterPtr->metadata);
                }
                else {
                    Tcl_AppendResult(interp, " {}", NULL);
                }
                return TCL_OK;
            } else {
		return Tk_ConfigureInfo(interp, Tk_MainWindow(interp),
			configSpecs, (char *) masterPtr, arg, 0);
	    }
	} else {
	    return ImgPhotoConfigureMaster(interp, masterPtr, objc-2, objv+2,
		    TK_CONFIG_ARGV_ONLY);
	}
................................................................................
	memset(&options, 0, sizeof(options));
	options.name = NULL;
	options.format = NULL;
	options.fromX = 0;
	options.fromY = 0;
	if (ParseSubcommandOptions(&options, interp,
		OPT_FORMAT | OPT_FROM | OPT_GRAYSCALE | OPT_BACKGROUND
                | OPT_METADATA,
		&index, objc, objv) != TCL_OK) {
	    return TCL_ERROR;
	}
	if ((options.name == NULL) || (index < objc)) {
	    Tcl_WrongNumArgs(interp, 2, objv, "?-option value ...?");
	    return TCL_ERROR;
	}
................................................................................
	 */

	index = 2;
	memset(&options, 0, sizeof(options));
	options.name = NULL;
	options.format = NULL;
	if (ParseSubcommandOptions(&options, interp,
                OPT_TO|OPT_FORMAT|OPT_METADATA,
		&index, objc, objv) != TCL_OK) {
	    return TCL_ERROR;
	}
	if ((options.name == NULL) || (index < objc)) {
	    Tcl_WrongNumArgs(interp, 2, objv, "data ?-option value ...?");
	    return TCL_ERROR;
	}
................................................................................

	index = 2;
	memset(&options, 0, sizeof(options));
	options.name = NULL;
	options.format = NULL;
	if (ParseSubcommandOptions(&options, interp,
		OPT_FORMAT | OPT_FROM | OPT_GRAYSCALE | OPT_BACKGROUND
                | OPT_METADATA,
		&index, objc, objv) != TCL_OK) {
	    return TCL_ERROR;
	}
	if ((options.name == NULL) || (index < objc)) {
	    Tcl_WrongNumArgs(interp, 2, objv, "fileName ?-option value ...?");
	    return TCL_ERROR;
	}
................................................................................
	     */

	    if (index + 1 >= objc) {
		goto oneValueRequired;
	    }
	    *optIndexPtr = ++index;
	    optPtr->format = objv[index];
        } else if (bit == OPT_METADATA) {
            /*
            * The -metadata option takes a single dict value. Note that
            * parsing this is outside the scope of this function.
            */

            if (index + 1 >= objc) {
                goto oneValueRequired;
            }
            *optIndexPtr = ++index;
            optPtr->metadata = objv[index];
        } else if (bit == OPT_COMPOSITE) {
	    /*
	     * The -compositingrule option takes a single value from a
	     * well-known set.
	     */

	    if (index + 1 >= objc) {
		goto oneValueRequired;
................................................................................
		    ckfree(args);
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "value for \"-format\" missing", -1));
		    Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO",
			    "MISSING_VALUE", NULL);
		    return TCL_ERROR;
		}
            } else if ((args[j][1] == 'm') &&
                !strncmp(args[j], "-metadata", length)) {
                if (++i < objc) {
                    metadata = objv[i];
                    j--;
                }
                else {
                    ckfree(args);
                    Tcl_SetObjResult(interp, Tcl_NewStringObj(
                        "value for \"-metadata\" missing", -1));
                    Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO",
                        "MISSING_VALUE", NULL);
                    return TCL_ERROR;
                }
            }
	}
    }

    /*
     * Save the current values for fileString and dataString, so we can tell
     * if the user specifies them anew. IMPORTANT: if the format changes we
     * have to interpret "-file" and "-data" again as well! It might be that
................................................................................
	}
	if (masterPtr->format) {
	    Tcl_DecrRefCount(masterPtr->format);
	}
	masterPtr->format = format;
    }
    if (metadata) {
        /*
        * Stringify to ignore -metadata "". It may come in as a list or other
        * object.
        */

        /* HaO: ToDo: value is a dict, not a string */
        (void)Tcl_GetString(metadata);
        if (metadata->length) {
            Tcl_IncrRefCount(metadata);
        }
        else {
            metadata = NULL;
        }
        if (masterPtr->metadata) {
            Tcl_DecrRefCount(masterPtr->metadata);
        }
        masterPtr->metadata = metadata;
    }
    /*
     * Set the image to the user-requested size, if any, and make sure storage
     * is correctly allocated for this image.
     */

    if (ImgPhotoSetSize(masterPtr, masterPtr->width,






|
|
|
|
|







 







|
|
|
|
|
|
|
|







 







|
|
|
|
|
|
|

|
|
<
|
|
|
|
|







 







|







 







|







 







|







 







|
|
|
|
|

|
|
|
|
|
|







 







|
|
|
|
|
<
|
|
|
|
|
|
|
|
|







 







|
|
|
|

|
|
|
|
|
|
|
|
|
|
|
|







457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
...
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
...
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553

554
555
556
557
558
559
560
561
562
563
564
565
...
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
...
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
....
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
....
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
....
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845

1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
....
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
	    if (masterPtr->dataString) {
		Tcl_SetObjResult(interp, masterPtr->dataString);
	    }
	} else if (strncmp(arg,"-format", length) == 0) {
	    if (masterPtr->format) {
		Tcl_SetObjResult(interp, masterPtr->format);
	    }
	} else if (strncmp(arg, "-metadata", length) == 0) {
	    if (masterPtr->metadata) {
		Tcl_SetObjResult(interp, masterPtr->metadata);
	    }
	} else {
	    Tk_ConfigureValue(interp, Tk_MainWindow(interp), configSpecs,
		    (char *) masterPtr, Tcl_GetString(objv[2]), 0);
	}
	return TCL_OK;
    }

    case PHOTO_CONFIGURE:
................................................................................
	    subobj = Tcl_NewStringObj("-format {} {} {}", 16);
	    if (masterPtr->format) {
		Tcl_ListObjAppendElement(NULL, subobj, masterPtr->format);
	    } else {
		Tcl_AppendStringsToObj(subobj, " {}", NULL);
	    }
	    Tcl_ListObjAppendElement(interp, obj, subobj);
	    subobj = Tcl_NewStringObj("-metadata {} {} {}", 16);
	    if (masterPtr->metadata) {
		Tcl_ListObjAppendElement(NULL, subobj, masterPtr->metadata);
	    } else {
		Tcl_AppendStringsToObj(subobj, " {}", NULL);
	    }
	    Tcl_ListObjAppendElement(interp, obj, subobj);
	    Tcl_ListObjAppendList(interp, obj, Tcl_GetObjResult(interp));
	    Tcl_SetObjResult(interp, obj);
	    return TCL_OK;

	} else if (objc == 3) {
	    const char *arg = TkGetStringFromObj(objv[2], &length);

	    if (length > 1 && !strncmp(arg, "-data", length)) {
................................................................................

		    Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp),
			    masterPtr->format);
		} else {
		    Tcl_AppendResult(interp, " {}", NULL);
		}
		return TCL_OK;
	    } else if (length > 1 &&
		!strncmp(arg, "-metadata", length)) {
		Tcl_AppendResult(interp, "-metadata {} {} {}", NULL);
		if (masterPtr->metadata) {
		    /*
		     * TODO: Modifying result is bad!
		     */

		    Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp),
			masterPtr->metadata);

		} else {
		    Tcl_AppendResult(interp, " {}", NULL);
		}
		return TCL_OK;
	    } else {
		return Tk_ConfigureInfo(interp, Tk_MainWindow(interp),
			configSpecs, (char *) masterPtr, arg, 0);
	    }
	} else {
	    return ImgPhotoConfigureMaster(interp, masterPtr, objc-2, objv+2,
		    TK_CONFIG_ARGV_ONLY);
	}
................................................................................
	memset(&options, 0, sizeof(options));
	options.name = NULL;
	options.format = NULL;
	options.fromX = 0;
	options.fromY = 0;
	if (ParseSubcommandOptions(&options, interp,
		OPT_FORMAT | OPT_FROM | OPT_GRAYSCALE | OPT_BACKGROUND
		| OPT_METADATA,
		&index, objc, objv) != TCL_OK) {
	    return TCL_ERROR;
	}
	if ((options.name == NULL) || (index < objc)) {
	    Tcl_WrongNumArgs(interp, 2, objv, "?-option value ...?");
	    return TCL_ERROR;
	}
................................................................................
	 */

	index = 2;
	memset(&options, 0, sizeof(options));
	options.name = NULL;
	options.format = NULL;
	if (ParseSubcommandOptions(&options, interp,
		OPT_TO|OPT_FORMAT|OPT_METADATA,
		&index, objc, objv) != TCL_OK) {
	    return TCL_ERROR;
	}
	if ((options.name == NULL) || (index < objc)) {
	    Tcl_WrongNumArgs(interp, 2, objv, "data ?-option value ...?");
	    return TCL_ERROR;
	}
................................................................................

	index = 2;
	memset(&options, 0, sizeof(options));
	options.name = NULL;
	options.format = NULL;
	if (ParseSubcommandOptions(&options, interp,
		OPT_FORMAT | OPT_FROM | OPT_GRAYSCALE | OPT_BACKGROUND
		| OPT_METADATA,
		&index, objc, objv) != TCL_OK) {
	    return TCL_ERROR;
	}
	if ((options.name == NULL) || (index < objc)) {
	    Tcl_WrongNumArgs(interp, 2, objv, "fileName ?-option value ...?");
	    return TCL_ERROR;
	}
................................................................................
	     */

	    if (index + 1 >= objc) {
		goto oneValueRequired;
	    }
	    *optIndexPtr = ++index;
	    optPtr->format = objv[index];
	} else if (bit == OPT_METADATA) {
	    /*
	    * The -metadata option takes a single dict value. Note that
	    * parsing this is outside the scope of this function.
	    */

	    if (index + 1 >= objc) {
		goto oneValueRequired;
	    }
	    *optIndexPtr = ++index;
	    optPtr->metadata = objv[index];
	} else if (bit == OPT_COMPOSITE) {
	    /*
	     * The -compositingrule option takes a single value from a
	     * well-known set.
	     */

	    if (index + 1 >= objc) {
		goto oneValueRequired;
................................................................................
		    ckfree(args);
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "value for \"-format\" missing", -1));
		    Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO",
			    "MISSING_VALUE", NULL);
		    return TCL_ERROR;
		}
	    } else if ((args[j][1] == 'm') &&
		!strncmp(args[j], "-metadata", length)) {
		if (++i < objc) {
		    metadata = objv[i];
		    j--;

		} else {
		    ckfree(args);
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"value for \"-metadata\" missing", -1));
		    Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO",
			"MISSING_VALUE", NULL);
		    return TCL_ERROR;
		}
	    }
	}
    }

    /*
     * Save the current values for fileString and dataString, so we can tell
     * if the user specifies them anew. IMPORTANT: if the format changes we
     * have to interpret "-file" and "-data" again as well! It might be that
................................................................................
	}
	if (masterPtr->format) {
	    Tcl_DecrRefCount(masterPtr->format);
	}
	masterPtr->format = format;
    }
    if (metadata) {
	/*
	 * Stringify to ignore -metadata "". It may come in as a list or other
	 * object.
	 */

	/* HaO: ToDo: value is a dict, not a string */
	(void)Tcl_GetString(metadata);
	if (metadata->length) {
	    Tcl_IncrRefCount(metadata);
	}
	else {
	    metadata = NULL;
	}
	if (masterPtr->metadata) {
	    Tcl_DecrRefCount(masterPtr->metadata);
	}
	masterPtr->metadata = metadata;
    }
    /*
     * Set the image to the user-requested size, if any, and make sure storage
     * is correctly allocated for this image.
     */

    if (ImgPhotoSetSize(masterPtr, masterPtr->width,

Changes to generic/tkImgPhoto.h.

162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
				 * instances of this image. */
    double gamma;		/* Display gamma value to correct for. */
    char *fileString;		/* Name of file to read into image. */
    Tcl_Obj *dataString;	/* Object to use as contents of image. */
    Tcl_Obj *format;		/* User-specified format of data in image file
				 * or string value. */
    Tcl_Obj *metadata;		/* User-specified metadata dict or read from
                                 * image file */
    unsigned char *pix32;	/* Local storage for 32-bit image. */
    int ditherX, ditherY;	/* Location of first incorrectly dithered
				 * pixel in image. */
    TkRegion validRegion;	/* Tk region indicating which parts of the
				 * image have valid image data. */
    PhotoInstance *instancePtr;	/* First in the list of instances associated
				 * with this master. */






|







162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
				 * instances of this image. */
    double gamma;		/* Display gamma value to correct for. */
    char *fileString;		/* Name of file to read into image. */
    Tcl_Obj *dataString;	/* Object to use as contents of image. */
    Tcl_Obj *format;		/* User-specified format of data in image file
				 * or string value. */
    Tcl_Obj *metadata;		/* User-specified metadata dict or read from
				 * image file */
    unsigned char *pix32;	/* Local storage for 32-bit image. */
    int ditherX, ditherY;	/* Location of first incorrectly dithered
				 * pixel in image. */
    TkRegion validRegion;	/* Tk region indicating which parts of the
				 * image have valid image data. */
    PhotoInstance *instancePtr;	/* First in the list of instances associated
				 * with this master. */