ulset.tcl

This Source-Navigator, an IDE for C/C++/Fortran/Java/Tcl/PHP/Python and a host of other languages.

# ulset.tcl - Set labels based on info from gettext.
# Copyright (C) 1997 Cygnus Solutions.
# Written by Tom Tromey <[e-mail]>.

# Extract underline and label info from a descriptor string.  Any
# underline in the descriptor is extracted, and the next character's
# index is used as the -underline value.  There can only be one _ in
# the label.
proc extract_label_info {option label} {
  set uList [split $label _]
  if {[llength $uList] > 2} then {
    error "too many underscores in label \"$label\""
  }

  if {[llength $uList] == 1} then {
    set ul -1
  } else {
    set ul [string length [lindex $uList 0]]
  }

  return [list $option [join $uList {}] -underline $ul]
}