How do you justify text in Tcl

Justifying text (i.e., chopping a long string up into shorter lines) is pretty easy using Tcl's string functions. Note that the [string wordstart] function is targeted more at variable names than space-separated words, so we use [string last] here.

    set len 60
    while { [string length $longString] > 0 } {
        set brk [string last " " $longString $len]
        if { $brk < 0 } {set brk $len}
        puts "\t[string range $longString 0 $brk]"
        set longString [string range $longString [expr {$brk+1}] end]

Some years later, CL notices that this looks wrong; it mostly does one more line than necessary. The most natural correction appears to be

   proc simple_justify {text width} {
     for {set result {}} {[string length $text] > $width} {
                   set text [string range $text [expr {$brk+1}] end]
             } {
       set brk [string last " " $text $width]
       if { $brk < 0 } {set brk $width}
       append result [string range $text 0 $brk] \n
     return $result$text

Notice that this doesn't handle multi-blanks, embedded newlines, ...

How about something a bit simpler, that doesn't break up words?

   proc wordwrap {max msg} {
       if { [string length $msg] > $max } {
           regsub -all "(.{1,$max})( +|$)" $msg "\\1\\3\n" msg
       return $msg

DKF: Formatting text so that text on each line is fully justified is somewhat trickier.

See for authoritative copy, which includes variants for doing a more sophisticated job of it in text and canvas widgets.

I include here an article I wrote on the topic a few years ago.

 From: "Donal K. Fellows" <[email protected]>
 Newsgroups: comp.lang.tcl
 Subject: Re: Methods for Justifying text output in TCL
 Date: Sat, 16 Jun 2001 20:05:39 +0100
 Organization: Tcl Core Team
 Message-ID: <[email protected]>
 References: <[email protected]>
  <[email protected]>

 In article <[email protected]>, Phil Ehrens <pehrens@nospam> writes
 >Thane Reaver wrote:
 >> I am interested in finding some methods for producing fully justified text
 >> output in TCL, not in TK.  The problem is simple.
 >The usual way of doing  this is to  prepend a  space to  each  word
 >starting with the LAST word in the line, and NOT to prepend a space
 >to words of less than 2 or 3 characters.

 I tend to use a different technique based on the idea of trying to
 distribute the extra spaces as evenly over the line as possible.  It
 seems to work fairly well...

 I attach a demo.


------------ BEGIN JUSTIFY.TCL ------------

# Calculate the indices into the paragraph where words start.
# Assumes no leading spaces (or tabs) and breaks over hyphens too.
proc getWordIndices {text {extraBreakChars ""}} {
    set indices [list 0]
    set words [split $text " -$extraBreakChars"]
    set index [string length [lindex $words 0]]
    foreach word [lrange $words 1 end] {
        incr index
        if {![string length $word]} {continue}
        lappend indices $index
        incr index [string length $word]
    return $indices

# Convert text (in a *single* font) into a list of words, required
# space, and widths of words (with and without required space added.)
# Used to drive the line-breaking algorithm.
proc getLengths {text font} {
    set wis [getWordIndices $text]
    set words {}
    for {set i 0} {$i+1<[llength $wis]} {} {
        lappend words [string range $text [lindex $wis $i] \
                [expr {[lindex $wis [incr i]]-1}]]
    set lengths {}
    set m [string length $font]
    foreach word [lappend words \
            [string range $text [lindex $wis end] end]] {
        set st [string trim $word]
        if {$m} {
            lappend lengths $st \
                    [string range $word [string length $st] end]\
                    [font measure $font $word] [font measure $font $st]
        } else {
            lappend lengths $st \
                    [string range $word [string length $st] end]\
                    [string length $word] [string length $st]
    return $lengths

# Convert the output of [getLengths] into a list of line-widths and
# lines, where each line consists of a list of words (including required
# spaces when not at the end of the line) and widths of those words.
# Recombines hyphenated words when these are not broken across lines.
proc getBrokenLines {lengths widthmap} {
    set linenumber 0
    set linewidth [eval $widthmap [list $linenumber]]
    set lines {}
    set curline {}
    set curwidth 0
    set lastspc {}
    set lastword {}
    set lastgap 0
    set lastswidth 0
    set lasttwidth 0
    foreach {word space swidth twidth} $lengths {
        if {$curwidth+$lastgap+$twidth > $linewidth} {
            lappend curline $lastword $lasttwidth
            lappend lines $curline
            set curline {}
            set linewidth [eval $widthmap [list [incr linenumber]]]
            set curwidth 0
        } elseif {$lasttwidth} {
            lappend curline $lastword$lastspc $lastswidth
        set curwidth [expr {$curwidth+$lastgap+$twidth}]
        set lastgap [expr {$swidth-$twidth}]
        set lastspc $space
        set lastswidth $swidth
        set lasttwidth $twidth
        set lastword $word
    lappend lines [lappend curline $lastword $lasttwidth]
    set clines {}
    foreach line $lines {
        set oc {}
        set ow 0
        set combined {}
        set tw 0
        foreach {chunk w} $line {
            if {[string compare $chunk [string trim $chunk]]} {
                lappend combined $oc$chunk [expr {$w+$ow}]
                set oc {}
                set ow 0
            } else {
                append oc $chunk
                set ow [expr {$ow+$w}]
            set tw [expr {$tw+$w}]
        if {$ow} {lappend combined $oc $ow}
        lappend clines $tw $combined
    set clines

proc simpleWidthMap {mainwidth firstwidth linenumber} {
    expr {$linenumber>0||$firstwidth==0 ? $mainwidth : $firstwidth}

# Takes the text of a paragraph to justify and a width in characters,
# and produces the justified paragraph (with spaces and newlines
# inserted so as to make each line except the last contain exactly
# $width characters with each containing the maximum number of words.)
proc justify {string width} {
    set info [getBrokenLines [getLengths $string {}] \
            [list simpleWidthMap $width 0]]
    set numlines [expr {[llength $info] / 2}]
    set ln 0
    set output {}
    foreach {lw ld} $info {
        if {[incr ln] == $numlines} {
            foreach {s w} $ld {
                append output $s
        set diff [expr {$width-$lw}]
        set each [expr {double($diff)/$lw}]
        set cur 0.0
        set line {}
        set done 0
        foreach {s w} [lrange $ld 0 [expr {[llength $ld]-3}]] {
            append line $s
            set cur [expr {$cur + ($each*$w) + $w}]
            incr done $w
            while {($cur-$done) > 1.0} {
                append line " "
                incr done
        append output $line [lindex $ld [expr {[llength $ld]-2}]] "\n"
    return $output

# Some text from a message by Phil Ehrens
# <[email protected]> though this algorithm doesn't break
# lines in quite the same places as he did in the original message.  Not
# sure why.
set text {The usual way of doing this is to prepend a space to each\
        word starting with the LAST word in the line, and NOT to\
        prepend a space to words of less than 2 or 3 characters.\
        Additional padding can be added after [,.!?], and extra spaces\
        can be prepended to words that are longer than, say 9\
        characters. This is the simpleminded way which assumes that the\
        lines in the inital input are within a few characters in length\
        of each other.}

if {$tcl_platform(platform) != "unix"} {
    console show
    console eval {.console configure -font {Courier 10}}
puts [justify $text 67]

See also the textutil module of tcllib, and ::textutil::adjust in particular.