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