/usr/share/tcltk/tcllib1.19/textutil/trim.tcl is in tcllib 1.19-dfsg-2.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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.2
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.7
|