#!/afs/ece/usr/tcl/bin/wish -f
# The next line is executed by most shells, but not Tcl \
wish $0 $*


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 {
All widgets that are scrollable will have scrolling commands provided, even if
they do not currently support any scrollbars. The one exception is Canvas
widgets, which will support scrolling only if they have a nonempty
-scrollregion.

Sometimes, for listboxes, the grids will start with an even number, which makes
them 1 off the listbox text.

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 new scrolling commands of Tk4.0, while easier to use for the user, make
viewing items in canvas virtually impossible. (Canvas widgets *really* need a
'see' command.) Browseth cannot gaurentee that an insert cursor on a canvas
will be visible.

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 {} {
  global Bindings TH_Dir Class
  if {[lsearch -exact [array names Bindings] "Browse,$Class"] == -1} {return ""}
  include_files {browse.Misc.tcl th_goto}
  if {[file exists "$TH_Dir/lib/browse.[set Class].tcl"]} {
    include_files [list "browse.$Class.tcl" "th_[set Class]_goto"]
  }
  teach_frame_code
}

# For a widget, returns the appropriate bindings. (They will depend on the
# widget)
proc widget_bindings {} {
  global TH_Dir Bindings App Widget Class
  set bindings ""

# If we have bindings for a widget's class, add them.
  if {[lsearch -exact [array names Bindings] "Browse,$Class"] != -1} {
    set bindings [concat $bindings $Bindings(Browse,$Class)]} else {return ""}

# Bindings that go for every widget browseth supports.
  if {$bindings != ""} {
    set bindings [concat $bindings $Bindings(Browse)]
  }

# For widgets that support selection.
  if {[lsearch "Listbox Canvas Entry Text" $Class] != -1} {
    set bindings [concat $bindings $Bindings(Browse,Select)]
  }

# Some widgets are scrollable iff their scrollregion value is nonempty. (Canvas)
  if {![catch {send $App $Widget cget -scrollregion} result]} {
    if {$result != ""} {
      set bindings [concat $bindings $Bindings(Browse,Scrollregion) \
	$Bindings(Browse,Scroll,X) $Bindings(Browse,Scroll,Y)]}
    return [widget_frame_bindings $bindings]
  } else {
# For widgets that (could) support a horizontal scrollbar.
    if {![catch {send $App $Widget xview}]} {
      set bindings [concat $bindings $Bindings(Browse,Scroll,X)]
    }
  
# For widgets that (could) support a vertical scrollbar.
    if {![catch {send $App $Widget yview}]} {
      set bindings [concat $bindings $Bindings(Browse,Scroll,Y)]
    }
  }
  return [widget_frame_bindings $bindings]
}
