Tk Source Code

Check-in [42f90406]
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:Fix some tests. Add some test cases.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | tip-262
Files: files | file ages | folders
SHA3-256: 42f90406df28a426387a263eee2336ae23e71c6d408d832c551ac42d59c84cc1
User & Date: dkf 2019-05-16 22:22:14
Context
2019-05-17
20:06
Add double buffering to frames and toplevels.

Theoretically only needed when drawing background with images, but simpler to do always. Incidentally fixes minor bug in labelframes with redrawing of focus rings, but nobody really used those on labelframes so it was never reported... check-in: 86db63ba user: dkf tags: tip-262

2019-05-16
22:22
Fix some tests. Add some test cases. check-in: 42f90406 user: dkf tags: tip-262
21:27
merge trunk check-in: 2eac67b2 user: dkf tags: tip-262
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Changes to tests/frame.test.

     8      8   # All rights reserved.
     9      9   
    10     10   package require tcltest 2.2
    11     11   namespace import ::tcltest::*
    12     12   eval tcltest::configure $argv
    13     13   tcltest::loadTestedCommands
    14     14   
           15  +testConstraint x11 [expr {[tk windowingsystem] eq "x11"}]
           16  +
    15     17   # eatColors --
    16     18   # Creates a toplevel window and allocates enough colors in it to
    17     19   # use up all the slots in the colormap.
    18     20   #
    19     21   # Arguments:
    20     22   # w -		Name of toplevel window to create.
    21     23   
