source: proiecte/pmake3d/make3d_original/Make3dSingleImageStanford_version0.1/third_party/vrippack-0.31/src/vrip/lib/tk/focus.tcl @ 37

# focus.tcl --
#
# This file defines several procedures for managing the input
# focus.
#
# RCS: @(#) $Id: focus.tcl,v 1.7.2.1 2000/08/05 23:53:13 hobbs Exp $
#
# Copyright (c) 1994-1995 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

# tk_focusNext --
# This procedure returns the name of the next window after "w" in
# "focus order" (the window that should receive the focus next if
# Tab is typed in w).  "Next" is defined by a pre-order search
# of a top-level and its non-top-level descendants, with the stacking
# order determining the order of siblings.  The "-takefocus" options
# on windows determine whether or not they should be skipped.
#
# Arguments:
# w -           Name of a window.

proc tk_focusNext w {
    set cur $w
    while {1} {

        # Descend to just before the first child of the current widget.

        set parent $cur
        set children [winfo children $cur]
        set i -1

        # Look for the next sibling that isn't a top-level.

        while {1} {
            incr i
            if {$i < [llength $children]} {
                set cur [lindex $children $i]
              if {[string equal [winfo toplevel $cur] $cur]} {
                    continue
                } else {
                    break
                }
            }

            # No more siblings, so go to the current widget's parent.
            # If it's a top-level, break out of the loop, otherwise
            # look for its next sibling.

            set cur $parent
            if {[string equal [winfo toplevel $cur] $cur]} {
                break
            }
            set parent [winfo parent $parent]
            set children [winfo children $parent]
            set i [lsearch -exact $children $cur]
        }
        if {[string equal $w $cur] || [tkFocusOK $cur]} {
            return $cur
        }
    }
}

# tk_focusPrev --
# This procedure returns the name of the previous window before "w" in
# "focus order" (the window that should receive the focus next if
# Shift-Tab is typed in w).  "Next" is defined by a pre-order search
# of a top-level and its non-top-level descendants, with the stacking
# order determining the order of siblings.  The "-takefocus" options
# on windows determine whether or not they should be skipped.
#
# Arguments:
# w -           Name of a window.

proc tk_focusPrev w {
    set cur $w
    while {1} {

        # Collect information about the current window's position
        # among its siblings.  Also, if the window is a top-level,
        # then reposition to just after the last child of the window.

        if {[string equal [winfo toplevel $cur] $cur]}  {
            set parent $cur
            set children [winfo children $cur]
            set i [llength $children]
        } else {
            set parent [winfo parent $cur]
            set children [winfo children $parent]
            set i [lsearch -exact $children $cur]
        }

        # Go to the previous sibling, then descend to its last descendant
        # (highest in stacking order.  While doing this, ignore top-levels
        # and their descendants.  When we run out of descendants, go up
        # one level to the parent.

        while {$i > 0} {
            incr i -1
            set cur [lindex $children $i]
            if {[string equal [winfo toplevel $cur] $cur]} {
                continue
            }
            set parent $cur
            set children [winfo children $parent]
            set i [llength $children]
        }
        set cur $parent
        if {[string equal $w $cur] || [tkFocusOK $cur]} {
            return $cur
        }
    }
}

# tkFocusOK --
#
# This procedure is invoked to decide whether or not to focus on
# a given window.  It returns 1 if it's OK to focus on the window,
# 0 if it's not OK.  The code first checks whether the window is
# viewable.  If not, then it never focuses on the window.  Then it
# checks the -takefocus option for the window and uses it if it's
# set.  If there's no -takefocus option, the procedure checks to
# see if (a) the widget isn't disabled, and (b) it has some key
# bindings.  If all of these are true, then 1 is returned.
#
# Arguments:
# w -           Name of a window.

proc tkFocusOK w {
    set code [catch {$w cget -takefocus} value]
    if {($code == 0) && ($value != "")} {
        if {$value == 0} {
            return 0
        } elseif {$value == 1} {
            return [winfo viewable $w]
        } else {
            set value [uplevel #0 $value [list $w]]
            if {$value != ""} {
                return $value
            }
        }
    }
    if {![winfo viewable $w]} {
        return 0
    }
    set code [catch {$w cget -state} value]
    if {($code == 0) && [string equal $value "disabled"]} {
        return 0
    }
    regexp Key|Focus "[bind $w] [bind [winfo class $w]]"
}

# tk_focusFollowsMouse --
#
# If this procedure is invoked, Tk will enter "focus-follows-mouse"
# mode, where the focus is always on whatever window contains the
# mouse.  If this procedure isn't invoked, then the user typically
# has to click on a window to give it the focus.
#
# Arguments:
# None.

proc tk_focusFollowsMouse {} {
    set old [bind all <Enter>]
    set script {
        if {[string equal "%d" "NotifyAncestor"] \
                || [string equal "%d" "NotifyNonlinear"] \
                || [string equal "%d" "NotifyInferior"]} {
            if {[tkFocusOK %W]} {
                focus %W
            }
        }
    }
    if {[string compare $old ""]} {
        bind all <Enter> "$old; $script"
    } else {
        bind all <Enter> $script
    }
}