#
# Code for maintaining a frame widget for entries & messages
#

# Returns the widget's frame, creating & displaying it if necessary.
proc th_frame {w} {
  global TH
  if {[string match "*_fm.*" $w]} {return [winfo parent [winfo parent $w]]}

  if {[catch {set TH(Frame,$w)} result]} {
# No frame specified for this widget...create (or assign) one.
    if {[winfo manager $w] == "pack"} {set TH(Frame,$w) "[set w]_fm"
    } elseif {[winfo toplevel $w] == "."} {set TH(Frame,$w) ".[th_gensym]"
    } else {set TH(Frame,$w) "[winfo toplevel $w].f[th_gensym]"}
  }

  if {![winfo exists $TH(Frame,$w)]} {frame $TH(Frame,$w)}

  if {![winfo ismapped $TH(Frame,$w)]} {
    if {![th_pack $TH(Frame,$w) $w bottom]} {
      pack $TH(Frame,$w) -side bottom -before [lindex [pack slaves [winfo toplevel $w]] 0]
  }}
  return $TH(Frame,$w)
}


set TH(Symname) "symth"
set TH(Symnum) 0

# Returns a new symbol upon each call
proc th_gensym {} {
  global TH
  incr TH(Symnum)
  return $TH(Symname)$TH(Symnum)
}


# Time to display labels
set TH(Label,Flash) 3000

# Displays a label for $TH(Label,Flash) milliseconds. Label lives in widget's
# frame. Args gets passed to the label as configuration options. Returns
# after-id used to destroy label.
proc th_flash_label {w args} {
  set f [th_frame $w]
  set newlabel "$f.msg"
  after cancel "catch \"destroy $newlabel\""
  catch "destroy $newlabel"
  eval label $newlabel -relief raised $args
  set t [$newlabel cget -text]
  while {[string index $t 0] == "\n"} {set t [string range $t 1 end]}
  if {[set i [string first "\n" $t]] > 0} {
    incr i -1
    set t [string range $t 0 $i]
  }
  $newlabel configure -text $t
  pack $newlabel -side left
  update
  global TH
  return [after $TH(Label,Flash) "catch \"destroy $newlabel\""]
}

# Works like the bind command, except uses TH(Binding,$th_binding) which is
# a list of bindings, applies binding to all in the list.
# If cmd is unspecified, returns current value of binding, or "" if none.
proc th_bind {w th_binding {cmd ""}} {
  global TH
  if {$cmd == ""} {
    if {[catch {bind $w [lindex $TH(Binding,$th_binding) 0]} result]} {
      return ""} else {return $result}}
  foreach binding $TH(Binding,$th_binding) {bind $w $binding $cmd}
}

# Creates a subframe, widget name of $name, with a button and entry, inside the
# widget's frame widget. Returns subframe. Button is $name.l and entry is
# $name.e. Returns subframe.
proc th_show_entry {w name} {
  global TH auto_index
  set f [th_frame $w]
  if {[string match "*_fm.e" $w]} {return ""}
  if {![winfo exists $f.$name]} {
    frame $f.$name
    pack [button $f.$name.l -command "eval \[th_bind $f.$name.e OK\]"] \
		-side left
    pack [entry $f.$name.e] -side right
    th_bind $f.$name.e Cancel "th_hide_entry $w $name ; bell ; break"
  }
  pack $f.$name -side left
  focus $f.$name.e
  if {[catch "set TH(Fields,$w)"]} {set TH(Fields,$w) ""}
  if {[lsearch $TH(Fields,$w) $name] < 0} {lappend TH(Fields,$w) $name}
  return $f.$name
}

# Hides every visible entry field for widget w.
proc th_cancel_all {w} {
  global TH
  if {[catch "set TH(Fields,$w)"]} {set TH(Fields,$w) ""}
  if {[catch "set TH(Cancel,Code,$w)"]} {set TH(Cancel,Code,$w) ""}
  if {$TH(Cancel,Code,$w) != ""} {eval $TH(Cancel,Code,$w)}
  foreach field $TH(Fields,$w) {th_hide_entry $w $field}
  bell
}

# Removes entry & label. (merely unpacks them)
proc th_hide_entry {w name} {
  global TH ; set i [lsearch TH(Fields,$w) $name]
  lreplace TH(Fields,$w) $i $i
  set f [th_frame $w]
  pack forget $f.$name
  if {[llength [pack slaves $f]] == 0} {pack forget $f}
  focus $w
}

# Called by a binding and checkbutton menuentry, ensures var is toggled only
# once.
proc th_checkbutton_variable {var} {
  global TH
  if {[catch "set TH($var,aux)"]} {set TH($var,aux) 0}
  if {[catch "set TH($var)"]} {set TH($var) 0}
  if {$TH($var) != $TH($var,aux)} {
# was invoked by menu.
    set TH($var,aux) $TH($var)
  } else {
# was invoked by keybinding
    if $TH($var) {set TH($var) 0} else {set TH($var) 1}
    set TH($var,aux) $TH($var)
}}

# Protects certain chars by preceding them with a \.
proc th_char_protect {c} {
  if {($c == {[}) || ($c == {]}) || ($c == " ") ||
    ($c == "{") || ($c == "}") || ($c == {"})} {
    return "\\$c"} else {return $c}
}

# Packs new_W on $side of w. Returns 1 if successful, 0 if w isn't packed
proc th_pack {new_w w {side top}} {
  if {[winfo manager $w] != "pack"} {return 0}

  set info [pack info $w]
  set i [lsearch $info "-side"] ; incr i
  set w_side [lindex $info $i]
  switch [list $w_side $side] {
    {top bottom} - {left right} - {bottom top} - {right left} {
      set code "-after $w -side $w_side"
    } default {set code "-before $w -side $side"
  }}
  set sides {left right top botto} ; set anchor {w e n s}
  eval pack $new_w $code -anchor [lindex {n e w s} [lsearch {top right left bottom} $w_side]]
  return 1
}
