Check-in [881ffc25d3]
Not logged in

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

Overview
Comment:merge with trunk
Timelines: family | ancestors | descendants | both | wtf-8-experiment
Files: files | file ages | folders
SHA1: 881ffc25d30ff5cf215d21f62525c8eaf7582cfb
User & Date: chw 2019-07-05 19:47:43
Context
2019-07-07
08:26
merge with trunk check-in: fea67f041d user: chw tags: wtf-8-experiment
2019-07-05
19:47
merge with trunk check-in: 881ffc25d3 user: chw tags: wtf-8-experiment
19:46
add tcl upstream changes check-in: 5438017a85 user: chw tags: trunk
2019-07-04
15:32
merge with trunk check-in: d5ad5781d6 user: chw tags: wtf-8-experiment
Changes

Changes to assets/materialicons0.2/materialicons.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
..
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
..
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
...
190
191
192
193
194
195
196
197
198
199
200
201
202
203

204
205
206
207
208

209
210
211
212
213
214
215
...
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
# Module to on-demand render MaterialIcons-Regular.svg
# into photo images using tksvg.
#
# chw January 2019
# image_ncg contributed by dzach May 2019

package require Tk
package require tdom
package require tksvg

namespace eval ::MaterialIcons {

................................................................................
	}
	set template0 {
	    <?xml version="1.0" encoding="UTF-8" standalone="no"?>
	    <svg id="%%s" width="%g" height="%g" viewBox="%s" version="1.1">
	      <g>
		<path fill="%%s" fill-opacity="%%g"
		 stroke="%%s" stroke-width="%%g"
		 transform="scale(1,-1) translate(0,%g)"
		 d="%%s"/>
	      </g>
	    </svg>
	}
	lassign $bbox x1 y1 x2 y2
	set w [expr {$x2 - $x1}]
	set h [expr {$y2 - $y1}]
................................................................................
	variable glyph
	tailcall lsort [array names glyph $pattern]
    }

    # Return SVG for named icon with optional fill color and opacity.

    proc svg {name {color black} {opacity 1.0}
	{stroke none} {strokewidth 1.0}} {
	variable glyph
	variable template
	if {![info exists glyph($name)]} {
	    return -code error "glyph $name does not exist"
	}
	tailcall format $template $name $color $opacity \
	    $stroke $strokewidth $glyph($name)
    }

    # Return photo image for named icon with optional size, fill color,
    # and opacity. If size is negative, it specifies pixels, else points
    # taking the current tk scaling into account.

    proc image {name {size 16} {color black} {opacity 1.0}} {
................................................................................
	} elseif {$val < 0} {
	    set val [expr {-1.0 * $val}]
	}
	return $val
    }

    # Like the "image_nc" method but accepting many options:
    #   glyph		glyph name to be rendered
    #   name		name of photo image
    #   -size S		size with optional unit suffix
    #   -fill C		fill color
    #   -opacity O	fill opacity
    #   -stroke C	stroke color
    #   -strokewidth S	stroke width with optional unit suffix


    proc image_ncg {name imgname args} {
	variable viewbox
	array set opts {
	    -size 24d -fill black -opacity 1.0 -stroke none -strokewidth 1.0

	}
	array set opts $args
	lassign $viewbox x y w h
	set size [val2px $opts(-size)]
	if {$size == 0} {
	    return -code error "invalid size"
	}
................................................................................
	    # reverse the scale
	    set opts(-strokewidth) \
		[expr {abs([val2px $opts(-strokewidth)] / $scale)}]
	}
	tailcall ::image create photo $imgname \
	    -format [list svg -scale $scale] \
	    -data [svg $name $opts(-fill) $opts(-opacity) $opts(-stroke) \
		$opts(-strokewidth)]
    }

    # Make some procs visible in MaterialIcons ensemble.

    namespace ensemble create -subcommands {
	names svg image image_nc flush rebuild image_ncg
    }

}

package provide MaterialIcons 0.2




|







 







|







 







|






|







 







