1# string.tcl --
2#
3#	Utilities for manipulating strings, words, single lines,
4#	paragraphs, ...
5#
6# Copyright (c) 2000      by Ajuba Solutions.
7# Copyright (c) 2000      by Eric Melski <ericm@ajubasolutions.com>
8# Copyright (c) 2002      by Joe English <jenglish@users.sourceforge.net>
9# Copyright (c) 2001-2006 by Andreas Kupries <andreas_kupries@users.sourceforge.net>
10#
11# See the file "license.terms" for information on usage and redistribution
12# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
13#
14# RCS: @(#) $Id: string.tcl,v 1.2 2008/03/22 16:03:11 mic42 Exp $
15
16# ### ### ### ######### ######### #########
17## Requirements
18
19package require Tcl 8.2
20
21namespace eval ::textutil::string {}
22
23# ### ### ### ######### ######### #########
24## API implementation
25
26# @c Removes the last character from the given <a string>.
27#
28# @a string: The string to manipulate.
29#
30# @r The <a string> without its last character.
31#
32# @i chopping
33
34proc ::textutil::string::chop {string} {
35    return [string range $string 0 [expr {[string length $string]-2}]]
36}
37
38# @c Removes the first character from the given <a string>.
39# @c Convenience procedure.
40#
41# @a string: string to manipulate.
42#
43# @r The <a string> without its first character.
44#
45# @i tail
46
47proc ::textutil::string::tail {string} {
48    return [string range $string 1 end]
49}
50
51# @c Capitalizes first character of the given <a string>.
52# @c Complementary procedure to <p ::textutil::uncap>.
53#
54# @a string: string to manipulate.
55#
56# @r The <a string> with its first character capitalized.
57#
58# @i capitalize
59
60proc ::textutil::string::cap {string} {
61    return [string toupper [string index $string 0]][string range $string 1 end]
62}
63
64# @c unCapitalizes first character of the given <a string>.
65# @c Complementary procedure to <p ::textutil::cap>.
66#
67# @a string: string to manipulate.
68#
69# @r The <a string> with its first character uncapitalized.
70#
71# @i uncapitalize
72
73proc ::textutil::string::uncap {string} {
74    return [string tolower [string index $string 0]][string range $string 1 end]
75}
76
77# Compute the longest string which is common to all strings given to
78# the command, and at the beginning of said strings, i.e. a prefix. If
79# only one argument is specified it is treated as a list of the
80# strings to look at. If more than one argument is specified these
81# arguments are the strings to be looked at. If only one string is
82# given, in either form, the string is returned, as it is its own
83# longest common prefix.
84
85proc ::textutil::string::longestCommonPrefix {args} {
86    return [longestCommonPrefixList $args]
87}
88
89proc ::textutil::string::longestCommonPrefixList {list} {
90    if {[llength $list] <= 1} {
91	return [lindex $list 0]
92    }
93
94    set list [lsort $list]
95    set min [lindex $list 0]
96    set max [lindex $list end]
97
98    # Min and max are the two strings which are most different. If
99    # they have a common prefix, it will also be the common prefix for
100    # all of them.
101
102    # Fast bailouts for common cases.
103
104    set n [string length $min]
105    if {$n == 0} {return ""}
106    if {0 == [string compare $min $max]} {return $min}
107
108    set prefix ""
109    set i 0
110    while {[string index $min $i] == [string index $max $i]} {
111	append prefix [string index $min $i]
112	if {[incr i] > $n} {break}
113    }
114    set prefix
115}
116
117# ### ### ### ######### ######### #########
118## Data structures
119
120namespace eval ::textutil::string {
121    # Export the imported commands
122
123    namespace export chop tail cap uncap
124    namespace export longestCommonPrefix
125    namespace export longestCommonPrefixList
126}
127
128# ### ### ### ######### ######### #########
129## Ready
130
131package provide textutil::string 0.7.1
132