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

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

# Help text.
set Help "" ; append Help {Browseth -- Add keybindings for traversal and selection of textual widgets

This program teaches widgets that contain text some simple commands to move
around the cursor, or scroll around the text, or select regions of text.

} $TH_Bindings_Help {

Widgets of Browseth
} $TH_Frame_Help {
Listboxes and canvases will accept scrolling commands only along a dimension
if they have a scrollbar in that dimension, as indicated in their -xscroll
or -yscroll configuration option.

While this provides widget-independent scrolling, and covers some defects (for
example, you can't tell the current x position of a listbox), the paging
may not be completely one page long if the scroll region is only showing part
of the widget. This usually happens when the widget's scrolling border is
visible, such as the end of a listbox, or the edge of a canvas.

The scrolling commands will not work with a gridded listbox. This is because
the listbox's grid alters the -xscroll or -yscroll option, as mentioned above.

As in other widgets, the program attempts to keep the cursor in view, however
in canvas widgets, this is haphazard at best. The program makes an effort to
keep the cursor in view, but due to the myrad methods of scrolling and
displaying text, this might be quite quirky.

The browse functions will only work on a canvas item, if it has the canvas's
focus. Browseth does not change canvas focuses.
}


# Gives app all the code necessary to do our functions.
proc teach_code {app widget} {
  set class [send $app winfo class $widget]
  if {[widget_bindings $app $widget] != ""} {

    include_files $app {browse.Misc.tcl th_Misc_line}
    global TH_Dir
    if {[file exists "$TH_Dir/lib/browse.[set class].tcl"]} {
      include_files $app [list "browse.$class.tcl" "th_[set class]_goto"]
    }
    teach_frame_code $app $widget
}}

# For a widget, returns the appropriate bindings. (They will depend on the
# widget)
proc widget_bindings {app w} {
  global TH_Dir Bindings
  set class [send $app winfo class $w]
  set bindings ""

  if {[lsearch -exact [array names Bindings] "Browse,$class"] != -1} {
    set bindings [concat $bindings $Bindings(Browse,$class)]}

  if {![catch {send $app $w configure -orient} result]} {
    if {[string index [lindex $result 4] 0] == "v"} {
      if {[lsearch -exact [array names Bindings] "Browse,$class,Y"] != -1} {
        set bindings [concat $bindings $Bindings(Browse,$class,Y)]}}}

  if {![catch {send $app $w configure -orient} result]} {
    if {[string index [lindex $result 4] 0] == "h"} {
      if {[lsearch -exact [array names Bindings] "Browse,$class,X"] != -1} {
        set bindings [concat $bindings $Bindings(Browse,$class,X)]}}}

  if {[lsearch "Listbox Canvas" $class] != -1} {
    if {![catch {send $app $w configure -xscroll} result]} {
      if {[lindex $result 4] != ""} {
        set bindings [concat $bindings $Bindings(Browse,Misc,X)]}}
    if {![catch {send $app $w configure -yscroll} result]} {
      if {[lindex $result 4] != ""} {
        set bindings [concat $bindings $Bindings(Browse,Misc,Y)]}}
  }

  return [widget_frame_bindings $bindings]
}