|
|





>




|
>







 







|











1
2
3
4
5
6
7
8
9
10
11
12
..
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
..
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
...
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
...
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
# Module to on-demand render MaterialIcons-Regular.svg
# into photo images using tksvg.
#
# chw January 2019
# image_ncg contributed by dzach May/July 2019

package require Tk
package require tdom
package require tksvg

namespace eval ::MaterialIcons {

................................................................................
	}
	set template0 {
	    <?xml version="1.0" encoding="UTF-8" standalone="no"?>
	    <svg id="%%s" width="%g" height="%g" viewBox="%s" version="1.1">
	      <g>
		<path fill="%%s" fill-opacity="%%g"
		 stroke="%%s" stroke-width="%%g"
		 transform="rotate(%%g,256,256) scale(1,-1) translate(0,%g)"
		 d="%%s"/>
	      </g>
	    </svg>
	}
	lassign $bbox x1 y1 x2 y2
	set w [expr {$x2 - $x1}]
	set h [expr {$y2 - $y1}]
................................................................................
	variable glyph
	tailcall lsort [array names glyph $pattern]
    }

    # Return SVG for named icon with optional fill color and opacity.

    proc svg {name {color black} {opacity 1.0}
	{stroke none} {strokewidth 1.0} {angle 0}} {
	variable glyph
	variable template
	if {![info exists glyph($name)]} {
	    return -code error "glyph $name does not exist"
	}
	tailcall format $template $name $color $opacity \
	    $stroke $strokewidth $angle $glyph($name)
    }

    # Return photo image for named icon with optional size, fill color,
    # and opacity. If size is negative, it specifies pixels, else points
    # taking the current tk scaling into account.

    proc image {name {size 16} {color black} {opacity 1.0}} {
................................................................................
	} elseif {$val < 0} {
	    set val [expr {-1.0 * $val}]
	}
	return $val
    }

    # Like the "image_nc" method but accepting many options:
    #   name		glyph name to be rendered
    #   imgname		name of photo image
    #   -size S		size with optional unit suffix
    #   -fill C		fill color
    #   -opacity O	fill opacity
    #   -stroke C	stroke color
    #   -strokewidth S	stroke width with optional unit suffix
    #   -angle A	angle in degrees

    proc image_ncg {name imgname args} {
	variable viewbox
	array set opts {
	    -size 24d -fill black -opacity 1.0 -stroke none
	    -strokewidth 1.0 -angle 0
	}
	array set opts $args
	lassign $viewbox x y w h
	set size [val2px $opts(-size)]
	if {$size == 0} {
	    return -code error "invalid size"
	}
................................................................................
	    # reverse the scale
	    set opts(-strokewidth) \
		[expr {abs([val2px $opts(-strokewidth)] / $scale)}]
	}
	tailcall ::image create photo $imgname \
	    -format [list svg -scale $scale] \
	    -data [svg $name $opts(-fill) $opts(-opacity) $opts(-stroke) \
		$opts(-strokewidth) $opts(-angle)]
    }

    # Make some procs visible in MaterialIcons ensemble.

    namespace ensemble create -subcommands {
	names svg image image_nc flush rebuild image_ncg
    }

}

package provide MaterialIcons 0.2

Changes to jni/sdl2tk/doc/bind.n.

