Toplevel widgets in a tree hierarchy: the test suite

 # wtree.test --
 # 
 # Part of: wtree
 # Contents: tests for the wtree package
 # Date: Sun Sep 21, 2003
 # 
 # Abstract
 # 
 # 
 # 
 # Copyright (c) 2003 Marco Maggi
 # 
 # The author  hereby grant permission to use,  copy, modify, distribute,
 # and  license this  software  and its  documentation  for any  purpose,
 # provided that  existing copyright notices  are retained in  all copies
 # and that  this notice  is included verbatim  in any  distributions. No
 # written agreement, license, or royalty  fee is required for any of the
 # authorized uses.  Modifications to this software may be copyrighted by
 # their authors and need not  follow the licensing terms described here,
 # provided that the new terms are clearly indicated on the first page of
 # each file where they apply.
 # 
 # IN NO  EVENT SHALL THE AUTHOR  OR DISTRIBUTORS BE LIABLE  TO ANY PARTY
 # FOR  DIRECT, INDIRECT, SPECIAL,  INCIDENTAL, OR  CONSEQUENTIAL DAMAGES
 # ARISING OUT  OF THE  USE OF THIS  SOFTWARE, ITS DOCUMENTATION,  OR ANY
 # DERIVATIVES  THEREOF, EVEN  IF THE  AUTHOR  HAVE BEEN  ADVISED OF  THE
 # POSSIBILITY OF SUCH DAMAGE.
 # 
 # THE  AUTHOR  AND DISTRIBUTORS  SPECIFICALLY  DISCLAIM ANY  WARRANTIES,
 # INCLUDING,   BUT   NOT  LIMITED   TO,   THE   IMPLIED  WARRANTIES   OF
 # MERCHANTABILITY,    FITNESS   FOR    A    PARTICULAR   PURPOSE,    AND
 # NON-INFRINGEMENT.  THIS  SOFTWARE IS PROVIDED  ON AN "AS  IS" BASIS,
 # AND  THE  AUTHOR  AND  DISTRIBUTORS  HAVE  NO  OBLIGATION  TO  PROVIDE
 # MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
 # 
 # $Id: 9989,v 1.2 2003-09-27 08:00:35 jcw Exp $

 package require Tcl 8.4
 package require tcltest 2.2

 ::tcltest::configure -verbose "pass error" \
        -testdir [file dirname [file normalize [info script]]]
 eval ::tcltest::configure $argv

 source [file join [file dirname [info script]] wtree.tcl]

 namespace eval ::test {

    variable    delay 200
    tk::wm withdraw .

    proc wait {} {
        update
        update idletasks
        after 200
    }

    proc data_window { window parent } {
        make_toplevel $window $parent
        tk::wm title $window "Data Window ($window)"

        wtree::register $window $parent
        wtree::set_focus_mode   $window keep
        return $window
    }

    proc dialog_window { window parent } {
        make_toplevel $window $parent
        tk::wm title $window "Dialog ($window)"

        wtree::register $window $parent
        wtree::set_focus_mode   $window ontop
        wtree::set_focus_window $parent $window
        return $window
    }

    proc error_window { window parent } {
        make_toplevel $window $parent
        tk::wm title $window "Error ($window)"

        wtree::register $window $parent
        wtree::set_focus_mode   $window keep
        wtree::set_focus_window $parent $window
        return $window
    }

    proc make_toplevel { window parent } {
        tk::toplevel $window
        tk::wm positionfrom $window program
        set g [tk::wm geometry $parent]
        scan $g "%dx%d+%d+%d" width height x y
        tk::wm geometry $window \
                [format "300x100+%d+%d" [expr {$x+60}] [expr {$y+90}]]
        return $window
    }

 #PAGE

 ::tcltest::test wtree-1.1 "register/unregister" {
    -setup      {
        tk::toplevel .t
    }
    -body       {
        set res [wtree::exists .t]
        wtree::register .t
        lappend res [wtree::exists .t]
        wtree::forget .t
        lappend res [wtree::exists .t]
    }
    -result {0 1 0}
    -cleanup    {
        tk::destroy .t
        unset -nocomplain res
    }
 }

 ::tcltest::test wtree-1.2 "register/destroy" {
    -setup      {
        tk::toplevel .t
    }
    -body       {
        set res [wtree::exists .t]
        wtree::register .t
        lappend res [wtree::exists .t]
        tk::destroy .t
        lappend res [wtree::exists .t]
    }
    -result {0 1 0}
    -cleanup    {
        unset -nocomplain res
    }
 }

 #PAGE

 ::tcltest::test wtree-2.1 "data->error" {
    -setup      {
        data_window .dataw .
        tk::focus .dataw
        wait
        error_window .errorw .dataw
        tk::focus .errorw
        wait
    }
    -body       {
        lappend res [tk::focus] \
                [tk::wm stackorder .errorw isabove .dataw]
        tk::focus .dataw
        wait
        lappend res [tk::focus] \
                [tk::wm stackorder .errorw isabove .dataw]
    }
    -result     ".errorw 1 .errorw 1"
    -cleanup    {
        tk::destroy .errorw .dataw
        unset -nocomplain errorw dataw res
    }
 }

 ::tcltest::test wtree-2.2 "data->dialog" {
    -setup      {
        data_window .dataw .
        tk::focus .dataw
        wait
        dialog_window .dialogw .dataw
        tk::focus .dialogw
        wait
    }
    -body       {
        lappend res [tk::focus] \
                [tk::wm stackorder .dialogw isabove .dataw]

        tk::focus .dataw
        wait
        lappend res [tk::focus] \
                [tk::wm stackorder .dialogw isabove .dataw]

        tk::focus .dialogw
        wait
        lappend res [tk::focus] \
                [tk::wm stackorder .dialogw isabove .dataw]
    }
    -result     ".dialogw 1 .dataw 1 .dialogw 1"
    -cleanup    {
        tk::destroy .dialogw .dataw
        unset -nocomplain res
    }
 }

 ::tcltest::test wtree-2.3 "data->dialog->error, focus all" {
    -setup      {
        data_window .dataw .
        tk::focus .dataw
        wait
        dialog_window .dialogw .dataw
        tk::focus .dialogw
        wait
        error_window .errorw .dialogw
        tk::focus .errorw
        wait
    }
    -body       {
        lappend res [tk::focus] \
                [tk::wm stackorder .errorw  isabove .dialogw] \
                [tk::wm stackorder .dialogw isabove .dataw]

        tk::focus .dialogw
        wait
        lappend res [tk::focus] \
                [tk::wm stackorder .errorw  isabove .dialogw] \
                [tk::wm stackorder .dialogw isabove .dataw]

        tk::focus .dataw
        wait
        lappend res [tk::focus] \
                [tk::wm stackorder .errorw  isabove .dialogw] \
                [tk::wm stackorder .dialogw isabove .dataw]

        tk::focus .errorw
        wait
        lappend res [tk::focus] \
                [tk::wm stackorder .errorw  isabove .dialogw] \
                [tk::wm stackorder .dialogw isabove .dataw]
    }
    -result     ".errorw 1 1 .errorw 1 1 .errorw 1 1 .errorw 1 1"
    -cleanup    {
        tk::destroy .dialogw .errorw .dataw
        unset -nocomplain res
    }
 }

 ::tcltest::test wtree-2.4 "data->dialog|error, focus dialog" {
    -setup      {
        data_window .dataw .
        tk::focus .dataw
        wait
        dialog_window .dialogw .dataw
        tk::focus .dialogw
        wait
        error_window .errorw .dataw
        tk::focus .errorw
        wait
    }
    -body       {
        lappend res [tk::focus]
        tk::focus .dialogw
        wait
        lappend res [tk::focus] \
                [tk::wm stackorder .errorw isabove .dialogw] \
                [tk::wm stackorder .errorw isabove .dataw]
    }
    -result     ".errorw .errorw 1 1"
    -cleanup    {
        tk::destroy .dialogw .errorw .dataw
        unset -nocomplain res
    }
 }

 ::tcltest::test wtree-2.5 "data->dialog->error, data->dialog->error" {
    -setup      {
        data_window .dataw1 .
        tk::focus .dataw1
        wait
        dialog_window .dialogw1 .dataw1
        tk::focus .dialogw1
        wait
        error_window .errorw1 .dialogw1
        tk::focus .errorw1
        wait

        data_window .dataw2 .
        tk::focus .dataw2
        wait
        dialog_window .dialogw2 .dataw2
        tk::focus .dialogw2
        wait
        error_window .errorw2 .dialogw2
        tk::focus .errorw2
        wait
    }
    -body       {
        lappend res [tk::focus] \
                [tk::wm stackorder .errorw1  isabove .dialogw1] \
                [tk::wm stackorder .dialogw1 isabove .dataw1] \
                [tk::wm stackorder .errorw2  isabove .dialogw2] \
                [tk::wm stackorder .dialogw2 isabove .dataw2]

        tk::focus .dialogw2
        wait

        lappend res [tk::focus] \
                [tk::wm stackorder .errorw1  isabove .dialogw1] \
                [tk::wm stackorder .dialogw1 isabove .dataw1] \
                [tk::wm stackorder .errorw2  isabove .dialogw2] \
                [tk::wm stackorder .dialogw2 isabove .dataw2]

        tk::focus .dataw2
        wait

        lappend res [tk::focus] \
                [tk::wm stackorder .errorw1  isabove .dialogw1] \
                [tk::wm stackorder .dialogw1 isabove .dataw1] \
                [tk::wm stackorder .errorw2  isabove .dialogw2] \
                [tk::wm stackorder .dialogw2 isabove .dataw2]

        tk::focus .dataw1
        wait

        lappend res [tk::focus] \
                [tk::wm stackorder .errorw1  isabove .dialogw1] \
                [tk::wm stackorder .dialogw1 isabove .dataw1] \
                [tk::wm stackorder .errorw2  isabove .dialogw2] \
                [tk::wm stackorder .dialogw2 isabove .dataw2]

        tk::focus .dialogw1
        wait

        lappend res [tk::focus] \
                [tk::wm stackorder .errorw1  isabove .dialogw1] \
                [tk::wm stackorder .dialogw1 isabove .dataw1] \
                [tk::wm stackorder .errorw2  isabove .dialogw2] \
                [tk::wm stackorder .dialogw2 isabove .dataw2]

        tk::focus .errorw2
        wait

        lappend res [tk::focus] \
                [tk::wm stackorder .errorw1  isabove .dialogw1] \
                [tk::wm stackorder .dialogw1 isabove .dataw1] \
                [tk::wm stackorder .errorw2  isabove .dialogw2] \
                [tk::wm stackorder .dialogw2 isabove .dataw2]
    }
    -result     ".errorw2 1 1 1 1 .errorw2 1 1 1 1 .errorw2 1 1 1 1 .errorw1 1 1 1 1 .errorw1 1 1 1 1 .errorw2 1 1 1 1"
    -cleanup    {
        tk::destroy .dialogw .errorw .dataw
        unset -nocomplain res
    }
 }

 #PAGE

 ::tcltest::test wtree-3.1 "data->error, iconify" {
    -setup      {
        data_window .dataw .
        tk::focus .dataw
        wait
        error_window .errorw .dataw
        tk::focus .errorw
        wait
    }
    -body       {
        tk::wm iconify .dataw
        wait
        lappend res [tk::wm state .dataw] [tk::wm state .errorw]

        tk::wm deiconify .dataw
        wait
        lappend res \
                [tk::wm state .dataw] \
                [tk::wm state .errorw] \
                [string equal [tk::focus] .errorw] \
                [tk::wm stackorder .errorw isabove .dataw]
    }
    -result     "iconic withdrawn normal normal 1 1"
    -cleanup    {
        tk::destroy .errorw .dataw
        unset -nocomplain res
    }
 }

 ::tcltest::test wtree-3.2 "data->dialog, iconify" {
    -setup      {
        data_window .dataw .
        tk::focus .dataw
        wait
        dialog_window .dialogw .dataw
        tk::focus .dialogw
        wait
    }
    -body       {
        tk::wm iconify .dataw
        wait
        lappend res [tk::wm state .dataw] [tk::wm state .dialogw]

        tk::wm deiconify .dataw
        wait
        lappend res \
                [tk::wm state .dataw] \
                [tk::wm state .dialogw] \
                [string equal [tk::focus] .dialogw] \
                [tk::wm stackorder .dialogw isabove .dataw]
    }
    -result     "iconic withdrawn normal normal 1 1"
    -cleanup    {
        tk::destroy .dialogw .dataw
        unset -nocomplain res
    }
 }

 ::tcltest::test wtree-3.3 "data->dialog->error, iconify" {
    -setup      {
        data_window .dataw .
        tk::focus .dataw
        wait
        dialog_window .dialogw .dataw
        tk::focus .dialogw
        wait
        error_window .errorw .dialogw
        tk::focus .errorw
        wait
    }
    -body       {
        tk::wm iconify .dataw
        wait
        lappend res \
                [tk::wm state .dataw] \
                [tk::wm state .dialogw] \
                [tk::wm state .errorw]

        tk::wm deiconify .dataw
        wait
        lappend res \
                [tk::wm state .dataw] \
                [tk::wm state .dialogw] \
                [tk::wm state .errorw] \
                [string equal [tk::focus] .errorw] \
                [tk::wm stackorder .errorw isabove .dialogw] \
                [tk::wm stackorder .dialogw isabove .dataw]
    }
    -result     "iconic withdrawn withdrawn normal normal normal 1 1 1"
    -cleanup    {
        tk::destroy .dialogw .errorw .dataw
        unset -nocomplain res
    }
 }

 ::tcltest::test wtree-3.4 "data->dialog|error, iconify" {
    -setup      {
        data_window .dataw .
        tk::focus .dataw
        wait
        dialog_window .dialogw .dataw
        tk::focus .dialogw
        wait
        error_window .errorw .dataw
        tk::focus .errorw
        wait
    }
    -body       {
        tk::wm iconify .dataw
        wait
        lappend res \
                [tk::wm state .dataw] \
                [tk::wm state .dialogw] \
                [tk::wm state .errorw]

        tk::wm deiconify .dataw
        wait
        lappend res \
                [tk::wm state .dataw] \
                [tk::wm state .dialogw] \
                [tk::wm state .errorw] \
                [string equal [tk::focus] .errorw] \
                [tk::wm stackorder .errorw isabove .dataw] \
                [tk::wm stackorder .errorw isabove .dialogw]
    }
    -result     "iconic withdrawn withdrawn normal normal normal 1 1 1"
    -cleanup    {
        tk::destroy .dialogw .errorw .dataw
        unset -nocomplain res
    }
 }

 ::tcltest::cleanupTests
 }
 namespace delete ::test

 ### end of file
 # Local Variables:
 # mode: tcl
 # page-delimiter: "^#PAGE"
 # End: