# -*- tcl -*- Copyright (c) 2012 Andreas Kupries # # ## ### ##### ######## ############# ##################### ## String utility commands. # # ## ### ##### ######## ############# ##################### ## Export (internals - recipe definitions, other utilities) namespace eval ::kettle::strutil { namespace export {[a-z]*} namespace ensemble create } # # ## ### ##### ######## ############# ##################### ## API proc ::kettle::strutil::padr {list} { set maxl 0 foreach str $list { set l [string length $str] if {$l <= $maxl} continue set maxl $l } set res {} foreach str $list { lappend res [format "%-*s" $maxl $str] } return $res } proc ::kettle::strutil::padl {list} { set maxl 0 foreach str $list { set l [string length $str] if {$l <= $maxl} continue set maxl $l } set res {} foreach str $list { lappend res [format "%*s" $maxl $str] } return $res } proc ::kettle::strutil::reflow {text {prefix { }}} { return [indent [undent [string trim $text \n]] $prefix] } proc ::kettle::strutil::indent {text prefix} { set text [string trimright $text] set res {} foreach line [split $text \n] { if {[string trim $line] eq {}} { lappend res {} } else { lappend res $prefix[string trimright $line] } } return [join $res \n] } proc ::kettle::strutil::undent {text} { if {$text eq {}} { return {} } set lines [split $text \n] set ne {} foreach l $lines { if {[string length [string trim $l]] == 0} continue lappend ne $l } set lcp [LCP $ne] if {$lcp eq {}} { return $text } regexp "^(\[\t \]*)" $lcp -> lcp if {$lcp eq {}} { return $text } set len [string length $lcp] set res {} foreach l $lines { if {[string trim $l] eq {}} { lappend res {} } else { lappend res [string range $l $len end] } } return [join $res \n] } proc ::kettle::strutil::LCP {list} { if {[llength $list] <= 1} { return [lindex $list 0] } set list [lsort $list] set min [lindex $list 0] set max [lindex $list end] # Min and max are the two strings which are most different. If # they have a common prefix, it will also be the common prefix for # all of them. # Fast bailouts for common cases. set n [string length $min] if {$n == 0} { return "" } if {$min eq $max} { return $min } set prefix "" set i 0 while {[string index $min $i] eq [string index $max $i]} { append prefix [string index $min $i] if {[incr i] > $n} {break} } return $prefix } # # ## ### ##### ######## ############# ##################### return