/usr/share/tcltk/tile0.8.2/keynav.tcl is in tk-tile 0.8.2-2.2.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 | ########################################################################
# keynav package - Enhanced keyboard navigation
# Copyright (C) 2003 Joe English
# Freely redistributable; see the file license.terms for details.
#
# keynav.tcl,v 1.8 2006/04/07 19:30:48 jenglish Exp
#
########################################################################
#
# Usage:
#
# package require keynav
#
# keynav::enableMnemonics $toplevel --
# Enable mnemonic accelerators for toplevel widget.
# Pressing Alt-K, where K is any alphanumeric key,
# will send an <<Invoke>> event to the widget with
# mnemonic K (as determined by the -underline and -text
# options).
#
# Side effects: adds a binding for <Alt-KeyPress> to $toplevel
#
# keynav::defaultButton $button --
# Enables default activation for the toplevel window
# in which $button appears. Pressing <Key-Return> invokes
# the default widget. The default widget is set to
# the widget with keyboard focus if it is defaultable,
# otherwise $button. A widget is _defaultable_
# if it has a -default option which is not set to
# "disabled".
#
# Side effects: adds <FocusIn> and <KeyPress-Return> bindings
# to the toplevel containing $button, and a <Destroy> binding
# to $button.
#
# $button must be a defaultable widget.
#
namespace eval keynav {}
package require Tcl 8.4
package require Tk 8.4
package provide keynav 1.0
event add <<Help>> <KeyPress-F1>
#
# Bindings for stock Tk widgets:
# (NB: for 8.3 use tkButtonInvoke, tkMbPost instead)
#
bind Button <<Invoke>> { tk::ButtonInvoke %W }
bind Checkbutton <<Invoke>> { tk::ButtonInvoke %W }
bind Radiobutton <<Invoke>> { tk::ButtonInvoke %W }
bind Menubutton <<Invoke>> { tk::MbPost %W }
proc keynav::enableMnemonics {w} {
bind [winfo toplevel $w] <Alt-KeyPress> {+ keynav::Alt-KeyPress %W %K }
}
# mnemonic $w --
# Return the mnemonic character for widget $w,
# as determined by the -text and -underline resources.
#
proc keynav::mnemonic {w} {
if {[catch {
set label [$w cget -text]
set underline [$w cget -underline]
}]} { return "" }
return [string index $label $underline]
}
# FindMnemonic $w $key --
# Locate the descendant of $w with mnemonic $key.
#
proc keynav::FindMnemonic {w key} {
if {[string length $key] != 1} { return }
set Q [list [set top [winfo toplevel $w]]]
while {[llength $Q]} {
set QN [list]
foreach w $Q {
if {[string equal -nocase $key [mnemonic $w]]} {
return $w
}
foreach c [winfo children $w] {
if {[winfo ismapped $c] && [winfo toplevel $c] eq $top} {
lappend QN $c
}
}
}
set Q $QN
}
return {}
}
# Alt-KeyPress --
# Alt-KeyPress binding for toplevels with mnemonic accelerators enabled.
#
proc keynav::Alt-KeyPress {w k} {
set w [FindMnemonic $w $k]
if {$w ne ""} {
event generate $w <<Invoke>>
return -code break
}
}
# defaultButton $w --
# Enable default activation for the toplevel containing $w,
# and make $w the default default widget.
#
proc keynav::defaultButton {w} {
variable DefaultButton
$w configure -default active
set top [winfo toplevel $w]
set DefaultButton(current.$top) $w
set DefaultButton(default.$top) $w
bind $w <Destroy> [list keynav::CleanupDefault $top]
bind $top <FocusIn> [list keynav::ClaimDefault $top %W]
bind $top <KeyPress-Return> [list keynav::ActivateDefault $top]
}
proc keynav::CleanupDefault {top} {
variable DefaultButton
unset DefaultButton(current.$top)
unset DefaultButton(default.$top)
}
# ClaimDefault $top $w --
# <FocusIn> binding for default activation.
# Sets the default widget to $w if it is defaultable,
# otherwise set it to the default default.
#
proc keynav::ClaimDefault {top w} {
variable DefaultButton
if {![info exists DefaultButton(current.$top)]} {
# Someone destroyed the default default, but not
# the rest of the toplevel.
return;
}
set default $DefaultButton(default.$top)
if {![catch {$w cget -default} dstate] && $dstate ne "disabled"} {
set default $w
}
if {$default ne $DefaultButton(current.$top)} {
# Ignore errors -- someone may have destroyed the current default
catch { $DefaultButton(current.$top) configure -default normal }
$default configure -default active
set DefaultButton(current.$top) $default
}
}
# ActivateDefault --
# Invoke the default widget for toplevel window, if any.
#
proc keynav::ActivateDefault {top} {
variable DefaultButton
if { [info exists DefaultButton(current.$top)]
&& [winfo exists $DefaultButton(current.$top)]
} {
event generate $DefaultButton(current.$top) <<Invoke>>
}
}
# traverseTo $w --
# Set the keyboard focus to the specified window,
# sending <<TraverseOut>> and <<TraverseIn>> virtual events
# as per TIP #204.
#
proc keynav::traverseTo {w} {
set focus [focus]
if {$focus ne ""} {
event generate $focus <<TraverseOut>>
}
focus $w
event generate $w <<TraverseIn>>
}
#
# Provide TIP #204 functionality if we're running 8.4:
#
if {![package vsatisfies [package provide Tk] 8.5]} {
bind all <Tab> { keynav::traverseTo [tk_focusNext %W] ; break}
bind all <<PrevWindow>> { keynav::traverseTo [tk_focusPrev %W] }
bind Entry <<TraverseIn>> { %W selection range 0 end; %W icursor end }
bind Spinbox <<TraverseIn>> { %W selection range 0 end; %W icursor end }
}
#*EOF*
|