562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
The path name of the window to which the event was reported (the
\fIwindow\fR field from the event).  Valid for all event types.
.IP "\fB%X\fR, \fB%Y\fR" 5
The \fIx_root\fR and  \fIy_root\fR fields from the event.
If a virtual-root window manager is being used then the substituted
values are the corresponding x-coordinate and y-coordinate in the virtual root.
Valid only for
\fBButtonPress\fR, \fBButtonRelease\fR, \fBKeyPress\fR, \fBKeyRelease\fR,
and \fBMotion\fR events.
Same meaning as \fB%x\fR and \fB%y\fR, except relative to the (virtual) root
window.
.LP
The replacement string for a %-replacement is formatted as a proper
Tcl list element.
This means that spaces or special characters such as \fB$\fR and
\fB{\fR may be preceded by backslashes.







|
|







562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
The path name of the window to which the event was reported (the
\fIwindow\fR field from the event).  Valid for all event types.
.IP "\fB%X\fR, \fB%Y\fR" 5
The \fIx_root\fR and  \fIy_root\fR fields from the event.
If a virtual-root window manager is being used then the substituted
values are the corresponding x-coordinate and y-coordinate in the virtual root.
Valid only for
\fBButtonPress\fR, \fBButtonRelease\fR, \fBEnter\fR, \fBKeyPress\fR,
\fBKeyRelease\fR, \fBLeave\fR and \fBMotion\fR events.
Same meaning as \fB%x\fR and \fB%y\fR, except relative to the (virtual) root
window.
.LP
The replacement string for a %-replacement is formatted as a proper
Tcl list element.
This means that spaces or special characters such as \fB$\fR and
\fB{\fR may be preceded by backslashes.

Changes to jni/sdl2tk/generic/tkImgPhoto.c.

34
35
36
37
38
39
40
41
42

43
44
45
46
47
48
49
50
51
..
71
72
73
74
75
76
77

78
79
80
81
82
83
84
..
88
89
90
91
92
93
94

95
96
97
98
99
100
101
...
110
111
112
113
114
115
116

117
118
119
120
121
122
123
...
585
586
587
588
589
590
591

592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
...
634
635
636
637
638
639
640
641
642























643
644
645
646
647
648
649
....
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
....
1759
1760
1761
1762
1763
1764
1765


























1766
1767
1768
1769
1770
1771
1772
    Tcl_Obj *name;		/* Name specified without an option. */
    int fromX, fromY;		/* Values specified for -from option. */
    int fromX2, fromY2;		/* Second coordinate pair for -from option. */
    int toX, toY;		/* Values specified for -to option. */
    int toX2, toY2;		/* Second coordinate pair for -to option. */
    int zoomX, zoomY;		/* Values specified for -zoom option. */
    int subsampleX, subsampleY;	/* Values specified for -subsample option. */
    double rotate;		/* Degrees to rotate the image with */
    double scaleX, scaleY;	/* Resize factors in the X and Y directions */

    int mirrorX, mirrorY;	/* 1 if mirroring the resp. axis requested */
    char *filtername;		/* Name of the interpolating lowpass filter */
    int smoothedge;		/* Pixel width of frame used in edge smoothing:
                                 * default value is 0 (means no smoothing)
                                 * and 1 may be specified in the Tcl command. */
    double blur;		/* Defines the effect of blurring the image,
				 * must be > 1.0 */
    Tcl_Obj *format;		/* Value specified for -format option. */
    XColor *background;		/* Value specified for -background option. */
................................................................................
 * OPT_ZOOM:			Set if -zoom option allowed/specified.
 * OPT_ROTATE:			Set if -rotate option allowed/specified.
 * OPT_SCALE:			Set if -scale option allowed/specified.
 * OPT_MIRROR:			Set if -mirror option allowed/specified.
 * OPT_FILTER:			Set if -filter option allowed/specified.
 * OPT_SMOOTHEDGE:		Set if -smoothedge option allowed/specified.
 * OPT_BLUR:			Set if -blur 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_ZOOM	0x100
#define OPT_ROTATE	0x200
#define OPT_SCALE	0x400
#define OPT_MIRROR	0x800
#define OPT_FILTER	0x1000
#define OPT_SMOOTHEDGE	0x2000
#define OPT_BLUR	0x4000


/*
 * List of option names. The order here must match the order of declarations
 * of the OPT_* constants above.
 */

static const char *const optionNames[] = {
................................................................................
    "-zoom",
    "-rotate",
    "-scale",
    "-mirror",
    "-filter",
    "-smoothedge",
    "-blur",

    NULL
};

/*
 * Message to generate when an attempt to resize an image fails due to memory
 * problems.
 */
................................................................................
	 */

	index = 2;
	memset(&options, 0, sizeof(options));
	options.zoomX = options.zoomY = 1;
	options.subsampleX = options.subsampleY = 1;
	options.scaleX = options.scaleY = 1;

	options.rotate = 0;
	options.mirrorX = options.mirrorY = 0;
	options.filtername = NULL;
	options.smoothedge = 0;
	options.blur = 0;
	options.name = NULL;
	options.compositingRule = TK_PHOTO_COMPOSITE_OVERLAY;
	if (ParseSubcommandOptions(&options, interp,
		OPT_FROM | OPT_TO | OPT_ZOOM | OPT_SUBSAMPLE | OPT_SHRINK |
		OPT_COMPOSITE | OPT_BACKGROUND |
		OPT_ROTATE | OPT_SCALE | OPT_MIRROR | OPT_FILTER | OPT_BLUR,
		&index, objc, objv) != TCL_OK) {
	    return TCL_ERROR;
	}
	if ((options.filtername == NULL) && (options.smoothedge != 0)) {
	    options.filtername = "Mitchell";
	}
................................................................................
		    Tcl_GetString(options.name)));
	    Tcl_SetErrorCode(interp, "TK", "LOOKUP", "PHOTO",
		    Tcl_GetString(options.name), NULL);
	    return TCL_ERROR;
	}
	Tk_PhotoGetImage(srcHandle, &block);

        if ((options.options & OPT_ROTATE) || (options.options & OPT_SCALE) ||
	    (options.options & OPT_MIRROR) || (options.options & OPT_FILTER)) {























	    int sameSrc = (block.pixelPtr == masterPtr->pix32);
	    PhotoMaster savedMaster;

	    savedMaster = *masterPtr;
	    if (sameSrc) {
		masterPtr->pix32 = NULL;
		masterPtr->width = masterPtr->height = 0;
................................................................................
	    }
	    optPtr->name = objv[index];
	    continue;
	}

	/*
	 * For the -from, -to, -zoom, -subsample, -background, -rotate,
	 * -scale, -filter, -mirror, -smoothedge options, parse the
	 * values given.  Report an error if too few or too many values
	 * are given.
	 */

	if (bit == OPT_BACKGROUND) {
	    /*
	     * The -background option takes a single XColor value.
	     */

................................................................................
			}
		    }
		}
	    } else {
		Tcl_AppendResult(interp, "the \"-scale\" option ",
			"requires one or two values", (char *) NULL);
		return TCL_ERROR;


























	    }
	} else if (bit == OPT_MIRROR) {
	    if (index + 1 < objc) {
		char *temp;

		*optIndexPtr = ++index;
                temp = Tcl_GetString(objv[index]);







|
|
>

|







 







>







 







>







 







>







 







>









|







 







|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







|
|
|







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
..
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
..
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
...
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
...
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
...
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
....
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
....
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
    Tcl_Obj *name;		/* Name specified without an option. */
    int fromX, fromY;		/* Values specified for -from option. */
    int fromX2, fromY2;		/* Second coordinate pair for -from option. */
    int toX, toY;		/* Values specified for -to option. */
    int toX2, toY2;		/* Second coordinate pair for -to option. */
    int zoomX, zoomY;		/* Values specified for -zoom option. */
    int subsampleX, subsampleY;	/* Values specified for -subsample option. */
    double rotate;		/* Degrees to rotate the image with. */
    double scaleX, scaleY;	/* Resize factors in the X and Y directions. */
    int stoX, stoY;		/* Target width/height for -scaleto option. */
    int mirrorX, mirrorY;	/* 1 if mirroring the resp. axis requested */
    char *filtername;		/* Name of the interpolating lowpass filter. */
    int smoothedge;		/* Pixel width of frame used in edge smoothing:
                                 * default value is 0 (means no smoothing)
                                 * and 1 may be specified in the Tcl command. */
    double blur;		/* Defines the effect of blurring the image,
				 * must be > 1.0 */
    Tcl_Obj *format;		/* Value specified for -format option. */
    XColor *background;		/* Value specified for -background option. */
................................................................................
 * OPT_ZOOM:			Set if -zoom option allowed/specified.
 * OPT_ROTATE:			Set if -rotate option allowed/specified.
 * OPT_SCALE:			Set if -scale option allowed/specified.
 * OPT_MIRROR:			Set if -mirror option allowed/specified.
 * OPT_FILTER:			Set if -filter option allowed/specified.
 * OPT_SMOOTHEDGE:		Set if -smoothedge option allowed/specified.
 * OPT_BLUR:			Set if -blur option allowed/specified.
 * OPT_SCALETO:			Set if -scaleto 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_ZOOM	0x100
#define OPT_ROTATE	0x200
#define OPT_SCALE	0x400
#define OPT_MIRROR	0x800
#define OPT_FILTER	0x1000
#define OPT_SMOOTHEDGE	0x2000
#define OPT_BLUR	0x4000
#define OPT_SCALETO	0x8000

/*
 * List of option names. The order here must match the order of declarations
 * of the OPT_* constants above.
 */

static const char *const optionNames[] = {
................................................................................
    "-zoom",
    "-rotate",
    "-scale",
    "-mirror",
    "-filter",
    "-smoothedge",
    "-blur",
    "-scaleto",
    NULL
};

/*
 * Message to generate when an attempt to resize an image fails due to memory
 * problems.
 */
................................................................................
	 */

	index = 2;
	memset(&options, 0, sizeof(options));
	options.zoomX = options.zoomY = 1;
	options.subsampleX = options.subsampleY = 1;
	options.scaleX = options.scaleY = 1;
	options.stoX = options.stoY = -1;
	options.rotate = 0;
	options.mirrorX = options.mirrorY = 0;
	options.filtername = NULL;
	options.smoothedge = 0;
	options.blur = 0;
	options.name = NULL;
	options.compositingRule = TK_PHOTO_COMPOSITE_OVERLAY;
	if (ParseSubcommandOptions(&options, interp,
		OPT_FROM | OPT_TO | OPT_ZOOM | OPT_SUBSAMPLE | OPT_SHRINK |
		OPT_COMPOSITE | OPT_BACKGROUND | OPT_SCALETO |
		OPT_ROTATE | OPT_SCALE | OPT_MIRROR | OPT_FILTER | OPT_BLUR,
		&index, objc, objv) != TCL_OK) {
	    return TCL_ERROR;
	}
	if ((options.filtername == NULL) && (options.smoothedge != 0)) {
	    options.filtername = "Mitchell";
	}
................................................................................
		    Tcl_GetString(options.name)));
	    Tcl_SetErrorCode(interp, "TK", "LOOKUP", "PHOTO",
		    Tcl_GetString(options.name), NULL);
	    return TCL_ERROR;
	}
	Tk_PhotoGetImage(srcHandle, &block);

	if (options.options & OPT_SCALETO) {
	    int corr;

	    /* No rotation, no smoothedge, please. */
	    options.rotate = 0;
	    options.smoothedge = 0;
	    options.options &= ~(OPT_ROTATE | OPT_SCALE);
	    options.toX = options.toY = 0;
	    corr = (options.stoX > block.width) ? 2 : 1;
	    options.scaleX =
		(double) options.stoX / (double) (block.width - corr);
	    options.toX2 = options.stoX;
	    if (options.stoY < 0) {
		options.scaleY = options.scaleX;
		options.toY2 = (int) (block.height * options.scaleY + 0.5);
	    } else {
		corr = (options.stoY > block.height) ? 2 : 1;
		options.scaleY =
		    (double) options.stoY / (double) (block.height - corr);
		options.toY2 = options.stoY;
	    }
	}

        if (options.options & (OPT_ROTATE | OPT_SCALE |
			       OPT_MIRROR | OPT_FILTER | OPT_SCALETO)) {
	    int sameSrc = (block.pixelPtr == masterPtr->pix32);
	    PhotoMaster savedMaster;

	    savedMaster = *masterPtr;
	    if (sameSrc) {
		masterPtr->pix32 = NULL;
		masterPtr->width = masterPtr->height = 0;
................................................................................
	    }
	    optPtr->name = objv[index];
	    continue;
	}

	/*
	 * For the -from, -to, -zoom, -subsample, -background, -rotate,
	 * -scale, -filter, -mirror, -smoothedge, -blur, -scaleto options,
	 * parse the values given. Report an error if too few or too many
	 * values are given.
	 */

	if (bit == OPT_BACKGROUND) {
	    /*
	     * The -background option takes a single XColor value.
	     */

................................................................................
			}
		    }
		}
	    } else {
		Tcl_AppendResult(interp, "the \"-scale\" option ",
			"requires one or two values", (char *) NULL);
		return TCL_ERROR;
	    }
	} else if (bit == OPT_SCALETO) {
	    if (index + 1 < objc) {
		*optIndexPtr = ++index;
		if ((Tcl_GetIntFromObj(interp, objv[index], &optPtr->stoX)
		     != TCL_OK) || (optPtr->stoX <= 0)) {
		    Tcl_AppendResult(interp,
			 "the -scaleto X value is invalid", (char *) NULL);
		    return TCL_ERROR;
		}
		if (index + 1 < objc) {
		    if (*(Tcl_GetString(objv[index+1])) != '-') {
			*optIndexPtr = ++index;
			if ((Tcl_GetIntFromObj(interp, objv[index], &optPtr->stoY)
			     != TCL_OK) || (optPtr->stoY <= 0)) {
			    Tcl_AppendResult(interp,
				"the -scaleto Y value is invalid",
				(char *) NULL);
			    return TCL_ERROR;
			}
		    }
		}
	    } else {
		Tcl_AppendResult(interp, "the \"-scaleto\" option ",
			"requires one or two values", (char *) NULL);
		return TCL_ERROR;
	    }
	} else if (bit == OPT_MIRROR) {
	    if (index + 1 < objc) {
		char *temp;

		*optIndexPtr = ++index;
                temp = Tcl_GetString(objv[index]);

Changes to jni/tcl/generic/tclCmdAH.c.

1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
....
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
....
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
....
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
....
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
....
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
....
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
	return TCL_ERROR;
    }
    if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) {
	return TCL_ERROR;
    }
