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
|
package require Tcl 8.2
namespace eval ::textutil {
namespace export strRepeat
variable HaveStrRepeat [ expr {![ catch { string repeat a 1 } ]} ]
if {0} {
# Problems with the deactivated code:
# - Linear in 'num'.
# - Tests for 'string repeat' in every call!
# (Ok, just the variable, still a test every call)
# - Fails for 'num == 0' because of undefined 'str'.
proc StrRepeat { char num } {
variable HaveStrRepeat
if { $HaveStrRepeat == 0 } then {
for { set i 0 } { $i < $num } { incr i } {
append str $char
}
} else {
set str [ string repeat $char $num ]
}
return $str
}
}
}
if {$::textutil::HaveStrRepeat} {
proc ::textutil::strRepeat {char num} {
return [string repeat $char $num]
}
proc ::textutil::blank {n} {
return [string repeat " " $n]
}
} else {
proc ::textutil::strRepeat {char num} {
if {$num <= 0} {
# No replication required
return ""
} elseif {$num == 1} {
# Quick exit for recursion
return $char
} elseif {$num == 2} {
# Another quick exit for recursion
return $char$char
} elseif {0 == ($num % 2)} {
# Halving the problem results in O (log n) complexity.
set result [strRepeat $char [expr {$num / 2}]]
return "$result$result"
} else {
# Uneven length, reduce problem by one
return "$char[strRepeat $char [incr num -1]]"
}
}
proc ::textutil::blank {n} {
return [strRepeat " " $n]
}
}
# @c Removes the last character from the given <a string>.
#
# @a string: The string to manipulate.
#
# @r The <a string> without its last character.
#
# @i chopping
proc ::textutil::chop {string} {
return [string range $string 0 [expr {[string length $string]-2}]]
}
# @c Removes the first character from the given <a string>.
# @c Convenience procedure.
#
# @a string: string to manipulate.
#
# @r The <a string> without its first character.
#
# @i tail
proc ::textutil::tail {string} {
return [string range $string 1 end]
}
# @c Capitalizes first character of the given <a string>.
# @c Complementary procedure to <p ::textutil::uncap>.
#
# @a string: string to manipulate.
#
# @r The <a string> with its first character capitalized.
#
# @i capitalize
proc ::textutil::cap {string} {
return [string toupper [string index $string 0]][string range $string 1 end]
}
# @c unCapitalizes first character of the given <a string>.
# @c Complementary procedure to <p ::textutil::cap>.
#
# @a string: string to manipulate.
#
# @r The <a string> with its first character uncapitalized.
#
# @i uncapitalize
proc ::textutil::uncap {string} {
return [string tolower [string index $string 0]][string range $string 1 end]
}
# Compute the longest string which is common to all strings given to
# the command, and at the beginning of said strings, i.e. a prefix. If
# only one argument is specified it is treated as a list of the
# strings to look at. If more than one argument is specified these
# arguments are the strings to be looked at. If only one string is
# given, in either form, the string is returned, as it is its own
# longest common prefix.
proc ::textutil::longestCommonPrefix {args} {
return [longestCommonPrefixList $args]
}
proc ::textutil::longestCommonPrefixList {list} {
if {[llength $list] == 0} {
return ""
} elseif {[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 {0 == [string compare $min $max]} {return $min}
set prefix ""
for {set i 0} {$i < $n} {incr i} {
if {0 == [string compare [set x [string range $min 0 $i]] [string range $max 0 $i]]} {
set prefix $x
continue
}
break
}
return $prefix
}
source [ file join [ file dirname [ info script ] ] adjust.tcl ]
source [ file join [ file dirname [ info script ] ] split.tcl ]
source [ file join [ file dirname [ info script ] ] tabify.tcl ]
source [ file join [ file dirname [ info script ] ] trim.tcl ]
# Do the [package provide] last, in case there is an error in the code above.
package provide textutil 0.7
|
