Toplevel widgets in a tree hierarchy: a script to play

 # playwtree.tcl --
 # 
 # Part of: wtree
 # Contents: a script to play with the package
 # Date: Sun Sep 21, 2003
 # 
 # Abstract
 # 
 #      This is a script to play with the "wtree.tcl" package.
 # 
 # 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: 9990,v 1.2 2003-09-27 08:00:36 jcw Exp $
 
 source [file join [file dirname [info script]] wtree.tcl]

 set counter 0

 proc main { argc argv } {
    global      forever


    tk::wm geometry     . +10+10
    tk::wm title                . "UWP Test"

    set bbar .buttonbar
    tk::frame $bbar
    tk::grid $bbar

    set q $bbar.quit
    tk::button $q -text "Quit" -command { set ::forever 1 }
    tk::bind   $q <Return> "$q invoke"
    tk::bind   .  <Escape> "$q invoke"
    tk::grid   $q

    set f .widgets
    tk::frame $f -relief ridge -borderwidth 2
    tk::grid $f -sticky news \
            -ipadx 5m -ipady 5m \
            -padx  5m -pady  5m

    tk::button $f.b -text "Data" -command "data_window ."
    tk::grid $f.b

    tk::focus  $q
    vwait forever
    exit 0
 }

 proc data_window { parent } {
    set window [unique]
    make_toplevel $window $parent
    tk::wm title $window "Data Window ($window)"
    
    wtree::register $window $parent
    wtree::set_focus_mode       $window keep

    button $window.data -text "Data" -command "data_window $window"
    button $window.dialog -text "Dialog" -command "dialog_window $window"
    button $window.error -text "Error" -command "error_window $window"
    button $window.dismiss -text "Dismiss" -command "destroy $window"
    grid $window.data $window.dialog $window.error $window.dismiss
    
    return $window
 }

 proc dialog_window { parent } {
    set window [unique]
    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

    button $window.data -text "Data" -command "data_window $window"
    button $window.dialog -text "Dialog" -command "dialog_window $window"
    button $window.error -text "Error" -command "error_window $window"
    button $window.dismiss -text "Dismiss" -command "destroy $window"
    grid $window.data $window.dialog $window.error $window.dismiss

    return $window
 }

 proc error_window { parent } {
    set window [unique]
    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

    button $window.dismiss -text "Dismiss" -command "destroy $window"
    grid $window.dismiss

    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
 }

 proc unique {} {
    global      counter
    return .[incr counter]
 }

 main $argc $argv

 ### end of file
 # Local Variables:
 # mode: tcl
 # End:
Category Example
Toplevel widgets in a tree hierarchy