#if defined(_WIN32)
    /* We use a value of 0 to indicate the access time not available */
    if (buf.st_atime == 0) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                             "could not get access time for file \"%s\"",
                             TclGetString(objv[1])));
        return TCL_ERROR;
    }
#endif

................................................................................
	long newTime;

	if (TclGetLongFromObj(interp, objv[2], &newTime) != TCL_OK) {
	    return TCL_ERROR;
	}

	tval.actime = newTime;
	tval.modtime = buf.st_mtime;

	if (Tcl_FSUtime(objv[1], &tval) != 0) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "could not set access time for file \"%s\": %s",
		    TclGetString(objv[1]), Tcl_PosixError(interp)));
	    return TCL_ERROR;
	}
................................................................................
	 */

	if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) {
	    return TCL_ERROR;
	}
    }

    Tcl_SetObjResult(interp, Tcl_NewLongObj((long) buf.st_atime));
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
 * FileAttrModifyTimeCmd --
................................................................................
	return TCL_ERROR;
    }
    if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) {
	return TCL_ERROR;
    }
#if defined(_WIN32)
    /* We use a value of 0 to indicate the modification time not available */
    if (buf.st_mtime == 0) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                             "could not get modification time for file \"%s\"",
                             TclGetString(objv[1])));
        return TCL_ERROR;
    }
