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