#!/afs/ece/usr/tcl/bin/wish -f

set Bind_Keyword [file tail [info script]]
source "[file dirname [info script]]/../aux/bind.tcl"

# Help text.
set Help "" ; append Help {Focuth -- Add bindings to switch keyboard focus

Any program that needs you to enter a lot of information will usually have
lots of entries and other widgets for you to use when entering them.
Unfortunately, some programs don't give you any way to switch the keyboard
focus between these widgets.

That's what this program is for. After clicking on Teach, you can select a
'focus list' of widgets. Each widget you click on will learn to switch to the
next widget you click on, and the previous one you clicked on. You can thus
create a 'focus list' of widgets to talk to. Or, by finishing your widget
sequence with the first widget, you can close that list and create a 'focus
ring'.

You can also switch automatically between all widgets of the same class (all
Entries for instance) This is useful in that it saves you from selecting the
focus list yourself, and it works even new widgets are created of the same class
or old widgets are destroyed.

Since you can change keybindings and menu entries, you can add multiple focus
lists to widgets. For example, you could implement many small focus rings using
<Tab>, and then a 'large' focus ring including one widget from each of the small
rights using <Control-Tab>.

} $TH_Bindings_Help {

Widgets of Focuth

The Teach Button

Click on Teach to teach focus switching. Then click, using Button 1, on a
sequence of widgets in a single application. Each widget will be taught how to
switch to its next widget and previous widget in your sequence. The first widget
will not have a previous member, nor will the last widget have a first member,
You can click on individual widgets, or individual items in a canvas. Finally,
you can 'close' the list by clicking again on the first widget after clicking
on all the widgets in your sequence.

Or you can teach all widgets of a particular class (like Entries) to swap
focus between each other, which will remain effective through widgets getting
destroyed, new ones getting added, etc. Use Shift-Button-1 on a widget, and all
widgets of that class will swap keyboard focus between each other.

Pressing Button-2 has a similar effect when creating a focus list, except that
instead of adding keybindings, it adds menus to each widget for swapping focus.
Of course, a menu function acts independently of the keyboard focus, so a
particular menuentry will always put the focus in the same place, irreverent of
where it was before, while a keybinding will move the focus depending on where
it currently resides.

Pressing Shift-Button-2 adds the menu entries the same was Button-2 does, but
instead of using a user-defined focus ring, it uses the class focusing
functions. Again, this is not too useful, except for show, since it displays the
keybinding that switches focus.

You can teach both keys and menus to a widget. If you wish to do this, it is
recommended you teach the widget keys first (Button 1) before the menus (Button
2). If a widget has the appropriate keybindings when you teach it menus, it
adds appropriate menu accelerators (the keybinding involved), otherwise it
leaves them empty.

Pressing Button-3 teaches the code necessary to teach focusing over a
user-defined focus list. Since no code is necessary for user-defined lists, this
essentially does nothing.

Pressing Shift-Button-3 teaches the code necessary to teach focussing over a
class of widgets. This gets done automatically if you want class focusing, so
you will normally not need this feature.

} $TH_Bind_Help {

Bugs / Limitations

Bindings made to canvas widget items apply to the canvas widgets themselves. So
in general, all canvas items can only switch focus to one other widget, or item.
}

set Prev_Widget ""
set Prev_Item ""
set App ""

proc toggle_grab [info args toggle_grab] [concat {
  global Prev_Widget App Prev_Item
  set Prev_Widget "" ; set App "" ; set Prev_Item "" ;
} [info body toggle_grab]]

# Gives app all the code necessary to do our functions.
# This is only necessary for class binding.
proc teach_code {app widget} {
  include_files $app {focus.tcl th_next_widget}
}

proc widget_bindings {app widget} {
  global Bindings
  return $Bindings(Focus)
}

proc add_focus_binding {x y b class_flag} {
  global Prev_Widget App Prev_Item
  if {![which_widget $x $y 1 app widget]} {toggle_grab ; th_beep ; return}
  clear_output
  set class [send $app winfo class $widget]
  if $class_flag {
    set Prev_Widget "" ; set App "" ; set Prev_Item ""
    teach_code $app $widget
    switch $b {
      1 {teach_keybindings $class [widget_bindings $app $widget] $app
    } 2 {teach_menubindings $widget [widget_bindings $app $widget] $app}}
  } else {
    if {$b == 3} {teach_code $app $widget}
    set root_x [send $app winfo rootx $widget]
    set root_y [send $app winfo rooty $widget]
    if {$Prev_Widget == ""} {
      set App $app
      set Prev_Widget $widget
      if {$class == "Canvas"} {
        set new_x [send $app $widget canvasx [expr $x - $root_x]]
        set new_y [send $app $widget canvasy [expr $y - $root_y]]
        set Prev_Item [lindex [send $app $widget find overlapping $new_x $new_y $new_x $new_y] 0]
      } else {set Prev_Item ""}
      clear_output
      return
    } else {if {$App != $app} {th_beep ; return}

      if {$class == "Canvas"} {
        set new_x [send $app $widget canvasx [expr $x - $root_x]]
        set new_y [send $app $widget canvasy [expr $y - $root_y]]
        set item [lindex [send $app $widget find overlapping $new_x $new_y $new_x $new_y] 0]
      } else {set item ""}

      if {$Prev_Item != ""} {
        set prev_binding "\{Focus_Previous \{catch \{focus $Prev_Widget ; focus $Prev_Item\}\}\}"
      } else {
        set prev_binding "\{Focus_Previous \{catch \{focus $Prev_Widget\}\}\}"}
      if {$item != ""} {
        set next_binding "\{Focus_Next \{catch \{focus $widget ; focus $item\}\}\}"
      } else {
        set next_binding "\{Focus_Next \{catch \{focus $widget\}\}\}"}

      switch $b {
        1 {teach_keybindings $widget $prev_binding $app
           teach_keybindings $Prev_Widget $next_binding $app
      } 2 {teach_menubindings $widget $prev_binding $app
           teach_menubindings $Prev_Widget $next_binding $app
      }}
      set Prev_Widget $widget
      set Prev_Item $item
}}}


# These bindings only should take effect during a global grab.
bind all <Any-Button>			"add_focus_binding %X %Y %b 0"
bind all <Any-Shift-Button>		"add_focus_binding %X %Y %b 1"
