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