Tk Source Code

Check-in [64d5777d]
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:Merge trunk and adjust frame tests.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | tip-262
Files: files | file ages | folders
SHA3-256: 64d5777deae88b6ea3a3cf55e04010d6c5d67ce0f4a41195f0230707a1bd2979
User & Date: culler 2019-05-24 22:18:09
Context
2019-05-25
08:11
TIP 262: -backgroundimage option for [frame] and [toplevel] check-in: 17cd3433 user: dkf tags: trunk
2019-05-24
22:18
Merge trunk and adjust frame tests. Closed-Leaf check-in: 64d5777d user: culler tags: tip-262
22:06
Improve image testing for Aqua check-in: e49ebc82 user: culler tags: trunk
2019-05-19
09:57
merge trunk check-in: 5be7fdb0 user: dkf tags: tip-262
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tkTest.c.

27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
....
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575

1576
1577
1578
1579
1580












1581
1582

1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
#ifdef _WIN32
#include "tkWinInt.h"
#endif

#if defined(MAC_OSX_TK)
#include "tkMacOSXInt.h"
#include "tkScrollbar.h"
#define APP_IS_DRAWING TkTestAppIsDrawing()
#else
#define APP_IS_DRAWING 0
#endif

#ifdef __UNIX__
#include "tkUnixInt.h"
#endif

