# -*- Tcl -*-

# Implement the listbox functionality for Tcl/Tk, when trying to pull
# down a *huge* list of names.

# This creates a `dynamic listbox' procedure, which tries to pull data
# from a procedure and update the box in realtime

# The input_routine (second argument to dynlistbox) must be a
# procedure of one required argument and one optional argument.  The
# required argument is an integer listing the number of items being
# requested.  If provided, the optional argument is a match to start
# reading from (the matching record itself does not get returned from
# the input routine).  The input_routine should return a list of all
# the data retrieved, with each line in the listbox corresponding to a
# list entry.

# The dynamic listbox itself holds both the listbox and the associated
# scrollbar, and sets itself up as a procedure like other Tk widgets.
# (Note that in order to accomplish this the frame for the
# listbox/scrollbar combination is renamed).

proc dynlistbox { name input_routine args } {
  global dynlistlast dynlistinput dynlistsearch dynlistglob debug

  frame $name 
  listbox $name.lb -yscrollcommand "$name.sb set" -relief sunken \
      -selectmode extended -takefocus 1
  eval $name.lb config $args
  scrollbar $name.sb -command "$name.lb yview"
  pack $name.lb -side left -expand yes -fill both
  pack $name.sb -side right -fill y

  bind $name.lb <KeyPress> "dynlistbox:keystroke $name %A"
  bind $name.lb <FocusIn> "set dynlistsearch($name) {}"
  bind $name.lb <ButtonPress-1> "set dynlistsearch($name) {}"

  # rename the $name frame to $name.frame so we can define the
  # dynlistbox as a virtual procedure
  rename $name $name.frame

  # define the procedure.  Note that $name is expanded throughout.
  proc $name { cmd args } "\
    switch -exact \$cmd { \
      append { eval dynlistbox:append $name \$args } \
      cancel { eval dynlistbox:cancel $name \$args } \
      update { eval dynlistbox:update $name \$args } \
      refresh { eval dynlistbox:refresh $name \$args } \
      populate { eval dynlistbox:refresh $name \$args } \
      curselection { eval $name.lb curselection } \
      get { eval $name.lb get \$args } \
      default { error \"unknown option \\\"\$cmd\\\" for \\\"$name\\\"\" } \
    }"

  set dynlistlast($name) ""
  set dynlistglob($name) ""
  set dynlistsearch($name) ""
  set dynlistinput($name) $input_routine
}