#endif
    if (objc == 3) {
................................................................................

	long newTime;

	if (TclGetLongFromObj(interp, objv[2], &newTime) != TCL_OK) {
	    return TCL_ERROR;
	}

	tval.actime = buf.st_atime;
	tval.modtime = newTime;

	if (Tcl_FSUtime(objv[1], &tval) != 0) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "could not set modification time for file \"%s\": %s",
		    TclGetString(objv[1]), Tcl_PosixError(interp)));
	    return TCL_ERROR;
................................................................................
	 */

	if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) {
	    return TCL_ERROR;
	}
    }

    Tcl_SetObjResult(interp, Tcl_NewLongObj((long) buf.st_mtime));
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
 * FileAttrLinkStatCmd --
................................................................................
    STORE_ARY("size",	Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_size));
#ifdef HAVE_STRUCT_STAT_ST_BLOCKS
    STORE_ARY("blocks",	Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_blocks));
#endif
#ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
    STORE_ARY("blksize", Tcl_NewLongObj((long)statPtr->st_blksize));
#endif
    STORE_ARY("atime",	Tcl_NewLongObj((long)statPtr->st_atime));
    STORE_ARY("mtime",	Tcl_NewLongObj((long)statPtr->st_mtime));
    STORE_ARY("ctime",	Tcl_NewLongObj((long)statPtr->st_ctime));
    mode = (unsigned short) statPtr->st_mode;
    STORE_ARY("mode",	Tcl_NewIntObj(mode));
    STORE_ARY("type",	Tcl_NewStringObj(GetTypeFromMode(mode), -1));
