#
# Code for focus hypertool
#

# Searches the window hierarchy for a widget of appropriate class that
# follows w. If class is unspecified, it becomes w's class.
proc th_next_widget {{w "."} {class ""}} {
  if {$class == ""} {set class [winfo class $w]
  } elseif {[winfo class $w] == $class} {
# Widget must be displayed
    if {[winfo ismapped $w]} {return $w}}
  set children [winfo children $w]
  if {$children != ""} { return [th_next_widget [lindex $children 0] $class]}

  while {$w != "."} {
    set parent [winfo parent $w]
    set children [winfo children $parent]
    set i [lsearch $children $w] ; incr i
    set l [llength $children]
    while {$i != $l} {
      set child [lindex $children $i]
      return [th_next_widget [lindex $children $i] $class]
      incr i
    }
    set w $parent
  }
  return
}

# Searches the window hierarchy for a widget of appropriate class that
# precedes w. If class is unspecified, it becomes w's class.
proc th_previous_widget {{w "."} {class ""}} {
 if {$class == ""} {set class [winfo class $w]
  } elseif {[winfo class $w] == $class} {
# Widget must be displayed.
    if {[winfo ismapped $w]} {return $w}}

  set children [winfo children $w]
  if {$children != ""} { return [th_previous_widget [lindex $children \
                                   [expr [llength $children] - 1]] $class]}

  while {$w != "."} {
    set parent [winfo parent $w]
    set children [winfo children $parent]
    set i [lsearch $children $w] ; incr i -1
    while {$i != -1} {
      set child [lindex $children $i]
      return [th_previous_widget [lindex $children $i] $class]
      incr i -1
    }
    set w $parent
  }
  return
}

# Like th_focus_next, but loops back to the beginning if no widget found.
proc th_circle_focus_next {w} {
  if {[set f [th_next_widget $w]] != ""} {focus $f
  } else {focus [th_next_widget . [winfo class $w]]}
}

# blah th_focus_previous, blah blah blah
proc th_circle_focus_previous {w} {
  if {[set f [th_previous_widget $w]] != ""} {focus $f
  } else {focus [th_previous_widget . [winfo class $w]]}
}