# Pulls down some number of items and schedules an idle timer to load more.
proc dynlistbox:append { name } {
  global dynlistlast dynlisttimer dynlistinput dynlistglob debug

  set size 50
  set dynlisttimer($name) ""
  set input_routine $dynlistinput($name)

  if {$dynlistlast($name) == ""} {
    # if the glob matcher starts with anything other than a special
    # glob character, then we can speed up the match by starting with
    # a search for everything leading up to the first glob character.
    if {$dynlistglob($name) != "" && [string match {[\?\*\[]*} $dynlistglob($name)] == 0} {
      regexp {^([^[?*]*)([[?*].*|)$} $dynlistglob($name) {} startsearch
      if {$debug} {puts "$input_routine $size $startsearch"}
      # get previous location
      set startsearch [$input_routine -1 $startsearch]
      set tmp [$input_routine $size $startsearch]
    } else {
      if {$debug} {puts "$input_routine $size"}
      set tmp [$input_routine $size]
    }
  } else { 
    # if we're in the midst of an update, but we've gone past the glob
    # matcher's potential matches, just return and stop pulling down
    # information.
    if {$dynlistglob($name) != "" && [string match {[\?\*\[]*} $dynlistglob($name)] == 0} {
      # add one to the last character of the matcher to `bracket' the matches
      regexp {^([^[?*]*)([^[?*])[[?*].*$} $dynlistglob($name) {} str c
      scan $c %c i
      set c [format %c [expr $i+1]]
      if {$dynlistlast($name) > "$str$c"} {
	return
      }
    }
    if {$debug} {puts "$input_routine $size $dynlistlast($name)"}
    set tmp [$input_routine $size $dynlistlast($name)]
  }

  if {[llength $tmp] != 0} {
    if {$dynlistglob($name) != ""} {
      if {$debug} { puts "...matching for $dynlistglob($name)" } 
      foreach n $tmp {
	if {[string match $dynlistglob($name) $n] == 1} {
	  $name.lb insert end $n
	} 
      }
    } else {
      eval $name.lb insert end $tmp
    }
    set dynlistlast($name) [lindex $tmp end]
    update
    if {[llength $tmp] == $size} {
      # We have not yet reached the end!
      set dynlisttimer($name) \
	  [after idle "dynlistbox:append $name"]
    }
  }
}
    
proc dynlistbox:cancel { name } {
  global dynlisttimer debug
  catch {
    if {$dynlisttimer($name) != ""} {
      after cancel $dynlisttimer($name)
      if {$debug} puts "cancelled $dynlisttimer($name)"
    }
  }
}

# perform a binary search on the listbox items, and returns the index 
# of the matching element.  If not present, returns an empty string.
proc dynlistbox:bsearch { name entry { nearest 0 } } {
  set min 0
  set max [expr [$name.lb size] -1]

  while {$max >= $min} {
    set i [expr int(($max+$min)/2)]
    set test [$name.lb get $i]
    if { $test == $entry } {
      return $i
    } elseif { $test > $entry } {
      set max [expr $i-1]
    } else {
      set min [expr $i+1]
    }
  }
  if {$nearest == 0} {
    return ""
  } else {
    return $min
  }
}     

# adds the entry into the list.
proc dynlistbox:binsert { name entry } {
  global debug
  set min 0
  set max [expr [$name.lb size] -1]

  while {$max >= $min} {
    if {[$name.lb get $min] > $entry} {
      if {$debug} {puts "...adding $entry to $name.lb at $min"}
      $name.lb insert $min $entry
      return
    }
    if {[$name.lb get $max] < $entry} {
      if {$debug} {puts "...adding $entry to $name.lb at [expr $max+1]"}
      $name.lb insert [expr $max+1] $entry
      return
    }

    set i [expr int(($max+$min)/2)]
    if { [$name.lb get $i] > $entry } {
      set max [expr $i-1]
    } else {
      set min [expr $i+1]
    }
  }
}     

# update a piece of the box.
proc dynlistbox:update { name entry } {
  global dynlistinput dynlistsearch debug

  # Update takes one name, and performs two input routine calls to
  # figure out whether the name exists or not.  If it does, it will
  # make sure that the entry is in the listing, otherwise it will
  # delete as appropriate.

  # get next entry after the previous.  If entry is present, the
  # `next' will then hold `entry'.  Otherwise, it will hold the next
  # item after where the entry would have been.
  if {$debug} { puts "$dynlistinput($name) -1 $entry" }
  set prev [$dynlistinput($name) -1 $entry]
  if {$debug} { puts "$dynlistinput($name) 1 $prev" }
  set next [$dynlistinput($name) 1 $prev]
  set i [dynlistbox:bsearch $name $entry]
  
  if {$debug} {puts "...bsearch for $entry returns \"$i\""}
  if {$next == $entry} {
    # make sure it's in the listing.
    if {$i == ""} { 
      dynlistbox:binsert $name $entry
    } 
  } else {
    # remove from listing
    if {$i != ""} {
      $name.lb delete $i $i
    }
  }
  set dynlistsearch($name) ""
}

# this should probably be done somewhere other than the dynlistbox
proc add_realm_to_glob { filter } {
  global kadmin

  if {$kadmin(realm) != ""} {
    set realm $kadmin(realm)
  } else {
    set realm "*"
  }

  if {[string first {@} $filter] == -1} {
    return "$filter@$realm"
  } else { 
    return $filter
  }
}

# clear and refresh listbox
proc dynlistbox:refresh { name {match ""} } {
  global debug dynlistlast dynlistglob
  # cancel any load in progress
  dynlistbox:cancel $name

  if {$match != "" && $match != "*" } {
    set dynlistglob($name) [add_realm_to_glob $match]
  } else {
    set dynlistglob($name) ""
  }
  set dynlistlast($name) ""
  $name.lb delete 0 end
  dynlistbox:append $name
}

proc dynlistbox:keystroke { name key } { 
  global dynlistsearch debug
  if {$key != ""} {
    if {$key == "\b"} {
      set dynlistsearch($name) \
	  [string range $dynlistsearch($name) 0 \
	     [expr [string length $dynlistsearch($name)]-2]]
    } elseif {$key == "\r"} {
      set dynlistsearch($name) ""
      return
    } else {
      set dynlistsearch($name) "$dynlistsearch($name)$key"
    }
    set i [dynlistbox:bsearch $name $dynlistsearch($name) 1]
    $name.lb see $i
  }
}