#undef STORE_ARY

    return TCL_OK;
}







|







 







|







 







|







 







|







 







|







 







|







 







|
|
|







1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
....
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
....
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
....
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
....
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
....
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
....
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
	return TCL_ERROR;
    }
    if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) {
	return TCL_ERROR;
    }
#if defined(_WIN32)
    /* We use a value of 0 to indicate the access time not available */
    if (Tcl_GetAccessTimeFromStat(&buf) == 0) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                             "could not get access time for file \"%s\"",
                             TclGetString(objv[1])));
        return TCL_ERROR;
    }
#endif

................................................................................
	long newTime;

	if (TclGetLongFromObj(interp, objv[2], &newTime) != TCL_OK) {
	    return TCL_ERROR;
	}

	tval.actime = newTime;
	tval.modtime = Tcl_GetModificationTimeFromStat(&buf);

	if (Tcl_FSUtime(objv[1], &tval) != 0) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "could not set access time for file \"%s\": %s",
		    TclGetString(objv[1]), Tcl_PosixError(interp)));
	    return TCL_ERROR;
	}
................................................................................
	 */

	if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) {
	    return TCL_ERROR;
	}
    }

    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(Tcl_GetAccessTimeFromStat(&buf)));
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
 * FileAttrModifyTimeCmd --
