Tk Source Code

#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;
    }

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"

	/*
	 * 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.xany.serial = LastKnownRequestProcessed(display);
	event.xany.send_event = False;
	event.xany.display = display;

	event.xunmap.type = UnmapNotify;
	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 --
 *

    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

    .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:

    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

    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
    .c create image 90 100 -image foo
    update
    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