|
|
Posted by slebetman@yahoo.com on 04/21/06 22:15
comp.lang.tcl wrote:
> Gerald W. Lester wrote:
> > Bryan Oakley wrote:
> > > comp.lang.tcl wrote:
> > >> Sorry, there is no further description I can give you. tclsh locks,
> > >> produces 100% CPU usage when you view via top, no error logs of any
> > >> kind.
> > >>
> > >> Here is PROPER_CASE:
> > >> <snip>
> > >
> > > Holy cow! All that just to change the case of words in a string?
> > >
> > > The proc is a bit buggy at first glance. It's amazing it works at all.
> > > It takes a string, does some string operations on it, then iterates over
> > > it as if it were a list and performs list operations on it. Then, it
> > > takes the list, performs string operations on it and returns a string.
> > >
> > > Indeed, testing it out by copying it into a tclsh session, it _is_
> > > buggy. If the first char is "-" it gets in an infinite loop.
> > >
> > > Maybe you should file a bug with whomever wrote PROPER_CASE instead of
> > > trying to work around its limitations.
> > >
> >
> > It does a *little* more than [string totitle $string] -- it ignores two
> > letter state "names" -- but not much.
> >
>
> Last I checked [string totitle] doesn't capitalize hyphenated names,
> Scots/Irish/Dutch names, etc. I wrote it back in 2000, when I only had
> about a year's knowledge of TCL at the time, I'm sure it needs a bit of
> fine-tuning, but it does the job it's supposed to do.
You should factor out some of the code in there. Not because it is
faster, or to make the code re-usable or even to save memory but simply
to make it easier to understand. Here's a work-alike version I whipped
up in about 2 minutes:
######
# Reformats a string to have proper case
######
proc properCase {str} {
set ret ""
foreach x [split $str " \t\n\r"] {
append ret "[caseFormat [string trim $x]]"
append ret " "
}
return $ret
}
########
# Applies case formatting rule to a word
########
proc caseFormat {word} {
if {[set ret [irishScotFormat $word]] != ""} {
return $ret
}
if {[set ret [smallWordFormat $word]] != ""} {
return $ret
}
if {[set ret [statesFormat $word]] != ""} {
return $ret
}
return [string totitle $word [firstAlpha $word] end]
}
# Returns first alpha char in a word
proc firstAlpha {word} {
for {set i 0} {$i < [string length $word]} {incr i} {
if {[string is alpha [string index $word $i]]} {
return $i
}
}
return end
}
################ Formatting rules:
proc smallWordFormat {word} {
if {[lsearch -exact {
a an in of and at is
} $word] != -1} {
return $word
}
return ""
}
proc irishScotFormat {word} {
return ""
}
proc statesFormat {word} {
set word [string toupper $word]
if {[lsearch -exact {
AL AK AR AZ CA CO CT DE DC FL GA
HI ID IL IN IA KS KY LA ME MD MA
MI MN MS MO MT NE NV NH NJ NM NY
NC ND OH OK OR PA RI SC SD TN TX
UT VT VA WA WV WI WY PR GU VI NE
NW SE SW N.E. S.E. S.W. N.W.
} $word] != -1} {
return $word
}
return ""
}
I haven't implemented the irishScotFormat proc partly because I'm not
sure what you want and partly because I'm too lazy to do it. Notice
that the bulk of the processing happens in caseFormat which only have
to handle a single word at a time. This simplifies the properCase proc
to simply parse the string a word at a time without having to worry
about the processing. It's also very easy to add in more formatting
checks in the caseFormat proc.
Hope this helps you a little, I just had to re-implement it, the
[PROPER_CASE] proc was too ugly for me to resist.
Navigation:
[Reply to this message]
|