Merge commit '7c621da28f07e449ad90c387344f07a453927569' as 'tcllib'

6 files changed, 326 insertions, 0 deletions

diff --git a/tcllib/modules/soundex/ChangeLog b/tcllib/modules/soundex/ChangeLog
new file mode 100644
index 0000000..5abf12e
--- /dev/null
+++ b/tcllib/modules/soundex/ChangeLog
@@ -0,0 +1,102 @@
+2013-02-01  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	*
+	* Released and tagged Tcllib 1.15 ========================
+	* 
+
+2011-12-13  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	*
+	* Released and tagged Tcllib 1.14 ========================
+	* 
+
+2011-01-24  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	*
+	* Released and tagged Tcllib 1.13 ========================
+	* 
+
+2009-12-07  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	*
+	* Released and tagged Tcllib 1.12 ========================
+	* 
+
+2008-12-12  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	*
+	* Released and tagged Tcllib 1.11.1 ========================
+	* 
+
+2008-10-16  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	*
+	* Released and tagged Tcllib 1.11 ========================
+	* 
+
+2008-06-14  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	* soundex.pcx: New file. Syntax definitions for the public
+	  commands of the soundex package.
+
+2007-09-12  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	*
+	* Released and tagged Tcllib 1.10 ========================
+	* 
+
+2007-03-21  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	* soundex.man: Fixed all warnings due to use of now deprecated
+	  commands. Added a section about how to give feedback.
+
+2006-10-03  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	*
+	* Released and tagged Tcllib 1.9 ========================
+	* 
+
+2006-01-26  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	* soundex.test: More boilerplate simplified via use of test support.
+
+2006-01-19  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	* soundex.test: Hooked into the new common test support code.
+
+2005-10-06  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	*
+	* Released and tagged Tcllib 1.8 ========================
+	* 
+
+2004-10-05  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	*
+	* Released and tagged Tcllib 1.7 ========================
+	* 
+
+2004-05-23  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	*
+	* Released and tagged Tcllib 1.6.1 ========================
+	* 
+
+2004-02-15  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	*
+	* Released and tagged Tcllib 1.6 ========================
+	* 
+
+2003-05-05  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	*
+	* Released and tagged Tcllib 1.4 ========================
+	* 
+
+2003-04-01  Andreas Kupries  <andreask@activestate.com>
+
+	* soundex.tcl: New module for soundex algorithms.
+	* soundex.man:
+	* soundex.test:
+	* pkgIndex.tcl:
diff --git a/tcllib/modules/soundex/pkgIndex.tcl b/tcllib/modules/soundex/pkgIndex.tcl
new file mode 100644
index 0000000..7be9812
--- /dev/null
+++ b/tcllib/modules/soundex/pkgIndex.tcl
@@ -0,0 +1,12 @@
+# Tcl package index file, version 1.1
+# This file is generated by the "pkg_mkIndex" command
+# and sourced either when an application starts up or
+# by a "package unknown" script.  It invokes the
+# "package ifneeded" command to set up package-related
+# information so that packages will be loaded automatically
+# in response to "package require" commands.  When this
+# script is sourced, the variable $dir must contain the
+# full path name of this file's directory.
+
+if {![package vsatisfies [package provide Tcl] 8.2]} {return}
+package ifneeded soundex 1.0 [list source [file join $dir soundex.tcl]]
diff --git a/tcllib/modules/soundex/soundex.man b/tcllib/modules/soundex/soundex.man
new file mode 100644
index 0000000..34adbb9
--- /dev/null
+++ b/tcllib/modules/soundex/soundex.man
@@ -0,0 +1,45 @@
+[comment {-*- tcl -*- doctools manpage}]
+[manpage_begin soundex n 1.0]
+[keywords knuth]
+[keywords soundex]
+[keywords {text comparison}]
+[keywords {text likeness}]
+[copyright {????, Algorithm: Donald E. Knuth}]
+[copyright {2003, Documentation: Andreas Kupries <andreas_kupries@users.sourceforge.net>}]
+[copyright {1998, Tcl port: Evan Rempel <erempel@uvic.ca>}]
+[moddesc   {Soundex}]
+[titledesc {Soundex}]
+[category  {Hashes, checksums, and encryption}]
+[require Tcl 8.2]
+[require soundex [opt 1.0]]
+[description]
+[para]
+
+This package provides soundex algorithms which allow the
+comparison of words based on their phonetic likeness.
+
+[para]
+
+Currently only an algorithm by Knuth is provided, which
+is tuned to english names and words.
+
+[list_begin definitions]
+
+[call [cmd ::soundex::knuth] [arg string]]
+
+Computes the soundex code of the input [arg string] using
+Knuth's algorithm and returns it as the result of the
+command.
+
+[list_end]
+
+[section EXAMPLES]
+
+[example {
+    % ::soundex::knuth Knuth
+    K530
+}]
+
+[vset CATEGORY soundex]
+[include ../doctools2base/include/feedback.inc]
+[manpage_end]
diff --git a/tcllib/modules/soundex/soundex.pcx b/tcllib/modules/soundex/soundex.pcx
new file mode 100644
index 0000000..bb1b280
--- /dev/null
+++ b/tcllib/modules/soundex/soundex.pcx
@@ -0,0 +1,26 @@
+# -*- tcl -*- soundex.pcx
+# Syntax of the commands provided by package soundex.
+#
+# For use by TclDevKit's static syntax checker (v4.1+).
+# See http://www.activestate.com/solutions/tcl/
+# See http://aspn.activestate.com/ASPN/docs/Tcl_Dev_Kit/4.0/Checker.html#pcx_api
+# for the specification of the format of the code in this file.
+#
+
+package require pcx
+pcx::register soundex
+pcx::tcldep   1.0 needs tcl 8.2
+
+namespace eval ::soundex {}
+
+#pcx::message FOO {... text ...} type
+#pcx::scan <VERSION> <NAME> <RULE>
+
+pcx::check 1.0 std ::soundex::knuth \
+    {checkSimpleArgs 1 1 {
+	checkWord
+    }}
+
+# Initialization via pcx::init.
+# Use a ::soundex::init procedure for non-standard initialization.
+pcx::complete
diff --git a/tcllib/modules/soundex/soundex.tcl b/tcllib/modules/soundex/soundex.tcl
new file mode 100644
index 0000000..08ba4fa
--- /dev/null
+++ b/tcllib/modules/soundex/soundex.tcl
@@ -0,0 +1,96 @@
+# soundex.tcl --
+#
+#	Implementation of soundex in Tcl
+#
+# Copyright (c) 2003 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: soundex.tcl,v 1.3 2004/01/15 06:36:14 andreas_kupries Exp $
+
+package require Tcl 8.2
+
+namespace eval ::soundex {}
+
+## ------------------------------------------------------------
+##
+## I. Soundex by Knuth.
+
+# This implementation of the Soundex algorithm is released to the public
+# domain: anyone may use it for any purpose.  See if I care.
+
+# N. Dean Pentcheff 1/13/89 Dept. of Zoology University of California Berkeley,
+#    CA  94720 dean@violet.berkeley.edu
+# TCL port by Evan Rempel 2/10/98 Dept Comp Services University of Victoria.
+# erempel@uvic.ca
+
+# proc ::soundex::knuth ( string )
+#
+#   Given as argument: a character string. Returns: a static string, 4 characters long
+#   This string is the Soundex key for the argument string.
+#   Side effects and limitations:
+#   Does not clobber the string passed in as the argument. No limit on
+#   argument string length. Assumes a character set with continuously
+#   ascending and contiguous letters within each case and within the digits
+#   (e.g. this works for ASCII and bombs in EBCDIC. But then, most things
+#   do.). Reference: Adapted from Knuth, D.E. (1973) The art of computer
+#   programming; Volume 3: Sorting and searching.  Addison-Wesley Publishing
+#   Company: Reading, Mass. Page 392.
+#   Special cases: Leading or embedded spaces, numerals, or punctuation are squeezed
+#   out before encoding begins.
+#
+#   Null strings or those with no encodable letters return the code 'Z000'.
+#
+#   Test data from Knuth (1973):
+#   Euler   Gauss   Hilbert Knuth   Lloyd   Lukasiewicz
+#   E460    G200    H416    K530    L300    L222
+
+namespace eval ::soundex {
+    variable  soundexKnuthCode
+    array set soundexKnuthCode {
+	a 0 b 1 c 2 d 3 e 0 f 1 g 2 h 0 i 0 j 2 k 2 l 4 m 5
+	n 5 o 0 p 1 q 2 r 6 s 2 t 3 u 0 v 1 w 0 x 2 y 0 z 2
+    }
+}
+proc ::soundex::knuth {in} {
+    variable soundexKnuthCode
+    set key ""
+
+    # Remove the leading/trailing white space punctuation etc.
+
+    set TempIn [string trim $in "\t\n\r .,'-"]
+
+    # Only use alphabetic characters, so strip out all others
+    # also, soundex index uses only lower case chars, so force to lower
+
+    regsub -all {[^a-z]} [string tolower $TempIn] {} TempIn
+    if {[string length $TempIn] == 0} {
+	return Z000
+    }
+    set last [string index $TempIn 0]
+    set key  [string toupper $last]
+    set last $soundexKnuthCode($last)
+
+    # Scan rest of string, stop at end of string or when the key is
+    # full
+
+    set count    1
+    set MaxIndex [string length $TempIn]
+
+    for {set index 1} {(($count < 4) && ($index < $MaxIndex))} {incr index } {
+	set chcode $soundexKnuthCode([string index $TempIn $index])
+	# Fold together adjacent letters sharing the same code
+	if {![string equal $last $chcode]} {
+	    set last $chcode
+	    # Ignore code==0 letters except as separators
+	    if {$last != 0} then {
+		set key $key$last
+		incr count
+	    }
+	}
+    }
+    return [string range ${key}0000 0 3]
+}
+
+package provide soundex 1.0
diff --git a/tcllib/modules/soundex/soundex.test b/tcllib/modules/soundex/soundex.test
new file mode 100644
index 0000000..a4d2bdf
--- /dev/null
+++ b/tcllib/modules/soundex/soundex.test
@@ -0,0 +1,45 @@
+# -*- tcl -*-
+# soundex.test:  tests for the soundex commands.
+#
+# This file contains a collection of tests for one or more of the Tcl
+# built-in commands.  Sourcing this file into Tcl runs the tests and
+# generates output for errors.  No output means no errors were found.
+#
+# Copyright (c) 2003 by Andreas Kupries <andreas_kupries@users.sourceforge.net>
+#
+# RCS: @(#) $Id: soundex.test,v 1.5 2006/10/09 21:41:42 andreas_kupries Exp $
+
+# -------------------------------------------------------------------------
+
+source [file join \
+	[file dirname [file dirname [file join [pwd] [info script]]]] \
+	devtools testutilities.tcl]
+
+testsNeedTcl     8.2
+testsNeedTcltest 1.0
+
+testing {
+    useLocal soundex.tcl soundex
+}
+
+# -------------------------------------------------------------------------
+
+namespace import ::soundex::knuth
+
+# -------------------------------------------------------------------------
+
+foreach {n in out} {
+    1.0 Euler       E460
+    1.1 Gauss       G200
+    1.2 Hilbert     H416
+    1.3 Knuth       K530
+    1.4 Lloyd       L300
+    1.5 Lukasiewicz L222
+} {
+    test soundex-$n {knuth soundex} {
+	::soundex::knuth $in
+    } $out
+}
+
+# -------------------------------------------------------------------------
+testsuiteCleanup