/*
................................................................................
    int width, int height,	/* Dimensions of area to redraw. */
    int drawableX, int drawableY)
				/* Coordinates in drawable corresponding to
				 * imageX and imageY. */
{
    TImageInstance *instPtr = clientData;
    char buffer[200 + TCL_INTEGER_SPACE * 6];

    /*
     * The purpose of the test image type is to track the calls to an image
     * display proc and record the parameters passed in each call.  On macOS
     * these tests will fail because of the asynchronous drawing.  The low
     * level graphics calls below which are supposed to draw a rectangle will
     * not draw anything to the screen because the idle task will not be
     * processed inside of the drawRect method and hence will not be able to
     * obtain a valid graphics context. Instead, the window will be marked as
     * needing display, and will be redrawn during a future asynchronous call
     * to drawRect.  This will generate an other call to this display proc,

     * and the recorded data will show extra calls, causing the test to fail.
     * To avoid this, we can set the [NSApp simulateDrawing] flag, which will
     * cause all low level drawing routines to return immediately and not
     * schedule the window for drawing later.  This flag is cleared by the
     * next call to XSync, which is called by the update command.












     */


    sprintf(buffer, "%s display %d %d %d %d",
	    instPtr->masterPtr->imageName, imageX, imageY, width, height);
    if (!APP_IS_DRAWING) {
	Tcl_SetVar2(instPtr->masterPtr->interp, instPtr->masterPtr->varName,
	    NULL, buffer, TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
    }
    if (width > (instPtr->masterPtr->width - imageX)) {
	width = instPtr->masterPtr->width - imageX;
    }
    if (height > (instPtr->masterPtr->height - imageY)) {
	height = instPtr->masterPtr->height - imageY;
    }






|

|







 







|



|
|
|
|
|
|
<
>
|
|
|
|
<
>
>
>
>
>
>
>
>
>
>
>
>


>
|
|
<

|







27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
....
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574

1575
1576
1577
1578
1579

1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596

1597
1598
1599
1600
1601
1602
1603
1604
1605
#ifdef _WIN32
#include "tkWinInt.h"
#endif

#if defined(MAC_OSX_TK)
#include "tkMacOSXInt.h"
#include "tkScrollbar.h"
#define LOG_DISPLAY TkTestLogDisplay()
#else
#define LOG_DISPLAY 1
#endif

#ifdef __UNIX__
#include "tkUnixInt.h"
#endif

/*
................................................................................
    int width, int height,	/* Dimensions of area to redraw. */
    int drawableX, int drawableY)
				/* Coordinates in drawable corresponding to
				 * imageX and imageY. */
{
    TImageInstance *instPtr = clientData;
    char buffer[200 + TCL_INTEGER_SPACE * 6];
    
    /*
     * The purpose of the test image type is to track the calls to an image
     * display proc and record the parameters passed in each call.  On macOS
     * a display proc must be run inside of the drawRect method of an NSView
     * in order for the graphics operations to have any effect.  To deal with
     * this, whenever a display proc is called outside of any drawRect method
     * it schedules a redraw of the NSView by calling [view setNeedsDisplay:YES].
     * This will trigger a later call to the view's drawRect method which will
     * run the display proc a second time.

     *
     * This complicates testing, since it can result in more calls to the display
     * proc than are expected by the test.  It can also result in an inconsistent
     * number of calls unless the test waits until the call to drawRect actually
     * occurs before validating its results.

     *
     * In an attempt to work around this, this display proc only logs those
     * calls which occur within a drawRect method.  This means that tests must
     * be written so as to ensure that the drawRect method is run before
     * results are validated.  In practice it usually suffices to run update
     * idletasks (to run the display proc the first time) followed by update
     * (to run the display proc in drawRect).
     *
     * This also has the consequence that the image changed command will log
     * different results on Aqua than on other systems, because when the image
     * is redisplayed in the drawRect method the entire image will be drawn,
     * not just the changed portion.  Tests must account for this.
     */

    if (LOG_DISPLAY) {
	sprintf(buffer, "%s display %d %d %d %d",
		instPtr->masterPtr->imageName, imageX, imageY, width, height);

	Tcl_SetVar2(instPtr->masterPtr->interp, instPtr->masterPtr->varName,
		    NULL, buffer, TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
    }
    if (width > (instPtr->masterPtr->width - imageX)) {
	width = instPtr->masterPtr->width - imageX;
    }
    if (height > (instPtr->masterPtr->height - imageY)) {
	height = instPtr->masterPtr->height - imageY;
    }

Changes to macosx/tkMacOSXInt.h.

198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
MODULE_SCOPE void TkpClipDrawableToRect(Display *display, Drawable d, int x,
	int y, int width, int height);
MODULE_SCOPE void TkpRetainRegion(TkRegion r);
MODULE_SCOPE void TkpReleaseRegion(TkRegion r);
MODULE_SCOPE void TkpShiftButton(NSButton *button, NSPoint delta);
MODULE_SCOPE Bool TkpAppIsDrawing(void);
MODULE_SCOPE void TkpDisplayWindow(Tk_Window tkwin);
MODULE_SCOPE Bool TkTestAppIsDrawing(void);
MODULE_SCOPE Bool TkMacOSXInDarkMode(Tk_Window tkwin);

/*
 * Include the stubbed internal platform-specific API.
 */

#include "tkIntPlatDecls.h"






|







198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
MODULE_SCOPE void TkpClipDrawableToRect(Display *display, Drawable d, int x,
	int y, int width, int height);
MODULE_SCOPE void TkpRetainRegion(TkRegion r);
MODULE_SCOPE void TkpReleaseRegion(TkRegion r);
MODULE_SCOPE void TkpShiftButton(NSButton *button, NSPoint delta);
MODULE_SCOPE Bool TkpAppIsDrawing(void);
MODULE_SCOPE void TkpDisplayWindow(Tk_Window tkwin);
MODULE_SCOPE Bool TkTestLogDisplay(void);
MODULE_SCOPE Bool TkMacOSXInDarkMode(Tk_Window tkwin);

/*
 * Include the stubbed internal platform-specific API.
 */

#include "tkIntPlatDecls.h"

Changes to macosx/tkMacOSXSubwindows.c.

205
206
207
208
209
210
211


212
213
214
215
216
217
218
219
220
221
222
223
...
282
283
284
285
286
287
288

289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
...
310
311
312
313
314
315
316
317

318
319
320
321
322
323
324
325
326
327
328





329
330
331
332
333
334
335
	/*
	 * For non-toplevel windows, rebuild the parent's clipping region
	 * and redisplay the window.
	 */

	TkMacOSXInvalClipRgns((Tk_Window) winPtr->parentPtr);


	if ([NSApp isDrawing]) {
	    [[win contentView] setNeedsRedisplay:YES];
	} else {
	    [[win contentView] setNeedsDisplay:YES];
	}
    }

    /*
     * Generate VisibilityNotify events for window and all mapped children.
     */

    event.xany.send_event = False;
................................................................................
XUnmapWindow(
    Display *display,		/* Display. */
    Window window)		/* Window. */
{
    MacDrawable *macWin = (MacDrawable *) window;
    TkWindow *winPtr = macWin->winPtr;
    TkWindow *parentPtr = winPtr->parentPtr;

    XEvent event;

    display->request++;
    if (Tk_IsTopLevel(winPtr)) {
	if (!Tk_IsEmbedded(winPtr) &&
		winPtr->wmInfoPtr->hints.initial_state!=IconicState) {
	    NSWindow *win = TkMacOSXDrawableWindow(window);

	    [win orderOut:nil];
	}
	TkMacOSXInvalClipRgns((Tk_Window) winPtr);

	/*
	 * We only need to send the UnmapNotify event for toplevel windows.
	 */
................................................................................
	event.xunmap.window = window;
	event.xunmap.event = window;
	event.xunmap.from_configure = false;
	Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL);
    } else {
	/*
	 * Rebuild the visRgn clip region for the parent so it will be allowed
	 * to draw in the space from which this subwindow was removed.

	 */

	if (parentPtr && parentPtr->privatePtr->visRgn) {
	    TkMacOSXInvalidateViewRegion(
		    TkMacOSXDrawableView(parentPtr->privatePtr),
		    parentPtr->privatePtr->visRgn);
	}
	TkMacOSXInvalClipRgns((Tk_Window) parentPtr);
	TkMacOSXUpdateClipRgn(parentPtr);
    }
    winPtr->flags &= ~TK_MAPPED;





}
 
/*
 *----------------------------------------------------------------------
 *
 * XResizeWindow --
 *






>
>
|
|
|
|
<







 







>






<
<







 







|
>











>
>
>
>
>







205
206
207
208
209
210
211
212
213
214
215
216
217

218
219
220
221
222
223
224
...
283
284
285
286
287
288
289
290
291
292
293
294
295
296


297
298
299
300
301
302
303
...
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
	/*
	 * For non-toplevel windows, rebuild the parent's clipping region
	 * and redisplay the window.
	 */

	TkMacOSXInvalClipRgns((Tk_Window) winPtr->parentPtr);
    }

    if ([NSApp isDrawing]) {
	[[win contentView] setNeedsRedisplay:YES];
    } else {
	[[win contentView] setNeedsDisplay:YES];

    }

    /*
     * Generate VisibilityNotify events for window and all mapped children.
     */

    event.xany.send_event = False;
................................................................................
XUnmapWindow(
    Display *display,		/* Display. */
    Window window)		/* Window. */
{
    MacDrawable *macWin = (MacDrawable *) window;
    TkWindow *winPtr = macWin->winPtr;
    TkWindow *parentPtr = winPtr->parentPtr;
    NSWindow *win = TkMacOSXDrawableWindow(window);
    XEvent event;

    display->request++;
    if (Tk_IsTopLevel(winPtr)) {
	if (!Tk_IsEmbedded(winPtr) &&
		winPtr->wmInfoPtr->hints.initial_state!=IconicState) {


	    [win orderOut:nil];
	}
	TkMacOSXInvalClipRgns((Tk_Window) winPtr);

	/*
	 * We only need to send the UnmapNotify event for toplevel windows.
	 */
................................................................................
	event.xunmap.window = window;
	event.xunmap.event = window;
	event.xunmap.from_configure = false;
	Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL);
    } else {
	/*
	 * Rebuild the visRgn clip region for the parent so it will be allowed
	 * to draw in the space from which this subwindow was removed and then
	 * redraw the window.
	 */

	if (parentPtr && parentPtr->privatePtr->visRgn) {
	    TkMacOSXInvalidateViewRegion(
		    TkMacOSXDrawableView(parentPtr->privatePtr),
		    parentPtr->privatePtr->visRgn);
	}
	TkMacOSXInvalClipRgns((Tk_Window) parentPtr);
	TkMacOSXUpdateClipRgn(parentPtr);
    }
    winPtr->flags &= ~TK_MAPPED;
    if ([NSApp isDrawing]) {
	[[win contentView] setNeedsRedisplay:YES];
    } else {
	[[win contentView] setNeedsDisplay:YES];
    }
}
 
/*
 *----------------------------------------------------------------------
 *
 * XResizeWindow --
 *

Changes to macosx/tkMacOSXTest.c.

86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101

102
103
104


105
106
107
108
109
110
111
112

113



114
115
116
117
118
119
120
121
122
123
124
    return TCL_OK;
}
#endif
 
/*
 *----------------------------------------------------------------------
 *
 * TkTestAppIsDrawing --
 *
 *      A test widget display procedure which records calls can use this to
 *      detect whether it is being called from within [NSView drawRect].
 *      If so, it probably should not be recording the call since it was
 *      probably generated spontaneously by the window manager rather than
 *      by an explicit call to update. This is just a wrapper for the NSApp
 *      property.
 *

 *
 * Results:
 *      Returns true if and only if called from within [NSView drawRect].


 *
 * Side effects:
 *	None
 *
 *----------------------------------------------------------------------
 */
MODULE_SCOPE Bool
TkTestAppIsDrawing(void) {

    return [NSApp isDrawing];



}
 

/*
 * Local Variables:
 * mode: objc
 * c-basic-offset: 4
 * fill-column: 79
 * coding: utf-8
 * End:
 */






|

|
|
|
|
|
|
|
>


|
>
>







|
>
|
>
>
>











86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
    return TCL_OK;
}
#endif
 
/*
 *----------------------------------------------------------------------
 *
 * TkTestLogDisplay --
 *
 *      The test image display procedure calls this to determine whether it
 *      should write a log message recording that it has being run.  On OSX
 *      10.14 and later, only calls to the display procedure which occur inside
 *      of the drawRect method should be logged, since those are the only ones
 *      which actually draw anything.  On earlier systems the opposite is true.
 *      The calls from within the drawRect method are redundant, since the
 *      first time the display procedure is run it will do the drawing and that
 *      first call will usually not occur inside of drawRect.
 *
 * Results:
 *      On OSX 10.14 and later, returns true if and only if called from
 *      within [NSView drawRect].  On earlier systems returns false if
 *      and only if called from with [NSView drawRect].
 *
 * Side effects:
 *	None
 *
 *----------------------------------------------------------------------
 */
MODULE_SCOPE Bool
TkTestLogDisplay(void) {
    if ([NSApp macMinorVersion] >= 14) {
	return [NSApp isDrawing];
    } else {
	return ![NSApp isDrawing];
    }
}
 

/*
 * Local Variables:
 * mode: objc
 * c-basic-offset: 4
 * fill-column: 79
 * coding: utf-8
 * End:
 */

Changes to tests/canvImg.test.

152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168

169

170





171
172
173
174
175
176
177
...
716
717
718
719
720
721
722






723
724
725
726
727
728
729
...
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
...
762
763
764
765
766
767
768






769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
    .c itemconfigure i1 -image {}
    update
    list $x [.c bbox i1]
} -cleanup {
	.c delete all
	image delete foo
} -result {{{foo free}} {}}
test canvImg-4.2 {ConfiugreImage procedure} -constraints testImageType -setup {
    .c delete all
} -body {
	image create test foo -variable x
    image create test foo2 -variable y
    foo2 changed 0 0 0 0 80 60
    .c create image 50 100 -image foo -tags i1 -anchor nw
    update
    set x {}
    set y {}

    .c itemconfigure i1 -image foo2

    update





    list $x $y [.c bbox i1]
} -cleanup {
	.c delete all
	image delete foo
	image delete foo2
} -result {{{foo free}} {{foo2 get} {foo2 display 0 0 80 60}} {50 100 130 160}}
test canvImg-4.3 {ConfiugreImage procedure} -constraints testImageType -setup {
................................................................................
    .c scale image 25 0 2.0 1.5
    .c bbox image
} -cleanup {
	.c delete all
	image delete foo
} -result {75 150 105 165}







test canvImg-10.1 {TranslateImage procedure} -constraints testImageType -setup {
    .c delete all
    update
} -body {
	image create test foo -variable x
    .c create image 50 100 -image foo -tags image -anchor nw
    update
................................................................................
    set x {}
    foo changed 2 4 6 8 30 15
    update
    return $x
} -cleanup {
	.c delete all
	image delete foo
} -result {{foo display 2 4 6 8}}

test canvImg-11.1 {TranslateImage procedure} -constraints testImageType -setup {
    .c delete all
    update
} -body {
	image create test foo -variable x
    .c create image 50 100 -image foo -tags image -anchor nw
................................................................................
    set x {}
    foo changed 0 0 0 0 40 50
    .c bbox image
} -cleanup {
	.c delete all
	image delete foo
} -result {30 75 70 125}






test canvImg-11.3 {ImageChangedProc procedure} -constraints {
	testImageType
} -setup {
    .c delete all
    update
} -body {
    image create test foo -variable x
	image create test foo2 -variable y
    foo changed 0 0 0 0 40 50
    foo2 changed 0 0 0 0 80 60

    .c create image 50 100 -image foo -tags image -anchor nw
    .c create image 70 110 -image foo2 -anchor nw
    update
    set y {}
    image create test foo -variable x
    update
    return $y
} -cleanup {
	.c delete all
	image delete foo foo2
} -result {{foo2 display 0 0 20 40}}

# cleanup
imageFinish
cleanupTests
return

# Local variables:
# mode: tcl
# End:






|


|






>

>

>
>
>
>
>







 







>
>
>
>
>
>







 







|







 







>
>
>
>
>
>







|













|









152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
...
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
...
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
...
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
    .c itemconfigure i1 -image {}
    update
    list $x [.c bbox i1]
} -cleanup {
	.c delete all
	image delete foo
} -result {{{foo free}} {}}
test canvImg-4.2 {ConfigureImage procedure} -constraints testImageType -setup {
    .c delete all
} -body {
    image create test foo -variable x
    image create test foo2 -variable y
    foo2 changed 0 0 0 0 80 60
    .c create image 50 100 -image foo -tags i1 -anchor nw
    update
    set x {}
    set y {}
    set timer [after 300 {lappend y "timeout"}]
    .c itemconfigure i1 -image foo2
    update idletasks
    update
    # On MacOS we need to wait for the test image display procedure to run.
    while {"timeout" ni $y && [lindex $y end 1] ne "display"} {
        vwait y
    }
    after cancel timer
    list $x $y [.c bbox i1]
} -cleanup {
	.c delete all
	image delete foo
	image delete foo2
} -result {{{foo free}} {{foo2 get} {foo2 display 0 0 80 60}} {50 100 130 160}}
test canvImg-4.3 {ConfiugreImage procedure} -constraints testImageType -setup {
................................................................................
    .c scale image 25 0 2.0 1.5
    .c bbox image
} -cleanup {
	.c delete all
	image delete foo
} -result {75 150 105 165}

