#acupoftea - mail.ontime-ae.com

System	:	Linux server1.ontime-gulf.com 4.18.0-553.5.1.el8_10.x86_64 #1 SMP Wed Jun 5 09:12:13 EDT 2024 x86_64
Software	:	Apache
Server	:	162.0.230.206
Domains	:	40 Domain
Permission	:	[ drwxr-xr-x ]
	:	/ usr / share / tk8.6 /

216.73.216.49

Home

File focus.tcl

# focus.tcl --
#
# This file defines several procedures for managing the input
# focus.
#
# 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 {[winfo toplevel $cur] eq $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 {[winfo toplevel $cur] eq $cur} {
		break
	    }
	    set parent [winfo parent $parent]
	    set children [winfo children $parent]
	    set i [lsearch -exact $children $cur]
	}
	if {$w eq $cur || [tk::FocusOK $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 {[winfo toplevel $cur] eq $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 {[winfo toplevel $cur] eq $cur} {
		continue
	    }
	    set parent $cur
	    set children [winfo children $parent]
	    set i [llength $children]
	}
	set cur $parent
	if {$w eq $cur || [tk::FocusOK $cur]} {
	    return $cur
	}
    }
}

# ::tk::FocusOK --
#
# 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 ::tk::FocusOK w {
    set code [catch {$w cget -takefocus} value]
    if {($code == 0) && ($value ne "")} {
	if {$value == 0} {
	    return 0
	} elseif {$value == 1} {
	    return [winfo viewable $w]
	} else {
	    set value [uplevel #0 $value [list $w]]
	    if {$value ne ""} {
		return $value
	    }
	}
    }
    if {![winfo viewable $w]} {
	return 0
    }
    set code [catch {$w cget -state} value]
    if {($code == 0) && $value eq "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 {"%d" eq "NotifyAncestor" || "%d" eq "NotifyNonlinear" \
		|| "%d" eq "NotifyInferior"} {
	    if {[tk::FocusOK %W]} {
		focus %W
	    }
	}
    }
    if {$old ne ""} {
	bind all <Enter> "$old; $script"
    } else {
	bind all <Enter> $script
    }
}

Name	Type	Size	Permission	Last Modified	Actions
.	DIR	-	drwxr-xr-x	2024-03-13 04:40:23
..	DIR	-	drwxr-xr-x	2025-10-16 10:59:21
demos	DIR	-	drwxr-xr-x	2024-03-13 04:40:23
images	DIR	-	drwxr-xr-x	2024-03-13 04:40:23
msgs	DIR	-	drwxr-xr-x	2024-03-13 04:40:23
ttk	DIR	-	drwxr-xr-x	2024-03-13 04:40:23
bgerror.tcl	text/plain	8.05 KB	-rw-r--r--	2019-10-16 05:25:09
button.tcl	text/plain	20.16 KB	-rw-r--r--	2019-10-16 05:25:09
choosedir.tcl	text/plain	9.43 KB	-rw-r--r--	2019-10-16 05:25:09
clrpick.tcl	text/plain	20.93 KB	-rw-r--r--	2019-10-16 05:25:09
comdlg.tcl	text/plain	8.04 KB	-rw-r--r--	2019-10-16 05:25:09
console.tcl	text/plain	32.02 KB	-rw-r--r--	2019-10-16 05:25:09
dialog.tcl	text/plain	5.88 KB	-rw-r--r--	2019-10-16 05:25:09
entry.tcl	text/plain	16.55 KB	-rw-r--r--	2019-10-16 05:25:09
focus.tcl	text/plain	4.74 KB	-rw-r--r--	2019-10-16 05:25:09
fontchooser.tcl	text/plain	15.47 KB	-rw-r--r--	2019-10-16 05:25:09
iconlist.tcl	text/plain	15.6 KB	-rw-r--r--	2019-10-16 05:25:09
icons.tcl	text/plain	10.63 KB	-rw-r--r--	2019-10-16 05:25:09
listbox.tcl	text/plain	14.25 KB	-rw-r--r--	2019-10-16 05:25:10
megawidget.tcl	text/plain	9.34 KB	-rw-r--r--	2019-10-16 05:25:10
menu.tcl	text/plain	37.12 KB	-rw-r--r--	2019-10-16 05:25:10
mkpsenc.tcl	text/plain	28.66 KB	-rw-r--r--	2019-10-16 05:25:10
msgbox.tcl	text/plain	16.08 KB	-rw-r--r--	2019-10-16 05:25:10
obsolete.tcl	text/plain	5.46 KB	-rw-r--r--	2019-10-16 05:25:10
optMenu.tcl	text/plain	1.55 KB	-rw-r--r--	2019-10-16 05:25:10
palette.tcl	text/plain	7.74 KB	-rw-r--r--	2019-10-16 05:25:10
panedwindow.tcl	text/plain	5.05 KB	-rw-r--r--	2019-10-16 05:25:10
safetk.tcl	text/plain	7.21 KB	-rw-r--r--	2019-10-16 05:25:10
scale.tcl	text/plain	7.58 KB	-rw-r--r--	2019-10-16 05:25:10
scrlbar.tcl	text/plain	12.45 KB	-rw-r--r--	2019-10-16 05:25:10
spinbox.tcl	text/plain	15.27 KB	-rw-r--r--	2019-10-16 05:25:10
tclIndex	text/plain	19.79 KB	-rw-r--r--	2019-10-16 05:25:10
tearoff.tcl	text/plain	5.02 KB	-rw-r--r--	2019-10-16 05:25:10
text.tcl	text/plain	32.31 KB	-rw-r--r--	2019-10-16 05:25:10
tk.tcl	text/plain	22.6 KB	-rw-r--r--	2019-10-16 05:25:10
tkfbox.tcl	text/plain	37.47 KB	-rw-r--r--	2019-10-16 05:25:10
unsupported.tcl	text/plain	10.01 KB	-rw-r--r--	2019-10-16 05:25:10
xmfbox.tcl	text/plain	25.46 KB	-rw-r--r--	2019-10-16 05:25:10

~ ACUPOFTEA - mail.ontime-ae.com