................................................................................
    47     49   #			to see if there are colormap entries free.
    48     50   
    49     51   proc colorsFree {w {red 31} {green 245} {blue 192}} {
    50     52       set vals [winfo rgb $w [format #%02x%02x%02x $red $green $blue]]
    51     53       expr {([lindex $vals 0]/256 == $red) && ([lindex $vals 1]/256 == $green)
    52     54   	    && ([lindex $vals 2]/256 == $blue)}
    53     55   }
           56  +
           57  +# uniq --
           58  +#
           59  +# Returns the unique items of a list in the order they first appear.
           60  +#
           61  +# Arguments:
           62  +# list -		The list to uniq-ify.
           63  +proc uniq {list} {
           64  +    set d {}
           65  +    foreach item $list {
           66  +	dict set d $item {}
           67  +    }
           68  +    return [dict keys $d]
           69  +}
    54     70   
    55     71   test frame-1.1 {frame configuration options} -setup {
    56     72       deleteWindows
    57     73   } -body {
    58     74       frame .f -class NewFrame
    59     75       .f configure -class
    60     76   } -cleanup {
................................................................................
   420    436   test frame-2.14 {toplevel configuration options} -setup {
   421    437       deleteWindows
   422    438   } -body {
   423    439       toplevel .t -width 200 -height 100 -visual who_knows?
   424    440   } -cleanup {
   425    441       deleteWindows
   426    442   } -returnCodes error -result {unknown or ambiguous visual name "who_knows?": class must be best, directcolor, grayscale, greyscale, pseudocolor, staticcolor, staticgray, staticgrey, truecolor, or default}
   427         -test frame-2.15 {toplevel configuration options} -constraints haveDISPLAY -setup {
          443  +test frame-2.15 {toplevel configuration options} -constraints {x11 haveDISPLAY} -setup {
   428    444       deleteWindows
   429    445   } -body {
   430    446       toplevel .t -width 200 -height 100 -screen $env(DISPLAY)
   431    447       wm geometry .t +0+0
   432    448       string compare [.t configure -screen] "-screen screen Screen {} $env(DISPLAY)"
   433    449   } -cleanup {
   434    450       deleteWindows
   435    451   } -result {0}
   436         -test frame-2.16 {toplevel configuration options} -constraints haveDISPLAY -setup {
          452  +test frame-2.16 {toplevel configuration options} -constraints {x11 haveDISPLAY} -setup {
   437    453       deleteWindows
   438    454   } -body {
   439    455       toplevel .t -width 200 -height 100 -screen $env(DISPLAY)
   440    456       wm geometry .t +0+0
   441    457       .t configure -screen another
   442    458   } -cleanup {
   443    459       deleteWindows
................................................................................
  1581   1597   } -cleanup {
  1582   1598       catch {image delete gorp}
  1583   1599       deleteWindows
  1584   1600   } -result {gorp 1 gorp}
  1585   1601   test frame-15.6 {TIP 262: frame background images} -setup {
  1586   1602       deleteWindows
  1587   1603       set result {}
         1604  +    . configure -width 200 -height 200
  1588   1605   } -constraints testImageType -body {
  1589   1606       image create test gorp -variable result
  1590   1607       pack [frame .f -width 100 -height 100 -bgimg gorp]
  1591         -    update idletasks; update; update idletasks; update
  1592         -    return $result
         1608  +    update idletasks; update
         1609  +    raise [winfo parent .f];	# Try to make sure the frame fully repaints
         1610  +    update idletasks; update
         1611  +    return [uniq $result]
  1593   1612   } -cleanup {
  1594   1613       deleteWindows
  1595   1614       catch {image delete gorp}
  1596   1615   } -result {{gorp get} {gorp display 0 0 30 15}}
         1616  +test frame-15.6a {TIP 262: frame background images (offsets)} -setup {
         1617  +    deleteWindows
         1618  +    set result {}
         1619  +    . configure -width 200 -height 200
         1620  +} -constraints testImageType -body {
         1621  +    image create test gorp -variable result
         1622  +    pack [frame .f -width 10 -height 10 -bgimg gorp]
         1623  +    update idletasks; update
         1624  +    raise [winfo parent .f];	# Try to make sure the frame fully repaints
         1625  +    update idletasks; update
         1626  +    return [uniq $result]
         1627  +} -cleanup {
         1628  +    deleteWindows
         1629  +    catch {image delete gorp}
         1630  +} -result {{gorp get} {gorp display 10 2 10 10}}
  1597   1631   test frame-15.7 {TIP 262: frame background images} -setup {
  1598   1632       deleteWindows
  1599   1633       set result {}
         1634  +    . configure -width 200 -height 200
  1600   1635   } -constraints testImageType -body {
  1601   1636       image create test gorp -variable result
  1602   1637       pack [frame .f -width 50 -height 25 -bgimg gorp -tile 1]
  1603         -    update idletasks; update; update idletasks; update
  1604         -    return $result
         1638  +    update idletasks; update
         1639  +    raise [winfo parent .f];	# Try to make sure the frame fully repaints
         1640  +    update idletasks; update
         1641  +    return [uniq $result]
  1605   1642   } -cleanup {
  1606   1643       deleteWindows
  1607   1644       catch {image delete gorp}
  1608   1645   } -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}}
         1646  +test frame-15.7a {TIP 262: frame background images (offsets)} -setup {
         1647  +    deleteWindows
         1648  +    set result {}
         1649  +    . configure -width 200 -height 200
         1650  +} -constraints testImageType -body {
         1651  +    image create test gorp -variable result
         1652  +    pack [frame .f -width 50 -height 25 -bgimg gorp -tile 1 -highlightthick 1]
         1653  +    update idletasks; update
         1654  +    raise [winfo parent .f];	# Try to make sure the frame fully repaints
         1655  +    update idletasks; update
         1656  +    return [uniq $result]
         1657  +} -cleanup {
         1658  +    deleteWindows
         1659  +    catch {image delete gorp}
         1660  +} -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}}
         1661  +test frame-15.7b {TIP 262: frame background images (offsets)} -setup {
         1662  +    deleteWindows
         1663  +    set result {}
         1664  +    . configure -width 200 -height 200
         1665  +} -constraints testImageType -body {
         1666  +    image create test gorp -variable result
         1667  +    pack [frame .f -width 50 -height 25 -bgimg gorp -tile 1 -bd 2]
         1668  +    update idletasks; update
         1669  +    raise [winfo parent .f];	# Try to make sure the frame fully repaints
         1670  +    update idletasks; update
         1671  +    return [uniq $result]
         1672  +} -cleanup {
         1673  +    deleteWindows
         1674  +    catch {image delete gorp}
         1675  +} -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}}
         1676  +test frame-15.7c {TIP 262: frame background images (offsets)} -setup {
         1677  +    deleteWindows
         1678  +    set result {}
         1679  +    . configure -width 200 -height 200
         1680  +} -constraints testImageType -body {
         1681  +    image create test gorp -variable result
         1682  +    pack [frame .f -width 50 -height 25 -bgimg gorp -tile 1 -bd 2 -highlightthick 1]
         1683  +    update idletasks; update
         1684  +    raise [winfo parent .f];	# Try to make sure the frame fully repaints
         1685  +    update idletasks; update
         1686  +    return [uniq $result]
         1687  +} -cleanup {
         1688  +    deleteWindows
         1689  +    catch {image delete gorp}
         1690  +} -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}}
  1609   1691   test frame-15.8 {TIP 262: toplevel background images} -setup {
  1610   1692       deleteWindows
  1611   1693       image create photo gorp -width 10 -height 10
  1612   1694       gorp put black -to 2 2 7 7
  1613   1695   } -body {
  1614         -    toplevel .f -width 100 -height 100
  1615         -    list [image inuse gorp] [.f configure -backgroundimage gorp;update] \
  1616         -	[image inuse gorp] [winfo width .f] [winfo height .f]
         1696  +    toplevel .t -width 100 -height 100
         1697  +    update
         1698  +    # Used to verify that setting a background image doesn't change the widget size
         1699  +    set w [winfo width .t]
         1700  +    set h [winfo height .t]
         1701  +    list [image inuse gorp] [.t configure -backgroundimage gorp;update] \
         1702  +	[image inuse gorp] \
         1703  +	[expr {$w-[winfo width .t]}] [expr {$h-[winfo height .t]}]
  1617   1704   } -cleanup {
  1618   1705       image delete gorp
  1619   1706       deleteWindows
  1620         -} -result {0 {} 1 100 100}
         1707  +} -result {0 {} 1 0 0}
  1621   1708   test frame-15.9 {TIP 262: toplevel background images} -setup {
  1622   1709       deleteWindows
  1623   1710       catch {rename gorp ""}
  1624   1711   } -body {
  1625         -    toplevel .f -width 100 -height 100
         1712  +    toplevel .t -width 100 -height 100
  1626   1713       update
  1627         -    .f configure -backgroundimage gorp
         1714  +    .t configure -backgroundimage gorp
  1628   1715   } -returnCodes error -cleanup {
  1629   1716       deleteWindows
  1630   1717   } -result {image "gorp" doesn't exist}
  1631   1718   test frame-15.10 {TIP 262: toplevel background images} -setup {
  1632   1719       deleteWindows
  1633   1720       image create photo gorp -width 10 -height 10
  1634   1721       gorp put black -to 2 2 7 7
  1635   1722   } -body {
  1636         -    toplevel .f -width 100 -height 100 -backgroundimage gorp -tile yes
         1723  +    toplevel .t -width 100 -height 100 -backgroundimage gorp -tile yes
  1637   1724       update
  1638         -    list [.f cget -bgimg] [.f cget -tile]
         1725  +    list [.t cget -bgimg] [.t cget -tile]
  1639   1726   } -cleanup {
  1640   1727       image delete gorp
  1641   1728       deleteWindows
  1642   1729   } -result {gorp 1}
  1643   1730   test frame-15.11 {TIP 262: toplevel background images} -setup {
  1644   1731       deleteWindows
  1645   1732       image create photo gorp -width 10 -height 10
  1646   1733       gorp put black -to 2 2 7 7
  1647   1734   } -body {
  1648         -    toplevel .f -width 100 -height 100 -backgroundimage gorp -tile yes
         1735  +    toplevel .t -width 100 -height 100 -backgroundimage gorp -tile yes
  1649   1736       update
  1650   1737       gorp put red -to 15 15 20 20
  1651   1738       update
  1652         -    list [.f cget -bgimg] [.f cget -tile]
         1739  +    list [.t cget -bgimg] [.t cget -tile]
  1653   1740   } -cleanup {
  1654   1741       image delete gorp
  1655   1742       deleteWindows
  1656   1743   } -result {gorp 1}
  1657   1744   test frame-15.12 {TIP 262: toplevel background images} -setup {
  1658   1745       deleteWindows
  1659   1746       image create photo gorp -width 10 -height 10
  1660   1747       gorp put black -to 2 2 7 7
  1661   1748       set result {}
  1662   1749   } -body {
  1663         -    toplevel .f -width 100 -height 100 -backgroundimage gorp -tile yes
         1750  +    toplevel .t -width 100 -height 100 -backgroundimage gorp -tile yes
  1664   1751       update
  1665   1752       image delete gorp
  1666   1753       update
  1667         -    set result [list [.f cget -bgimg] [.f cget -tile]]
         1754  +    set result [list [.t cget -bgimg] [.t cget -tile]]
  1668   1755       image create photo gorp -width 250 -height 250
  1669   1756       update
  1670         -    lappend result [.f cget -backgroundimage]
         1757  +    lappend result [.t cget -backgroundimage]
  1671   1758   } -cleanup {
  1672   1759       catch {image delete gorp}
  1673   1760       deleteWindows
  1674   1761   } -result {gorp 1 gorp}
  1675   1762   test frame-15.13 {TIP 262: toplevel background images} -setup {
  1676   1763       deleteWindows
  1677   1764       set result {}
  1678   1765   } -constraints testImageType -body {
  1679   1766       image create test gorp -variable result
  1680         -    toplevel .f -width 100 -height 100 -bgimg gorp
  1681         -    wm overrideredirect .f 1;	# Reduce trouble from window managers
  1682         -    update idletasks; update; update idletasks; update
  1683         -    return $result
         1767  +    toplevel .t -width 100 -height 100 -bgimg gorp
         1768  +    wm overrideredirect .t 1;	# Reduce trouble from window managers
         1769  +    update idletasks; update
         1770  +    raise .t;			# Try to make sure the toplevel fully repaints
         1771  +    update idletasks; update
         1772  +    return [uniq $result]
  1684   1773   } -cleanup {
  1685   1774       deleteWindows
  1686   1775       catch {image delete gorp}
  1687   1776   } -result {{gorp get} {gorp display 0 0 30 15}}
  1688   1777   test frame-15.14 {TIP 262: toplevel background images} -setup {
  1689   1778       deleteWindows
  1690   1779       set result {}
  1691   1780   } -constraints testImageType -body {
  1692   1781       image create test gorp -variable result
  1693         -    toplevel .f -width 50 -height 25 -bgimg gorp -tile 1
  1694         -    wm overrideredirect .f 1;	# Reduce trouble from window managers
  1695         -    update idletasks; update; update idletasks; update
  1696         -    return $result
         1782  +    toplevel .t -width 50 -height 25 -bgimg gorp -tile 1
         1783  +    wm overrideredirect .t 1;	# Reduce trouble from window managers
         1784  +    update idletasks; update
         1785  +    raise .t;			# Try to make sure the toplevel fully repaints
         1786  +    update idletasks; update
         1787  +    return [uniq $result]
  1697   1788   } -cleanup {
  1698   1789       deleteWindows
  1699   1790       catch {image delete gorp}
  1700   1791   } -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}}
  1701   1792   
  1702   1793   # cleanup
  1703   1794   cleanupTests
  1704   1795   return
  1705   1796   
  1706   1797   # Local Variables:
  1707   1798   # mode: tcl
  1708   1799   # End: