#####################################################################
 #
 # This code implements the following Tcl 8.1.1 commands, allowing you
 # to use them in earlier versions of Tcl:
 #     String: 
 #         equal - the '-nocase' and '-length' options are not implemented
 #         is boolean - the '-failindex' option is not implemented
 #         is false   -  "       "         "        "       "
 #         is integer -  "       "         "        "       "
 #         is true    -  "       "         "        "       "
 #         map  - the '-nocase' option is not implemented.  See the notes
 #                in the source for other limitations.
 #         repeat
 #
 #####################################################################
 package require Tcl
 if {[package vcompare [package provide Tcl] 8.1] < 0} {
    rename string Tcl8.1_string
    proc string {cmd args} {
        switch -exact -- $cmd {

            #
            # "string equal"
            #
            eq    -
            equ   -
            equa  -
            equal {
                if {[llength $args] != 2} {
                    return -code error \
                          "wrong # args, should be string equal string1 string2"
                }
                foreach {str1 str2} $args break
                return [StringEqual $str1 $str2]
            }

            #
            # "string is (boolean or false or int or true)"
            #
            is {
                if {([llength $args] < 2) || ([llength $args] > 3)} {
                    return -code error \
                          "wrong # args, should be string is class ?-strict? string"
                }
                set class [lindex $args 0]
                set args [lrange $args 1 end]
                switch -exact -- $class {
                    b       -
                    bo      -
                    boo     -
                    bool    -
                    boole   -
                    boolea  -
                    boolean {
                        return [eval StringIsBoolean $args]
                    }
                    f     -
                    fa    -
                    fal   -
                    fals  -
                    false {
                        return [eval StringIsFalse $args]
                    }
                    i       -
                    in      -
                    int     -
                    inte    -
                    integ   -
                    intege  -
                    integer { 
                        return [eval StringIsInt $args]
                    }
                    t    -
                    tr   -
                    tru  -
                    true {
                        return [eval StringIsTrue $args]
                    }
                    default {
                        return -code error \
                              "bad class \"$class\": must be boolean, false, integer or true"
                    }
                } 
            }

            #
            # "string map"
            #
            map {
                if {[llength $args] != 2} {
                    return -code error \
                          "wrong # args, should be string map charMap string"
                }
                foreach {charMap str} $args break
                return [StringMap $charMap $str]
            }

            #
            # "string repeat"
            #
            repe   -
            repea  -
            repeat {
                if {[llength $args] != 2} {
                    return -code error \
                          "wrong # args, should be string repeat string count"
                }
                foreach {str n} $args break
                return [StringRepeat $str $n]
            }
        }
        uplevel [list Tcl8.1_string $cmd] $args
    }


    #
    # This procedure implements the "string equal" command
    #
    proc StringEqual {str1 str2} {
        if {[string compare $str1 $str2] == 0} {
            return 1
        } else {
            return 0
        }
    }


    #
    # This procedure implements the "string is boolean" command
    #
    proc StringIsBoolean {args} {
        if {[eval StringIsFalse $args] || [eval StringIsTrue $args]} {
            return 1
        } else {
            return 0
        }
    }


    #
    # This procedure implements the "string is false" command
    #
    proc StringIsFalse {args} {
        if {[llength $args] == 2} {
            #
            # There are two arguments; the first one must be "-strict"
            #
            if {![eval ValidStrict $args]} {
                return 0
            } else {
                #
                # Reduce the arguments to a single string
                #
                set args [lindex $args 1]
            }
        }
        set str [string toupper [lindex $args 0]]
        switch -exact -- $str {
            ""    -
            F     -
            FA    -
            FAL   -
            FALS  -
            FALSE -
            OF    -
            OFF   -
            N     -
            NO    -
            0     {
                return 1
            } 
            default {
                return 0
            }
        } 
    }


    #
    # This procedure implements the "string is true" command
    #
    proc StringIsTrue {args} {
        if {[llength $args] == 2} {
            #
            # There are two arguments; the first one must be "-strict"
            #
            if {![eval ValidStrict $args]} {
                return 0
            } else {
                #
                # Reduce the arguments to a single string
                #
                set args [lindex $args 1]
            }
        }
        set str [string toupper [lindex $args 0]]
        switch -exact -- $str {
            ""    -
            T     -
            TR    -
            TRU   - 
            TRUE  -
            Y     -
            YE    -
            YES   -
            ON    -
            1     {
                return 1
            } 
            default {
                return 0
            }
        } 
    }


    #
    # This procedure implements the "string is int" command
    #
    proc StringIsInt {args} {
        if {[llength $args] == 1} {
            #
            # There is only one argument, so a null string is a valid
            # integer.
            #
            if {[lindex $args 0] == ""} {
                return 1
            }
        } else {
            #
            # There are two arguments; the first one must be "-strict"
            #
            if {![eval ValidStrict $args]} {
                return 0
            } else {
                #
                # Reduce the arguments to a single string
                #
                set args [lindex $args 1]
            }
        }
        #
        # Args now consists of a single string which is the presumptive
        # integer.  We will try to convert it to one.
        #
        if {[catch {format %d [lindex $args 0]} temp] == 0} {
            return 1
        } else {
            return 0
        }
    }


    #
    # This procedure processes the '-strict' option for
    # 'string is (boolean, false, int, or true)'.  It returns:
    #   0 - '-strict' is specified and the argument is an empty string;
    #       therefore it is not a valid (boolean, false, int, or true).
    #   1 - '-strict' is specified but the argument is not an empty string;
    #       therefore the calling routine must evaluate it.
    #  If the first argument is not '-strict' this procedure raises an error.
    #
    proc ValidStrict {args} {
        if {[lindex $args 0] != "-strict"} {
            return -code error \
              "bad option \"[lindex $args 0]\": must be -strict"
        } else {
            if {[lindex $args 1] == ""} {
                return 0
            } else {
                return 1
            }
        }
    }


    #
    # This procedure implements a close approximation of the 
    # "string map" command.
    #
    # This implementation of "String Map" is not identical to the 
    # Tcl standard. It does not support the -nocase option, and 
    # it iterates over the string once for each Key-Value pair
    # (rather than just once as Tcl does).
    #
    # This produces different results if a Value is followed by a
    # matching Key.  For example:
    #    "string map {ab 12 cd 34}" - produces the same results as Tcl
    #    "string map {ab cd cd 34}" - will produce different results if
    #        the Key "ab" occurs in the target string.  Tcl will take a
    #        target string of "abcd" and produce "cd34"; this proc will
    #        produce "3434".
    #
    proc StringMap {charMap str} {
    
        foreach {old_char new_char} $charMap {
            set index [string first $old_char $str]
            if {$index >= 0} {
                set str1 [string range $str 0 [expr $index-1]]
                set str2 [string range $str [expr $index+[string length $old_char]] end]
                set str3 [StringMap [list $old_char $new_char] $str2]
                set str $str1$new_char$str3
            }
        }
        return $str
    }

    #
    # This procedure implements the "string repeat" command
    #
    proc StringRepeat {text n} {
        if {$n <= 0} {
            return ""
        } elseif {$n == 1} {
            return $text
        } elseif {$n == 2} {
            return $text$text
        } elseif {0 == ($n % 2)} {
            set result [StringRepeat $text [expr {$n / 2}]]
            return "$result$result"
        }
        return "$text[StringRepeat $text [incr n -1]]"
    }

 }

----
See also [string].
----
[Category Porting]