if {[tk windowingsystem] == "aqua" && $tcl_platform(osVersion) > 18} {
    # Aqua >= 10.14 will redraw the entire image.
    set result_10_1 {{foo display 0 0 30 15}}
} else {
    set result_10_1 {{foo display 2 4 6 8}} 
}
test canvImg-10.1 {TranslateImage procedure} -constraints testImageType -setup {
    .c delete all
    update
} -body {
	image create test foo -variable x
    .c create image 50 100 -image foo -tags image -anchor nw
    update
................................................................................
    set x {}
    foo changed 2 4 6 8 30 15
    update
    return $x
} -cleanup {
	.c delete all
	image delete foo
} -result $result_10_1

test canvImg-11.1 {TranslateImage procedure} -constraints testImageType -setup {
    .c delete all
    update
} -body {
	image create test foo -variable x
    .c create image 50 100 -image foo -tags image -anchor nw
................................................................................
    set x {}
    foo changed 0 0 0 0 40 50
    .c bbox image
} -cleanup {
	.c delete all
	image delete foo
} -result {30 75 70 125}
if {[tk windowingsystem] == "aqua" && $tcl_platform(osVersion) > 18} {
    # Aqua >= 10.14 will redraw the entire image.
    set result_11_3 {{foo2 display 0 0 80 60}}
} else {
    set result_11_3 {{foo2 display 0 0 20 40}} 
}
test canvImg-11.3 {ImageChangedProc procedure} -constraints {
	testImageType
} -setup {
    .c delete all
    update
} -body {
    image create test foo -variable x
    image create test foo2 -variable y
    foo changed 0 0 0 0 40 50
    foo2 changed 0 0 0 0 80 60

    .c create image 50 100 -image foo -tags image -anchor nw
    .c create image 70 110 -image foo2 -anchor nw
    update
    set y {}
    image create test foo -variable x
    update
    return $y
} -cleanup {
	.c delete all
	image delete foo foo2
} -result $result_11_3

# cleanup
imageFinish
cleanupTests
return

# Local variables:
# mode: tcl
# End:

Changes to tests/frame.test.

1579
1580
1581
1582
1583
1584
1585
1586
1587
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
1614
1615
1616
1617








1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632





1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
....
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763





1764
1765
1766
1767
1768
1769
1770
    deleteWindows
    set result {}
    . configure -width 200 -height 200
} -constraints testImageType -body {
    image create test gorp -variable result
    pack [frame .f -width 100 -height 100 -bgimg gorp]
    update idletasks; update
    raise [winfo parent .f];	# Try to make sure the frame fully repaints
    update idletasks; update
    return [uniq $result]
} -cleanup {
    deleteWindows
    catch {image delete gorp}
} -result {{gorp get} {gorp display 0 0 30 15}}
test frame-15.6a {TIP 262: frame background images (offsets)} -setup {
    deleteWindows
    set result {}
    . configure -width 200 -height 200
} -constraints testImageType -body {
    image create test gorp -variable result
    pack [frame .f -width 10 -height 10 -bgimg gorp]
    update idletasks; update
    raise [winfo parent .f];	# Try to make sure the frame fully repaints






    update idletasks; update
    return [uniq $result]
} -cleanup {
    deleteWindows
    catch {image delete gorp}
} -result {{gorp get} {gorp display 10 2 10 10}}
test frame-15.7 {TIP 262: frame background images} -setup {
................................................................................
    deleteWindows
    set result {}
    . configure -width 200 -height 200
} -constraints testImageType -body {
    image create test gorp -variable result
    pack [frame .f -width 50 -height 25 -bgimg gorp -tile 1]
    update idletasks; update
    raise [winfo parent .f];	# Try to make sure the frame fully repaints
    update idletasks; update








    return [uniq $result]
} -cleanup {
    deleteWindows
    catch {image delete gorp}
} -result {{gorp get} {gorp display 0 0 30 15} {gorp display 0 0 30 10} {gorp display 0 0 20 15} {gorp display 0 0 20 10}}
test frame-15.7a {TIP 262: frame background images (offsets)} -setup {
    deleteWindows
    set result {}
    . configure -width 200 -height 200
} -constraints testImageType -body {
    image create test gorp -variable result
    pack [frame .f -width 50 -height 25 -bgimg gorp -tile 1 -highlightthick 1]
    update idletasks; update
    raise [winfo parent .f];	# Try to make sure the frame fully repaints
    update idletasks; update





    return [uniq $result]
} -cleanup {
    deleteWindows
    catch {image delete gorp}
} -result {{gorp get} {gorp display 0 0 30 15} {gorp display 0 0 30 8} {gorp display 0 0 18 15} {gorp display 0 0 18 8}}
test frame-15.7b {TIP 262: frame background images (offsets)} -setup {
    deleteWindows
    set result {}
    . configure -width 200 -height 200
} -constraints testImageType -body {
    image create test gorp -variable result
    pack [frame .f -width 50 -height 25 -bgimg gorp -tile 1 -bd 2]
    update idletasks; update
    raise [winfo parent .f];	# Try to make sure the frame fully repaints
    update idletasks; update
    return [uniq $result]
} -cleanup {
    deleteWindows
    catch {image delete gorp}
} -result {{gorp get} {gorp display 0 0 30 15} {gorp display 0 0 30 6} {gorp display 0 0 16 15} {gorp display 0 0 16 6}}
test frame-15.7c {TIP 262: frame background images (offsets)} -setup {
    deleteWindows
    set result {}
    . configure -width 200 -height 200
} -constraints testImageType -body {
    image create test gorp -variable result
    pack [frame .f -width 50 -height 25 -bgimg gorp -tile 1 -bd 2 -highlightthick 1]
    update idletasks; update
    raise [winfo parent .f];	# Try to make sure the frame fully repaints
    update idletasks; update
    return [uniq $result]
} -cleanup {
    deleteWindows
    catch {image delete gorp}
} -result {{gorp get} {gorp display 0 0 30 15} {gorp display 0 0 30 4} {gorp display 0 0 14 15} {gorp display 0 0 14 4}}
test frame-15.8 {TIP 262: toplevel background images} -setup {
    deleteWindows
................................................................................
    deleteWindows
    set result {}
} -constraints testImageType -body {
    image create test gorp -variable result
    toplevel .t -width 100 -height 100 -bgimg gorp
    wm overrideredirect .t 1;	# Reduce trouble from window managers
    update idletasks; update
    raise .t;			# Try to make sure the toplevel fully repaints
    update idletasks; update
    return [uniq $result]
} -cleanup {
    deleteWindows
    catch {image delete gorp}
} -result {{gorp get} {gorp display 0 0 30 15}}
test frame-15.14 {TIP 262: toplevel background images} -setup {
    deleteWindows
    set result {}
} -constraints testImageType -body {
    image create test gorp -variable result
    toplevel .t -width 50 -height 25 -bgimg gorp -tile 1
    wm overrideredirect .t 1;	# Reduce trouble from window managers
    update idletasks; update
    raise .t;			# Try to make sure the toplevel fully repaints
    update idletasks; update





    return [uniq $result]
} -cleanup {
    deleteWindows
    catch {image delete gorp}
} -result {{gorp get} {gorp display 0 0 30 15} {gorp display 0 0 30 10} {gorp display 0 0 20 15} {gorp display 0 0 20 10}}
 
# cleanup






<
<













|
>
>
>
>
>
>







 







|
|
>
>
>
>
>
>
>
>













|
|
>
>
>
>
>













<
<













<
<







 







<
<













|
|
>
>
>
>
>







1579
1580
1581
1582
1583
1584
1585


1586
1587
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
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662


1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675


1676
1677
1678
1679
1680
1681
1682
....
1753
1754
1755
1756
1757
1758
1759