................................................................................
	return TCL_ERROR;
    }
    if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) {
	return TCL_ERROR;
    }
#if defined(_WIN32)
    /* We use a value of 0 to indicate the modification time not available */
    if (Tcl_GetModificationTimeFromStat(&buf) == 0) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                             "could not get modification time for file \"%s\"",
                             TclGetString(objv[1])));
        return TCL_ERROR;
    }
#endif
    if (objc == 3) {
................................................................................

	long newTime;

	if (TclGetLongFromObj(interp, objv[2], &newTime) != TCL_OK) {
	    return TCL_ERROR;
	}

	tval.actime = Tcl_GetAccessTimeFromStat(&buf);
	tval.modtime = newTime;

	if (Tcl_FSUtime(objv[1], &tval) != 0) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "could not set modification time for file \"%s\": %s",
		    TclGetString(objv[1]), Tcl_PosixError(interp)));
	    return TCL_ERROR;
................................................................................
	 */

	if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) {
	    return TCL_ERROR;
	}
    }

    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(Tcl_GetModificationTimeFromStat(&buf)));
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
 * FileAttrLinkStatCmd --
................................................................................
    STORE_ARY("size",	Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_size));
#ifdef HAVE_STRUCT_STAT_ST_BLOCKS
    STORE_ARY("blocks",	Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_blocks));
#endif
#ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
    STORE_ARY("blksize", Tcl_NewLongObj((long)statPtr->st_blksize));
