# 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.1 2003-09-21 08:00:38 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
}
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 ns [namespace current]
tk::bind UWPWTreeWindow <FocusIn> "+${ns}::focus %W"
tk::bind UWPWTreeWindow <Destroy> "+${ns}::forget %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
base::tagadd $window UWPWTreeWindow
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)
# Remove the wtree tag from the window's tag list.
base::tagdel $window UWPWTreeWindow
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
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
}
}
tk::raise $window
set tofocus $tree($window:tofocus)
if { [string length $tofocus] == 0 } {
tk::focus $window
return 1
}
tk::wm deiconify $tofocus
switch $tree($tofocus:focusmode) {
keep {
tk::focus $tofocus
return 0
}
ontop {
tk::wm deiconify $tofocus
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
}
### end of file