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
|
namespace eval ::textutil {
namespace eval trim {
variable StrU "\[ \t\]+"
variable StrR "(${StrU})\$"
variable StrL "^(${StrU})"
namespace export trim trimright trimleft \
trimPrefix trimEmptyHeading
# This will be redefined later. We need it just to let
# a chance for the next import subcommand to work
#
proc trimleft { text { trim "[ \t]+" } } { }
proc trimright { text { trim "[ \t]+" } } { }
proc trim { text { trim "[ \t]+" } } { }
proc trimPrefix {text prefix} {}
proc trimEmptyHeading {text} {}
}
namespace import -force trim::trim trim::trimleft trim::trimright trim::trimPrefix trim::trimEmptyHeading
namespace export trim trimleft trimright trimPrefix trimEmptyHeading
}
proc ::textutil::trim::trimleft {text {trim "[ \t]+"}} {
regsub -line -all -- [MakeStr $trim left] $text {} text
return $text
}
proc ::textutil::trim::trimright {text {trim "[ \t]+"}} {
regsub -line -all -- [MakeStr $trim right] $text {} text
return $text
}
proc ::textutil::trim::trim {text {trim "[ \t]+"}} {
regsub -line -all -- [MakeStr $trim left] $text {} text
regsub -line -all -- [MakeStr $trim right] $text {} text
return $text
}
proc ::textutil::trim::MakeStr { string pos } {
variable StrU
variable StrR
variable StrL
if { "$string" != "$StrU" } {
set StrU $string
set StrR "(${StrU})\$"
set StrL "^(${StrU})"
}
if { "$pos" == "left" } {
return $StrL
}
if { "$pos" == "right" } {
return $StrR
}
return -code error "Panic, illegal position key \"$pos\""
}
# @c Strips <a prefix> from <a text>, if found at its start.
#
# @a text: The string to check for <a prefix>.
# @a prefix: The string to remove from <a text>.
#
# @r The <a text>, but without <a prefix>.
#
# @i remove, prefix
proc ::textutil::trim::trimPrefix {text prefix} {
if {[string first $prefix $text] == 0} {
return [string range $text [string length $prefix] end]
} else {
return $text
}
}
# @c Removes the Heading Empty Lines of <a text>.
#
# @a text: The text block to manipulate.
#
# @r The <a text>, but without heading empty lines.
#
# @i remove, empty lines
proc ::textutil::trim::trimEmptyHeading {text} {
regsub -- "^(\[ \t\]*\n)*" $text {} text
return $text
}
|