#endif
    STORE_ARY("atime",	Tcl_NewWideIntObj(Tcl_GetAccessTimeFromStat(statPtr)));
    STORE_ARY("mtime",	Tcl_NewWideIntObj(Tcl_GetModificationTimeFromStat(statPtr)));
    STORE_ARY("ctime",	Tcl_NewWideIntObj(Tcl_GetChangeTimeFromStat(statPtr)));
    mode = (unsigned short) statPtr->st_mode;
    STORE_ARY("mode",	Tcl_NewIntObj(mode));
    STORE_ARY("type",	Tcl_NewStringObj(GetTypeFromMode(mode), -1));
#undef STORE_ARY

    return TCL_OK;
}

Changes to jni/tcl/generic/tclIOUtil.c.

327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
....
4455
4456
4457
4458
4459
4460
4461
4462
4463
4464
4465
4466
4467
4468
4469
4470
	oldStyleBuf->st_ino	= (ino_t) buf.st_ino;
	oldStyleBuf->st_dev	= buf.st_dev;
	oldStyleBuf->st_rdev	= buf.st_rdev;
	oldStyleBuf->st_nlink	= buf.st_nlink;
	oldStyleBuf->st_uid	= buf.st_uid;
	oldStyleBuf->st_gid	= buf.st_gid;
	oldStyleBuf->st_size	= (off_t) buf.st_size;
	oldStyleBuf->st_atime	= buf.st_atime;
	oldStyleBuf->st_mtime	= buf.st_mtime;
	oldStyleBuf->st_ctime	= buf.st_ctime;
#ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
	oldStyleBuf->st_blksize	= buf.st_blksize;
#endif
#ifdef HAVE_STRUCT_STAT_ST_BLOCKS
#ifdef HAVE_BLKCNT_T
	oldStyleBuf->st_blocks	= (blkcnt_t) buf.st_blocks;
#else
................................................................................
    Tcl_Close(interp, out);

    /*
     * Set modification date of copied file.
     */

    if (Tcl_FSLstat(source, &sourceStatBuf) == 0) {
	tval.actime = sourceStatBuf.st_atime;
	tval.modtime = sourceStatBuf.st_mtime;
	Tcl_FSUtime(target, &tval);
    }

  done:
    return result;
}
 







|
|
|







 







|
|







327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
....
4455
4456
4457
4458
4459
4460
4461
4462
4463
4464
4465
4466
4467
4468
4469
4470
	oldStyleBuf->st_ino	= (ino_t) buf.st_ino;
	oldStyleBuf->st_dev	= buf.st_dev;
	oldStyleBuf->st_rdev	= buf.st_rdev;
	oldStyleBuf->st_nlink	= buf.st_nlink;
	oldStyleBuf->st_uid	= buf.st_uid;
	oldStyleBuf->st_gid	= buf.st_gid;
	oldStyleBuf->st_size	= (off_t) buf.st_size;
	oldStyleBuf->st_atime	= Tcl_GetAccessTimeFromStat(&buf);
	oldStyleBuf->st_mtime	= Tcl_GetModificationTimeFromStat(&buf);
	oldStyleBuf->st_ctime	= Tcl_GetChangeTimeFromStat(&buf);
#ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
	oldStyleBuf->st_blksize	= buf.st_blksize;
#endif
#ifdef HAVE_STRUCT_STAT_ST_BLOCKS
#ifdef HAVE_BLKCNT_T
	oldStyleBuf->st_blocks	= (blkcnt_t) buf.st_blocks;
#else
................................................................................
    Tcl_Close(interp, out);

    /*
     * Set modification date of copied file.
     */

    if (Tcl_FSLstat(source, &sourceStatBuf) == 0) {
	tval.actime = Tcl_GetAccessTimeFromStat(&sourceStatBuf);
	tval.modtime = Tcl_GetModificationTimeFromStat(&sourceStatBuf);
	Tcl_FSUtime(target, &tval);
    }

  done:
    return result;
}