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 http://www.man.ac.uk/~zzcgudf/tcl/wordwrap.tcl
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" <donal@ugglan.demon.co.uk> 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: <YthMCTAD46K7Ewkv@ugglan.demon.co.uk> References: <l3qW6.33169$Ts6.3367035@typhoon.we.rr.com> <9gdchh$qel@gap.cco.caltech.edu> In article <9gdchh$qel@gap.cco.caltech.edu>, Phil Ehrens <pehrens@nospam .ligo.caltech.edu> 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. Donal.------------ 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
}
continue
}
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
# <pehrens@nospam.ligo.caltech.edu> 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.
