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
|
# trim.tcl --
#
# Various ways of trimming a string.
#
# Copyright (c) 2000 by Ajuba Solutions.
# Copyright (c) 2000 by Eric Melski <ericm@ajubasolutions.com>
# Copyright (c) 2001-2006 by Andreas Kupries <andreas_kupries@users.sourceforge.net>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: trim.tcl,v 1.5 2006/04/21 04:42:28 andreas_kupries Exp $
# ### ### ### ######### ######### #########
## Requirements
package require Tcl 8.5 9
namespace eval ::textutil::trim {}
# ### ### ### ######### ######### #########
## API implementation
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
}
# @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
}
# ### ### ### ######### ######### #########
## Helper commands. Internal
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\""
}
# ### ### ### ######### ######### #########
## Data structures
namespace eval ::textutil::trim {
variable StrU "\[ \t\]+"
variable StrR "(${StrU})\$"
variable StrL "^(${StrU})"
namespace export \
trim trimright trimleft \
trimPrefix trimEmptyHeading
}
# ### ### ### ######### ######### #########
## Ready
package provide textutil::trim 0.8
|
