1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
|
#
# textutil.tcl
# March 1995
# Simple text-formatting utilities
#
proc repeatstr {str n} {
set result "";
while {$n > 0} {
append result $str;
incr n -1
}
return $result
}
### Line-oriented procedures:
# replace tabs with spaces.
proc detabline {line {tabstop 8}} {
if {[string first "\t" $line] == -1} {return $line}
set spaces 0
set result ""
set col 0
foreach chunk [split $line "\t"] {
append result [repeatstr { } $spaces]
append result $chunk
incr col $spaces
incr col [string length $chunk]
set spaces [expr $tabstop - $col % $tabstop]
}
return $result
}
# padline line len
# pad 'line' with blanks on the right until it is 'len' chars long
proc padline {line {linelen 70}} {
set line [string trimright $line]
set l [string length $line]
while {$l < $linelen} {
incr l
append line " "
}
return $line
}
# rjustline, centerline
# right-justify and center a line
proc rjustline {line {linelen 70}} {
return "[repeatstr { } [expr $linelen - [string length $line]]]$line"
}
proc centerline {line {linelen 70}} {
return "[repeatstr { } [expr ($linelen - [string length $line])/2]]$line"
}
# make a three-part line with left, center, and right parts
# (useful for headers, footers)
#
proc threepart {lft mid rgt {linelen 70}} {
set space [expr ($linelen - [string length $mid])]
set lpad [expr $space/2 - [string length $lft]]
set rpad [expr $space/2 - [string length $rgt]]
if {$space % 2 == 1} { incr rpad }
return "${lft}[repeatstr { } $lpad]${mid}[repeatstr { } $rpad]${rgt}"
}
### Line list routines:
proc maxwidth {lines} {
set width 0
foreach line $lines {
if {[string length $line] > $width} {
set width [string length $line]
}
}
return $width
}
proc rjust {lines {linelen 70}} {
set result ""
foreach line $lines {
set line [string trim $line]
lappend result \
"[repeatstr { } [expr $linelen - [string length $line]]]$line"
}
return $result
}
proc ljust {lines {linelen 70}} {
set result ""
foreach line $lines {
set line [string trim $line]
lappend result [padline $line $linelen]
}
return $result
}
proc center {lines {linelen 70}} {
set result ""
foreach line $lines {
set line [string trim $line]
lappend result [centerline $line $linelen]
}
return $result
}
proc indent {lines indent} {
set result {}
set spc [repeatstr { } $indent]
foreach line $lines {
lappend result "$spc[string trimright $line]"
}
return $result
}
proc adjoin {lines1 lines2 {sep { }}} {
set result "" ;
set len1 [string length [lindex $lines1 0]]
set len2 [string length [lindex $lines2 0]]
if {[llength $lines1] <= [llength $lines2]} {
foreach line $lines1 {
lappend result "${line}${sep}[lindex $lines2 0]"
set lines2 [lreplace $lines2 0 0]
}
set sep "[repeatstr { } $len1]${sep}"
foreach line $lines2 {
lappend result "${sep}${line}"
}
} else {
foreach line $lines2 {
lappend result "[lindex $lines1 0]$sep$line"
set lines1 [lreplace $lines1 0 0]
}
set sep "$sep[repeatstr { } $len2]"
foreach line $lines1 {
lappend result "$line$sep"
}
}
return $result
}
proc underscore {lines {score =}} {
lappend lines [repeatstr $score [maxwidth $lines]]
return $lines
}
proc boxlines {lines {width 0}} {
set margin 1;
set result "";
set lm "|[repeatstr " " $margin]"
set rm "[repeatstr " " $margin]|"
if {$width == 0} { set width [maxwidth $lines] }
set vline ".[repeatstr - [expr $margin + $margin + $width]]."
lappend result $vline;
foreach line $lines {
lappend result "$lm[padline $line $width]$rm"
}
lappend result $vline
return $result
}
proc upcase {lines} { return [string toupper $lines] }
proc downcase {lines} { return [string tolower $lines] }
proc putlines {lines {fp stdout}} {
foreach line $lines { puts $fp $line }
return ""
}
proc wordwrap {words {linelen 70}} {
set lines {}
set curlen 0
set curline ""
foreach word $words {
if [set wordlen [string length $word]] {
if {[incr curlen $wordlen] > $linelen} {
lappend lines [string trimright $curline]
set curline ""
set curlen $wordlen
}
append curline "$word "
incr curlen; # account for final space
}
}
if {$curline != ""} {
lappend lines [string trimright $curline]
}
return $lines
}
|