1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
    deleteWindows
    set result {}
    . configure -width 200 -height 200
} -constraints testImageType -body {
    image create test gorp -variable result
    pack [frame .f -width 100 -height 100 -bgimg gorp]
    update idletasks; update


    return [uniq $result]
} -cleanup {
    deleteWindows
    catch {image delete gorp}
} -result {{gorp get} {gorp display 0 0 30 15}}
test frame-15.6a {TIP 262: frame background images (offsets)} -setup {
    deleteWindows
    set result {}
    . configure -width 200 -height 200
} -constraints testImageType -body {
    image create test gorp -variable result
    pack [frame .f -width 10 -height 10 -bgimg gorp]
    update idletasks; update
    # On MacOS must wait for the test image display procedure to run.
    set timer [after 300 {lappend result "timedout"}]
    while {"timedout" ni $result &&
	   "gorp display 10 2 10 10" ni $result} {
       vwait result
    }
    after cancel $timer
    update idletasks; update
    return [uniq $result]
} -cleanup {
    deleteWindows
    catch {image delete gorp}
} -result {{gorp get} {gorp display 10 2 10 10}}
test frame-15.7 {TIP 262: frame background images} -setup {
................................................................................
    deleteWindows
    set result {}
    . configure -width 200 -height 200
} -constraints testImageType -body {
    image create test gorp -variable result
    pack [frame .f -width 50 -height 25 -bgimg gorp -tile 1]
    update idletasks; update
    # On MacOS must wait for the test image display procedure to run.
    set timer [after 300 {lappend result "timedout"}]
    while {"timedout" ni $result &&
	   "gorp display 0 0 20 10" ni $result} {
	vwait result
    }
    after cancel $timer
    if {[lindex $result end] eq "timedout"} {
	return [lreplace $result end end]
    }
    return [uniq $result]
} -cleanup {
    deleteWindows
    catch {image delete gorp}
} -result {{gorp get} {gorp display 0 0 30 15} {gorp display 0 0 30 10} {gorp display 0 0 20 15} {gorp display 0 0 20 10}}
test frame-15.7a {TIP 262: frame background images (offsets)} -setup {
    deleteWindows
    set result {}
    . configure -width 200 -height 200
} -constraints testImageType -body {
    image create test gorp -variable result
    pack [frame .f -width 50 -height 25 -bgimg gorp -tile 1 -highlightthick 1]
    update idletasks; update
    # On MacOS must wait for the test image display procedure to run.
    set timer [after 300 {lappend result "timedout"}]
    while {"timedout" ni $result &&
	   "gorp display 0 0 18 8" ni $result} {
	vwait result
   }
    after cancel $timer
    return [uniq $result]
} -cleanup {
    deleteWindows
    catch {image delete gorp}
} -result {{gorp get} {gorp display 0 0 30 15} {gorp display 0 0 30 8} {gorp display 0 0 18 15} {gorp display 0 0 18 8}}
test frame-15.7b {TIP 262: frame background images (offsets)} -setup {
    deleteWindows
    set result {}
    . configure -width 200 -height 200
} -constraints testImageType -body {
    image create test gorp -variable result
    pack [frame .f -width 50 -height 25 -bgimg gorp -tile 1 -bd 2]
    update idletasks; update


    return [uniq $result]
} -cleanup {
    deleteWindows
    catch {image delete gorp}
} -result {{gorp get} {gorp display 0 0 30 15} {gorp display 0 0 30 6} {gorp display 0 0 16 15} {gorp display 0 0 16 6}}
test frame-15.7c {TIP 262: frame background images (offsets)} -setup {
    deleteWindows
    set result {}
    . configure -width 200 -height 200
} -constraints testImageType -body {
    image create test gorp -variable result
    pack [frame .f -width 50 -height 25 -bgimg gorp -tile 1 -bd 2 -highlightthick 1]
    update idletasks; update


    return [uniq $result]
} -cleanup {
    deleteWindows
    catch {image delete gorp}
} -result {{gorp get} {gorp display 0 0 30 15} {gorp display 0 0 30 4} {gorp display 0 0 14 15} {gorp display 0 0 14 4}}
test frame-15.8 {TIP 262: toplevel background images} -setup {
    deleteWindows
................................................................................
    deleteWindows
    set result {}
} -constraints testImageType -body {
    image create test gorp -variable result
    toplevel .t -width 100 -height 100 -bgimg gorp
    wm overrideredirect .t 1;	# Reduce trouble from window managers
    update idletasks; update


    return [uniq $result]
} -cleanup {
    deleteWindows
    catch {image delete gorp}
} -result {{gorp get} {gorp display 0 0 30 15}}
test frame-15.14 {TIP 262: toplevel background images} -setup {
    deleteWindows
    set result {}
} -constraints testImageType -body {
    image create test gorp -variable result
    toplevel .t -width 50 -height 25 -bgimg gorp -tile 1
    wm overrideredirect .t 1;	# Reduce trouble from window managers
    update idletasks; update
    # On MacOS must wait for the test image display procedure to run.
    set timer [after 300 {lappend result "timedout"}]
    while {"timedout" ni $result &&
	   "gorp display 0 0 20 10" ni $result} {
	vwait result
   }
    after cancel $timer
    return [uniq $result]
} -cleanup {
    deleteWindows
    catch {image delete gorp}
} -result {{gorp get} {gorp display 0 0 30 15} {gorp display 0 0 30 10} {gorp display 0 0 20 15} {gorp display 0 0 20 10}}
 
# cleanup

Changes to tests/image.test.

58
59
60
61
62
63
64

65

66








67
68
69
70
71
72
73
...
341
342
343
344
345
346
347





348
349
350
351
352
353
354
355
356
357

358

359





360
361
362
363
364






