#
# Module to perform iteration on a widget
#


# Sets up the iteration function.
proc th_iterate_binding {w} {
  set f [th_show_entry $w iterate]
  $f.l configure -text "Iteration Argument:" -command bell
  $f.e configure -width 4
  $f.e delete 0 end
  bindtags $f.e ". All $f.e"
  bind $f.e <Key> "th_iterate_aux $w $f %A %K"
  bind $f.e <Control-Key> "th_do_iteration $w $f %A Control-%K"
  bind $f.e <Meta-Key> "th_do_iteration $w $f %A Meta-%K"
  bind $f.e <Control-Meta-Key> "th_do_iteration $w $f %A Control-Meta-%K"
}

proc th_iterate_aux {w f c b} {
  if {([regexp {[0-9]} $c])} {$f.e insert end $c
  } else {th_do_iteration $w $f $c $b}
}

# Does the iteration associated with binding b (or character c). F is w's
# associated frame.
proc th_do_iteration {w f c b} {
  if {(![regexp . $c])} {return}
  global TH
  if {([set n [$f.e get]] == "")} {set n $TH(Iterate,Default)}
  if {$b == ""} {set b $c}
  if {![catch "set TH(Binding,Cancel)"]} {
    if {[lsearch $TH(Binding,Cancel) $b] >= 0} {
      eval [bind $w $b]
      th_hide_entry $w iterate
      return
  }}
  if {[set cmd [th_return_binding $w $b $c]] == ""} {bell ; return}
  for {set i 1} {($i <= $n)} {incr i} {eval $cmd}
  th_hide_entry $w iterate
}

# Given a key, returns its keybinding in the current widget.
proc th_return_binding {widget binding {c ""}} {
  set key_binding [th_general_bind $binding]
  if {[string length $binding] == 1} {set binding "Key-$binding"}
  set result {}
  foreach spec [bindtags $widget] {
    if {([set cmd [bind $spec <$binding>]] == "") &&
        ([set cmd [bind $spec <$key_binding>]] == "")} {continue}
    append result $cmd " \n "
  }
  if {$result == ""} {return ""}
  if {[regsub -all {%K} $result $binding new_result]} {set result $new_result}
  if {[regsub -all {%W} $result $widget new_result]} {set result $new_result}
  if {$c != ""} {if {[regsub -all {%A} $result [th_char_protect $c] new_result]} {
        set result $new_result}}
  return $result
}

# Returns a keybinding's generalization (Ex: Control-x -> Control-Key)
proc th_general_bind {binding} {
  set list [split $binding {-}]
  set length [llength $list]
  incr length -2
  if {$length == -1} {return Key
  } else {return "[join [lrange $list 0 $length] {-}]-Key"}
}
