share/redhat/gui/list.tcl

# list.tcl - Some handy list procs.
# Copyright (C) 1997 Cygnus Solutions.
# Written by Tom Tromey <tromey@cygnus.com>.
# FIXME: some are from TclX; we should probably just use the C
# implementation that is in S-N.

proc lvarpush {listVar element {index 0}} {
  upvar $listVar var
  if {![info exists var]} then {
    lappend var $element
  } else {
    set var [linsert $var $index $element]
  }
}

proc lvarpop {listVar {index 0}} {
  upvar $listVar var
  set result [lindex $var $index]
  # NOTE lreplace can fail if list is empty.
  if {! [catch {lreplace $var $index $index} new]} then {
    set var $new
  }
  return $result
}

proc lassign {list args} {
  set len [expr {[llength $args] - 1}]

  # Special-case last element: if LIST is longer than ARGS, assign a
  # list of leftovers to the last variable.
  if {[llength $list] - 1 > $len} then {
    upvar [lindex $args $len] local
    set local [lrange $list $len end]
    incr len -1
  }

  while {$len >= 0} {
    upvar [lindex $args $len] local
    set local [lindex $list $len]
    incr len -1
  }
}

# Remove duplicates and sort list.  ARGS are arguments to lsort, eg
# --increasing.
proc lrmdups {list args} {
  set slist [eval lsort $args [list $list]]
  set last [lvarpop slist]
  set result [list $last]
  foreach item $slist {
    if {$item != $last} then {
      set last $item
      lappend result $item
    }
  }
  return $result
}

proc lremove {list element} {
  set index [lsearch -exact $list $element]
  if {$index == -1} then {
    return $list
  }
  return [lreplace $list $index $index]
}

# replace element with new element
proc lrep {list element new} {
  set index [lsearch -exact $list $element]
  if {$index == -1} {
    return $list
  }
  return [lreplace $list $index $index $new]
}

# FIXME: this isn't precisely like the C lvarcat.  It is slower.
proc lvarcat {listVar args} {
  upvar $listVar var
  if {[join $args] != ""} then {
    # Yuck!
    eval eval lappend var $args
  }
}