365
366
367
368
369
370
371
...
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
    imageCleanup
} -body {
    image create test myimage -variable x
    .c create image 100 50 -image myimage
    .c create image 100 150 -image myimage
    update
    set x {}

    image create test myimage -variable x

    update








    return $x
} -cleanup {
    imageCleanup
} -result {{myimage free} {myimage free} {myimage delete} {myimage get} {myimage get} {myimage display 0 0 30 15} {myimage display 0 0 30 15}}
test image-1.8 {Tk_ImageCmd procedure, "create" option} -constraints {
	testImageType
} -setup {
................................................................................
    button .b -image myimage2
    lappend res [image inuse myimage2]
} -cleanup {
    imageCleanup
    catch {destroy .b}
} -result [list 0 1]







test image-9.1 {Tk_ImageChanged procedure} -constraints testImageType -setup {
    .c delete all
    imageCleanup
    update
} -body {
    image create test foo -variable x
    .c create image 50 50 -image foo
    update
    set x {}

    foo changed 5 6 7 8 30 15

    update





    return $x
} -cleanup {
    .c delete all
    imageCleanup
} -result {{foo display 5 6 7 8}}






test image-9.2 {Tk_ImageChanged procedure} -constraints testImageType -setup {
    .c delete all
    imageCleanup
    update
} -body {
    image create test foo -variable x
    .c create image 50 50 -image foo
................................................................................
    set x {}
    foo changed 5 6 7 8 30 15
    update
    return $x
} -cleanup {
    .c delete all
    imageCleanup
} -result {{foo display 5 6 25 9} {foo display 0 0 12 14}}


test image-10.1 {Tk_GetImage procedure} -setup {
    imageCleanup
} -body {
    .c create image 100 10 -image bad_name
} -cleanup {
    imageCleanup






>

>

>
>
>
>
>
>
>
>







 







>
>
>
>
>
|









>

>

>
>
>
>
>




|
>
>
>
>
>
>







 







|
<







58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
...
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
...
402
403
404
405
406
407
408
409

410
411
412
413
414
415
416
    imageCleanup
} -body {
    image create test myimage -variable x
    .c create image 100 50 -image myimage
    .c create image 100 150 -image myimage
    update
    set x {}
    set timer [after 500 {lappend x "timeout"}]
    image create test myimage -variable x
    update idletasks
    update
    # On MacOS we need to wait for the test image display procedure to run.
    while {"timeout" ni $x && [lindex $x end 1] ne "display"} {
        vwait x
    }
    after cancel timer
    if {[lindex $x end] eq "timeout"} {
       return [lreplace $x end end]
    }
    return $x
} -cleanup {
    imageCleanup
} -result {{myimage free} {myimage free} {myimage delete} {myimage get} {myimage get} {myimage display 0 0 30 15} {myimage display 0 0 30 15}}
test image-1.8 {Tk_ImageCmd procedure, "create" option} -constraints {
	testImageType
} -setup {
................................................................................
    button .b -image myimage2
    lappend res [image inuse myimage2]
} -cleanup {
    imageCleanup
    catch {destroy .b}
} -result [list 0 1]

if {[tk windowingsystem] == "aqua" && $tcl_platform(osVersion) > 18} {
    # Aqua >= 10.14 will redraw the entire image in drawRect.
    set result_9_1 {{foo display 0 0 30 15}}
} else {
    set result_9_1 {{foo display 5 6 7 8}}
}
test image-9.1 {Tk_ImageChanged procedure} -constraints testImageType -setup {
    .c delete all
    imageCleanup
    update
} -body {
    image create test foo -variable x
    .c create image 50 50 -image foo
    update
    set x {}
    set timer [after 500 {lappend x "timeout"}]
    foo changed 5 6 7 8 30 15
    update idletasks
    update
    # On MacOS we need to wait for the test image display procedure to run.
    while {"timeout" ni $x && [lindex $x end 1] ne "display"} {
        vwait x
    }
    after cancel timer
    return $x
} -cleanup {
    .c delete all
    imageCleanup
} -result $result_9_1
if {[tk windowingsystem] == "aqua" && $tcl_platform(osVersion) > 18} {
    # Aqua >= 10.14 will redraw the entire image.
    set result_9_2 {{foo display 0 0 30 15} {foo display 0 0 30 15}}
} else {
    set result_9_2 {{foo display 5 6 25 9} {foo display 0 0 12 14}}
}
test image-9.2 {Tk_ImageChanged procedure} -constraints testImageType -setup {
    .c delete all
    imageCleanup
    update
} -body {
    image create test foo -variable x
    .c create image 50 50 -image foo
................................................................................
    set x {}
    foo changed 5 6 7 8 30 15
    update
    return $x
} -cleanup {
    .c delete all
    imageCleanup
} -result $result_9_2


test image-10.1 {Tk_GetImage procedure} -setup {
    imageCleanup
} -body {
    .c create image 100 10 -image bad_name
} -cleanup {
    imageCleanup