ulset.tcl

来自「windows下的GDB insight前端」· TCL 代码 · 共 23 行

# 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]
}