# wtree.tcl --
 # 
 # Part of: wtree
 # Contents: the package
 # Date: Sun Sep 21, 2003
 # 
 # Abstract
 # 
 #      This module provides the ability to organise toplevel widgets
 #      in a tree hierarchy and to define groups in it. Groups are used
 #      map/unmap sets of windows together and to configure windows to
 #      give the focus to other selected windows.
 # 
 # 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: 9988,v 1.4 2006-11-28 19:00:35 jcw Exp $

 package require Tk 8.4

 namespace eval tk {
    namespace export \[a-z\]*

    set ns [namespace current]
    foreach c {
        bind            bindtags        button          canvas
        checkbutton     destroy         entry           focus
        frame           grid            label           listbox
        lower           menu            menubutton      message
        option          pack            place           radiobutton
        raise           scrollbar       spinbox         text 
        toplevel        wm              winfo           image
        labelframe      scale           event           font
        tk
    } {
        interp alias {} ${ns}::$c {} ::$c
    }
    interp alias {} ${ns}::wait  {} ::tkwait
    unset ns c
 }

 namespace eval base {
    namespace export \[a-z\]*
    namespace eval tk { namespace import ::tk::bindtags }
 }

 proc base::tagadd { widget tag {pos 1} } {
    tk::bindtags $widget [linsert [tk::bindtags $widget] $pos $tag]
 } 

 proc base::tagdel { widget tag } {
    set idx [lsearch [set lst [tk::bindtags $widget]] $tag]
    tk::bindtags $widget [lreplace $lst $idx $idx]
 }

 namespace eval wtree {
    namespace eval tk           {
        namespace import ::tk::focus ::tk::wm \
                ::tk::raise ::tk::bind ::tk::winfo
    }
    namespace eval base         {
        namespace import ::base::tagadd ::base::tagdel
    }

    # This is the  variable in which the tree is  stored.  The keys have
    # the format "<window>:<attribute>",  where <window> is the pathname
    # of the toplevel window.

    variable    tree
    set tree(.:parent)          .
    set tree(.:children)        {}
    set tree(.:tofocus)         {}
    set tree(.:focusmode)       keep
    set tree(.:ismapped)        0

    set ns [namespace current]

    tk::bind UWPTagWTreeWindow <FocusIn>        "+${ns}::focus %W"
    tk::bind UWPTagWTreeWindow <Destroy>        "+${ns}::forget %W"
    tk::bind UWPTagWTreeWindow <Map>            "+${ns}::map %W"
    tk::bind UWPTagWTreeWindow <Unmap>          "+${ns}::unmap %W"

    unset ns
 }

 proc wtree::register { window {parent .} } {
    variable    tree


    lappend tree($parent:children) $window
    set tree($window:parent)    $parent
    set tree($window:children)  {}
    set tree($window:tofocus)   {}
    set tree($window:focusmode) keep
    set tree($window:ismapped)  [tk::winfo ismapped $window]

    base::tagadd $window UWPTagWTreeWindow
    return
 }

 proc wtree::forget { window } {
    variable    tree

    
    # Remove the window from its parent list.
    set parent $tree($window:parent)
    set idx [lsearch [set lst $tree($parent:children)] $window]
    set tree($parent:children) [lreplace $lst $idx $idx]

    if { [string equal $tree($parent:tofocus) $window] } {
        set tree($parent:tofocus) {}
    }

    # Make the children sons of the root window.
    foreach child $tree($window:children) {
        set tree($child:parent) .
    }

    # Free resources.
    unset tree($window:parent) tree($window:children) \
            tree($window:tofocus) tree($window:focusmode) \
            tree($window:ismapped)

    # Remove the wtree tag from the window's tag list.
    base::tagdel $window UWPTagWTreeWindow
    return
 }

 proc wtree::exists { window } {
    variable    tree
    return [info exists tree($window:children)]
 }

 proc wtree::get_root_windows {} {
    variable    tree
    return $tree(.:children)
 }

 proc wtree::get_window_parent { window } {
    variable    tree
    return $tree($window:parent)
 }

 proc wtree::get_window_children { window } {
    variable    tree
    return $tree($window:children)
 }

 proc wtree::set_focus_mode { window mode } {
    variable    tree
    set tree($window:focusmode) $mode
 }

 proc wtree::set_focus_window { window child } {
    variable    tree
    set tree($window:tofocus) $child
 }

 proc wtree::focus { window } {
    variable    tree

     if { ! $tree($window:ismapped) } {
         return
     }

    # Scenario: a data  window is created and takes  the focus; an ontop
    # dialog window  is created  as child of  the data window;  the data
    # window takes the focus; an error window is created as child of the
    # data window and  takes the focus; a request is  sent to the dialog
    # window to take the focus.
    #
    # In  this  case  the  dialog  must  give  the  focus  to  the  data
    # window.

    set parent $tree($window:parent)
    if { ! [string equal $parent .] } {
        set ptf $tree($parent:tofocus)
        if {
            [string equal $tree($window:focusmode) ontop] &&
            ([string length $ptf] != 0) && (! [string equal $ptf $window])
        } {
            tk::focus $parent
            return 0
        }
    }

    # If this window has no focus-thief registered: focus it and return.

    tk::raise $window
    set tofocus $tree($window:tofocus)
    if { [string length $tofocus] == 0 } {
        tk::focus $window
        return 1
    }

    # This window  has a  focus-thief registered. If  its focus  mode is
    # "keep" focus it and return.
    #
    # If its mode is "ontop":  raise it. Then descend the tree following
    # the path  of "tofocus" windows, raising  all of them:  if a window
    # with no focus-thief is found: return; if a window with "keep" mode
    # is found: focus it and return.

    tk::wm deiconify $tofocus
    switch $tree($tofocus:focusmode) {
        keep    {
            tk::focus $tofocus
            return 0
        }
        ontop   {
            tk::raise $tofocus
            set child $tree($tofocus:tofocus)
            while { [string length $child] } {
                if { [string equal $tree($child:focusmode) keep] } {
                    tk::focus $child
                    return 0
                }
                set child $tree($child:tofocus)
            }
        }
    }
    return 1
 }

 #        If this window: is not a root window, is registered
 #      as focus-thief for its parent; and the parent window: is
 #      not mapped; then the parent window is mapped.
 #
 #        If this window has a focus-thief and this child window is
 #      not mapped: it's mapped.
 #
 #        If one of the children of this window has focus mode set
 #      to "ontop" and is unmapped: it's mapped.
 #

 proc wtree::map { window } {
    variable    tree


    set tree($window:ismapped) 1

    if {
        [string equal $tree($window:focusmode) keep] ||
        [string equal $tree($window:focusmode) ontop]
    } {
        set parent $tree($window:parent)
        if {
            [string length $parent] &&
            [string equal $tree($parent:tofocus) $window] &&
            (! $tree($parent:ismapped))
        } {
            tk::wm deiconify $parent
            set tree($parent:ismapped) 1
        }
    }

    set tofocus $tree($window:tofocus)
    if { [string length $tofocus] && (! $tree($tofocus:ismapped)) } {
        tk::wm deiconify $tofocus
        set tree($tofocus:ismapped) 1
    }

    foreach child $tree($window:children) {
        if { [string equal $tofocus $child] } { continue }
        if {
            [string equal $tree($child:focusmode) ontop] ||
            (! $tree($child:ismapped))
        } {
            tk::wm deiconify $child
            set tree($child:ismapped) 1
        }
    }
    return
 }

 #      Registers the event in the "ismapped" state of the window.
 #
 #        If this window: is not a root window, is registered
 #      as focus-thief for its parent; and the parent window: is
 #      mapped; then the parent window is unmapped.
 #
 #        If this window has a focus-thief and this child window is
 #      mapped: it's unmapped.
 #
 #        If one of the children of this window has focus mode set
 #      to "ontop" ans is mapped: it's unmapped.
 #
 #       Returns the empty string.

 proc wtree::unmap { window } {
    variable    tree


    set tree($window:ismapped) 0

    if {
        [string equal $tree($window:focusmode) keep] ||
        [string equal $tree($window:focusmode) ontop]
    } {
        set parent $tree($window:parent)
        if {
            [string length $parent] &&
            [string equal $tree($parent:tofocus) $window] &&
            ($tree($parent:ismapped))
        } {
            tk::wm withdraw $window
            tk::wm iconify $parent
            set tree($parent:ismapped) 0
        }
    }

    set tofocus $tree($window:tofocus)
    if { [string length $tofocus] && ($tree($tofocus:ismapped)) } {
        tk::wm withdraw $tofocus
        set tree($tofocus:ismapped) 0
    }

    foreach child $tree($window:children) {
        if { [string equal $tofocus $child] } { continue }
        if {
            [string equal $tree($child:focusmode) ontop] &&
            ($tree($child:ismapped))
        } {
            tk::wm withdraw $child
            set tree($child:ismapped) 0
        }
    }
    return
 }
 
 ### end of file

----
[Category Widget]