#
# Example #1 (variables and commands)
#
set case_1 "this"
set case_2 "that"
set case_3 "foo"
set string_to_match "THIS"
dispatch -exact -nocase -- $string_to_match {
$case_1 {
# NOTICE we used a variable for this?
puts stdout "MATCHED case #1."
}
$case_2 {
# NOTICE we used a variable for this?
puts stdout "MATCHED case #2."
}
$case_3 {
# NOTICE we used a variable for this?
puts stdout "MATCHED case #3."
}
[string trim $string_to_match] {
# this case refers to the trimmed version of itself
# (the variable being matched), variations on this
# could prove quite useful.
puts stdout "MATCHED trimmed version of self."
}
"literal" -
default {
# NOTE: the above "literal" case would fall through to this case.
puts stdout "MATCHED default."
}
} #
# Example #2 (use with regexp):
#
set email_regexp {^([0-9A-Za-z])([0-9A-Za-z_\.\-]*)@([0-9A-Za-z])([0-9A-Za-z\.\-]*)$}
set string_to_match "billy@mistachkin.com"
dispatch -regexp -nocase -- $string_to_match {
$email_regexp {
# NOTICE we used a variable for this?
puts stdout "MATCHED, valid email address."
}
default {
puts stdout "MATCHED default."
}
} Main Source File (dispatch.tcl)
###############################################################################
#
# Tcl dispatch command
#
# Copyright (c) 2001-2003 by Joe Mistachkin. All rights reserved.
#
# written by: Joe Mistachkin <joe@mistachkin.com>
# created on: 10/07/2001
# modified on: 08/21/2003
#
###############################################################################
#
# The authors hereby grant permission to use, copy, modify, distribute,
# and license this software and its documentation for any purpose, provided
# that existing copyright notices are retained in all copies and that this
# notice is included verbatim in any distributions. No written agreement,
# license, or royalty fee is required for any of the authorized uses.
# Modifications to this software may be copyrighted by their authors
# and need not follow the licensing terms described here, provided that
# the new terms are clearly indicated on the first page of each file where
# they apply.
#
# IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
# FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
# ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
# DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
#
# THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE
# IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
# NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
# MODIFICATIONS.
#
# GOVERNMENT USE: If you are acquiring this software on behalf of the
# U.S. government, the Government shall have only "Restricted Rights"
# in the software and related documentation as defined in the Federal
# Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2). If you
# are acquiring the software on behalf of the Department of Defense, the
# software shall be classified as "Commercial Computer Software" and the
# Government shall have only "Restricted Rights" as defined in Clause
# 252.227-7013 (c) (1) of DFARs. Notwithstanding the foregoing, the
# authors grant the U.S. Government and others acting in its behalf
# permission to use and distribute the software in accordance with the
# terms specified in this license.
#
###############################################################################
# REQUIRES Tcl 8.0+
package require "Tcl" "8.0"
# maximum possible number of arguments for dispatch proc
set dispatch_maximum_arguments "8"
# dispatch error string
set dispatch_argument_error "wrong # args: should be \"dispatch ?switches? string pattern body ... ?default body?\""
# THESE are ALL the allowed switches for the dispatch proc
# (except for "--", which is a special case)
set dispatch_switches [list "-exact" "-nocase" "-expr" "-glob" "-regexp" "-all"]
# dispatch switch error string
set dispatch_switch_error "bad option, must be one of: $dispatch_switches"
# do not change this
set dispatch_name "Tcl_dispatch"
# do not change this
set dispatch_version "2.7"
proc valid_switch { argument variable_name } {
#
# check if valid switch (is it in the list?)...
#
if {[string index $argument "0"] == "-"} then {
if {$variable_name != ""} then {
if {$argument == "--"} then {
# value 4 means "end of switches"
# (this is always a valid switch)
set result "4"
} else {
if {(([string index $argument "0"] == "-") && ([string is integer -strict [string range $argument "1" "end"]] != "0"))} then {
# this is the integer value for use in the future...
# value 3 means "valid switch"
set result "3"
} else {
upvar "1" $variable_name valid_switches
if {[lsearch $valid_switches $argument] != "-1"} then {
# value 3 means "valid switch"
set result "3"
} else {
# value 2 means "not a supported switch"
set result "2"
}
}
}
} else {
# value 1 means "invalid variable name" (in this context)
set result "1"
}
} else {
# value 0 means "not a switch OR not a supported switch"
set result "0"
}
return $result
}
proc check_switch { argument variable_name force } {
#
# simply see if passed argument is a supported option
#
if {[string index $argument "0"] == "-"} then {
if {$variable_name != ""} then {
set switch_name [string range $argument "1" "end"]
# get a handle on the variable (array) that we need to modify
upvar "1" $variable_name switches
# if always allow or if the switch is actually considered valid...
if {(($force != "0") || ([info exists switches($switch_name)] != "0"))} then {
# value 1 means "switch enabled"
set switches($switch_name) "1"
# value 1 means "processed switch"
set result "1"
} else {
if {[string is integer -strict $argument] != "0"} then {
# set the integer value for use in the future...
set switches(value) $argument
# value 1 means "processed switch"
set result "1"
} else {
# value 2 means "invalid switch"
set result "2"
}
}
} else {
# value 0 means "did NOT process switch"
set result "0"
}
} else {
# value 0 means "did NOT process switch"
set result "0"
}
return $result
}
proc dispatch { args } {
#
# This is the OUTER dispatch proc. It handles translation of switches
# and then forwards the request to dispatch_internal.
#
global dispatch_argument_error
global dispatch_maximum_arguments
global dispatch_switch_error
global dispatch_switches
set result ""
# the integer value for use in the future...
set switches(value) "0"
# all the possible switches...
set switches(exact) "0"
set switches(nocase) "0"
set switches(expr) "0"
set switches(glob) "0"
set switches(regexp) "0"
set switches(all) "0"
set switches(end) "0"
set count [llength $args]
if {$count <= $dispatch_maximum_arguments} then {
#
# this loop is trying to find "the first non-switch argument"...
#
set invalid "0"
set found "0"
set index "0"
while {(($index < $count) && ($found == "0") && ($invalid == "0"))} {
set is_switch [valid_switch [lindex $args $index] dispatch_switches]
switch -exact -- $is_switch {
"0" {
#
# we are done, we found an actual non-switch argument...
#
set found "1"
}
"1" {
#
# invalid...
#
set invalid "1"
}
"2" {
#
# we are done, we found an invalid switch...
#
set invalid "1"
}
"3" {
#
# found a valid switch, process it
#
check_switch [lindex $args $index] switches "1"
# skip to next index now
set index [expr {$index + "1"}]
}
"4" {
#
# found FINAL switch, process it
#
check_switch [lindex $args $index] switches "1"
# skip to next index now
# next argument, this is still a switch
set index [expr {$index + "1"}]
set found "1"
}
default {
# we found something invalid...???
set invalid "1"
}
}
}
if {$found != "0"} then {
# we must have at least two arguments left...
if {$index < ($count - "1")} then {
# what are we dispatching on?
set dispatch_string [lindex $args $index]
# advance to the next argument.
set index [expr {$index + "1"}]
# this is the body that contains the different possible matches...
set dispatch_body [lindex $args $index]
#
# the magic number "2" in this command is the
# parameter required for the uplevel commands
# contained within dispatch_internal
#
set result [dispatch_internal $switches(exact) $switches(nocase) $switches(expr) $switches(glob) $switches(regexp) $switches(all) $switches(end) "2" $dispatch_string $dispatch_body]
set dispatch_error "0"
} else {
set dispatch_error "1"
}
} else {
if {$invalid != "0"} then {
set dispatch_error "2"
} else {
set dispatch_error "1"
}
}
} else {
set dispatch_error "1"
}
switch -exact -- $dispatch_error {
"1" {
error $dispatch_argument_error
}
"2" {
error $dispatch_switch_error
}
}
return $result
}
proc dispatch_internal { dispatch_exact dispatch_nocase dispatch_expr dispatch_glob dispatch_regexp dispatch_all dispatch_end dispatch_level dispatch_string dispatch_body } {
global dispatch_argument_error
#
# NOTE: This does NOT function EXACTLY the same as the "switch" command, but it's pretty darn close.
#
# 1. ALL of the standard switches for "switch" are supported plus "-nocase".
# 2. default case can be anywhere (matching STOPS when it is found).
# 3. string variables ARE supported (the main reason this proc exists).
# 4. commands are supported for the PATTERNS as well as the script bodies
# (must be enclosed in curly braces)...
#
# NOTE: Obviously, the length of the dispatch_body argument list must be divisible by 2.
#
set result ""
# must have some elements dispatch_body...
if {[llength $dispatch_body] > "0"} then {
# must have even number of elements in dispatch_body
if {[llength $dispatch_body] % "2" == "0"} then {
#
# initially, we will return null if nothing matches...
# same as switch
#
set evaluated "0"
set matched "0"
foreach {this_pattern this_body} $dispatch_body {
#
# make sure we aren't just searching for a proc body
#
if {$matched == "0"} then {
#
# check if it's the default
#
if {$this_pattern == "default"} then {
# THIS ALWAYS MATCHES, regardless of switches
# presumably, default is the last one
set matched "1"
} else {
#
# check if string variable
#
if {[string index $this_pattern "0"] == "\$"} then {
# get variable name portion only
set variable_name [string range $this_pattern "1" "end"]
# unset in case we set it previously
# BUGFIX: SQUASH annoying error messages in errorInfo!
if {[info exists variable_value] != "0"} then {
catch {unset variable_value}
}
#
# get variable value from calling proc
# (could this be done better with upvar?)
#
# this needs the [list] command to account for the pathological
# case of {this_happy variable_name}.
#
set variable_value [uplevel $dispatch_level [list set $variable_name]]
} else {
#
# command, interesting...
#
if {[string index $this_pattern "0"] == "\["} then {
# get command portion only
set variable_name [string range $this_pattern "1" "end-1"]
# just evaluate the command using uplevel...
# [list] is not required here, $variable_name contains a
# complete command in proper form list form.
set variable_value [uplevel $dispatch_level $variable_name]
} else {
#
# must be some kind of string constant
#
set variable_value $this_pattern
}
}
if {$dispatch_regexp != "0"} then {
#
# regexp (for experts only!)
#
if {$dispatch_nocase != "0"} then {
#
# case insensitive specified
# check if we matched the value...
#
if {[regexp -nocase -- $variable_value $dispatch_string] != "0"} then {
set matched "1"
} else {
set matched "0"
}
} else {
#
# case sensitive is the default
# check if we matched the value...
#
if {[regexp -- $variable_value $dispatch_string] != "0"} then {
set matched "1"
} else {
set matched "0"
}
}
} else {
if {$dispatch_glob != "0"} then {
#
# string match (always a family favorite)
#
if {$dispatch_nocase != "0"} then {
#
# case insensitive specified
# check if we matched the value...
#
if {[string match [string tolower $variable_value] [string tolower $dispatch_string]] != "0"} then {
set matched "1"
} else {
set matched "0"
}
} else {
#
# case sensitive is the default
# check if we matched the value...
#
if {[string match $variable_value $dispatch_string] != "0"} then {
set matched "1"
} else {
set matched "0"
}
}
} else {
if {$dispatch_expr != "0"} then {
#
# NEW: check to see if the truth value of the dispatch arm by itself is non-zero
# (it may have a dynamic value).
#
if {[expr {int($variable_value)}]} then {
set matched "1"
} else {
set matched "0"
}
} else {
# dispatch_exact is the default
if {$dispatch_nocase != "0"} then {
#
# case insensitive specified
# check if we matched the value...
#
if {[string tolower $dispatch_string] == [string tolower $variable_value]} then {
set matched "1"
} else {
set matched "0"
}
} else {
#
# case sensitive is the default
# check if we matched the value...
#
if {$dispatch_string == $variable_value} then {
set matched "1"
} else {
set matched "0"
}
}
}
}
}
}
}
if {$matched != "0"} then {
#
# check for "search for next proc body" like switch does
#
if {$this_body == "-"} then {
#
# skill skipping to next script body...
#
continue
} else {
#
# evaluate this script body (IN THE PROPER LEVEL) and exit loop
# [list] is not required at this level because the body is a script, not a command.
#
set result [uplevel $dispatch_level $this_body]
set evaluated "1"
set matched "0"
if {$dispatch_all == "0"} then {
#
# if they are NOT allowing multiple (default)
# break out of loop
#
break
}
}
}
}
set dispatch_error "0"
} else {
set dispatch_error "1"
}
} else {
set dispatch_error "1"
}
if {$dispatch_error != "0"} then {
error $dispatch_argument_error
}
return $result
}
proc dispatch_terminate {} {
global dispatch_name
#
# forget package
#
package forget $dispatch_name
#
# kill vars
#
foreach this_global [info globals] {
if {[string match "dispatch_*" $this_global] != "0"} then {
# nuke variable in global scope... (dead)
uplevel "#0" unset $this_global
}
}
#
# kill procs
#
rename dispatch ""
rename dispatch_internal ""
rename valid_switch ""
rename check_switch ""
rename dispatch_terminate ""
return "0"
}
# loaded OK, provide package
package provide $dispatch_name $dispatch_version
# // end of fileTests File (dispatch_sample.tcl)
###############################################################################
#
# Tcl dispatch command sample and [torture] test suite
#
# Copyright (c) 2001-2003 by Joe Mistachkin. All rights reserved.
#
# written by: Joe Mistachkin <joe@mistachkin.com>
# created on: 10/07/2001
# modified on: 05/06/2003
#
###############################################################################
#
# The authors hereby grant permission to use, copy, modify, distribute,
# and license this software and its documentation for any purpose, provided
# that existing copyright notices are retained in all copies and that this
# notice is included verbatim in any distributions. No written agreement,
# license, or royalty fee is required for any of the authorized uses.
# Modifications to this software may be copyrighted by their authors
# and need not follow the licensing terms described here, provided that
# the new terms are clearly indicated on the first page of each file where
# they apply.
#
# IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
# FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
# ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
# DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
#
# THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE
# IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
# NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
# MODIFICATIONS.
#
# GOVERNMENT USE: If you are acquiring this software on behalf of the
# U.S. government, the Government shall have only "Restricted Rights"
# in the software and related documentation as defined in the Federal
# Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2). If you
# are acquiring the software on behalf of the Department of Defense, the
# software shall be classified as "Commercial Computer Software" and the
# Government shall have only "Restricted Rights" as defined in Clause
# 252.227-7013 (c) (1) of DFARs. Notwithstanding the foregoing, the
# authors grant the U.S. Government and others acting in its behalf
# permission to use and distribute the software in accordance with the
# terms specified in this license.
#
###############################################################################
# require Tcl 8.0+
package require Tcl 8.0
# attempt to load dispatch package
source "dispatch.tcl"
# require dispatch package 2.0+ to be loaded...
package require Tcl_dispatch 2.0
proc DispatchSample1 { string_to_match } {
set test_1 "this"
set test_2 "that"
set test_3 "foo"
set test_4 "not used"
set test_5 "bar"
set test_6 "FOO"
set test_7 "BAR"
dispatch $string_to_match {
$test_1 {
puts stdout "MATCHED #1\n"
}
$test_2 {
puts stdout "MATCHED #2\n"
}
$test_3 {
puts stdout "MATCHED #3\n"
}
"test 4" {
puts stdout "MATCHED #4\n"
}
$test_5 -
$test_6 -
$test_7 {
puts stdout "MATCHED #5,#6,#7\n"
}
default {
puts stdout "MATCHED DEFAULT!\n"
}
}
}
proc DispatchSample2 { string_to_match } {
set test_1 "this"
set test_2 "that"
set test_3 "foo"
set test_4 "not used"
set test_5 "bar"
set test_6 "FOO"
set test_7 "BAR"
set test_8 "NOEVAL"
dispatch $string_to_match {
$test_1 {
puts stdout "MATCHED #1\n"
}
$test_2 {
puts stdout "MATCHED #2\n"
}
$test_3 {
puts stdout "MATCHED #3\n"
}
"test 4" {
puts stdout "MATCHED #4\n"
}
$test_5 -
$test_6 -
$test_7 {
puts stdout "MATCHED #5,#6,#7\n"
}
$test_8 -
}
}
proc DispatchSample3 { string_to_match } {
dispatch -glob -- $string_to_match {
"1" {
puts stdout "MATCHED #1\n"
}
"2" {
puts stdout "MATCHED #2\n"
}
"3" {
error "cannot match #3"
}
"*" {
puts stdout "MATCHED *\n"
}
}
}
proc DispatchSample4 { string_to_match } {
# MALFORMED dispatch statement test
dispatch $string_to_match {
"1" {
puts stdout "MATCHED #1\n"
}
"2" {
puts stdout "MATCHED #2\n"
}
"3"
}
}
proc DispatchSample5 { string_to_match } {
set email_regexp {^([0-9A-Za-z])([0-9A-Za-z_\.\-]*)@([0-9A-Za-z])([0-9A-Za-z\.\-]*)$}
dispatch -regexp -nocase -- $string_to_match {
{^([01]?\d\d?|2[0-4]\d|25[0-5])\.([01]?\d\d?|2[0-4]\d|25[0-5])\.([01]?\d\d?|2[0-4]\d|25[0-5])\.([01]?\d\d?|2[0-4]\d|25[0-5])$} {
puts stdout "MATCHED, VALID IP\n"
}
{^([01]?[0123456789][0123456789]?|2[0-4][0123456789]|25[0-5])\.([01]?[0123456789][0123456789]?|2[0-4][0123456789]|25[0-5])\.([01]?[0123456789][0123456789]?|2[0-4][0123456789]|25[0-5])\.([01]?[0123456789][0123456789]?|2[0-4][0123456789]|25[0-5])$} {
puts stdout "MATCHED, VALID IP, PRE 8.0\n"
}
$email_regexp {
# NOTICE we used a variable for this?
puts stdout "MATCHED, VALID EMAIL ADDRESS\n"
}
{(<A )(.*?)(HREF=\")(.*?)(\")} {
puts stdout "MATCHED, VALID HYPERLINK\n"
}
default {
puts stdout "NOT MATCHED REGEXP\n"
}
}
}
proc DispatchSample6 { string_to_match } {
set sample6_var "this_is_a_test"
dispatch -exact -nocase -- $string_to_match {
"test" {
puts stdout "MATCHED TEST\n"
}
{[string repeat $sample6_var "2"]} {
puts stdout "MATCHED TEST * 2\n"
}
{\[fakecommand\]} {
puts stdout "MATCHED FAKE COMMAND\n"
}
{[string repeat $sample6_var "3"]} -
{[string repeat $sample6_var "4"]} {
puts stdout "MATCHED TEST * 3 OR 4\n"
if {$string_to_match == "this_is_a_testthis_is_a_testthis_is_a_testthis_is_a_test"} then {
puts stdout "MATCHED TEST * 4\n"
} else {
puts stdout "MATCHED TEST * 3\n"
}
}
default {
puts stdout "NOT MATCHED SAMPLE\n"
}
}
}
proc DispatchSample7 { string_to_match } {
#
# default string test
#
dispatch $string_to_match {
"1" {
puts stdout "MATCHED #1\n"
}
"2" {
puts stdout "MATCHED #2\n"
}
"3" {
puts stdout "MATCHED #3\n"
}
"4" {
puts stdout "MATCHED #4\n"
}
"5" {
puts stdout "MATCHED #5\n"
}
"6" {
puts stdout "MATCHED #6\n"
}
"default" {
puts stdout "MATCHED DEFAULT!\n"
}
}
}
proc DispatchSample8 { string_to_match } {
#
# multiple glob test...
#
dispatch -glob -all -- $string_to_match {
"1" {
puts stdout "MATCHED #1\n"
}
"1*" {
puts stdout "MATCHED GLOB 1*\n"
}
"2" {
puts stdout "MATCHED #2\n"
}
"2*" {
puts stdout "MATCHED GLOB 2*\n"
}
"default" {
puts stdout "MATCHED DEFAULT!\n"
}
}
}
proc DispatchSample9 { string_to_match } {
#
# invalid switch test
#
dispatch -glob -all -notvalid -- $string_to_match {
"1" {
puts stdout "MATCHED #1\n"
}
"2" {
puts stdout "MATCHED #2\n"
}
"default" {
puts stdout "MATCHED DEFAULT!\n"
}
}
}
proc DispatchSample10 { string_to_match } {
#
# valid switch-like looking argument after end of switches
#
dispatch -glob -- -notvalid {
"-notvalid" {
puts stdout "MATCHED -notvalid\n"
}
"default" {
puts stdout "MATCHED DEFAULT!\n"
}
}
}
###############################################################################
# series 1, test ``normal`` usage
###############################################################################
puts stdout "TEST #1, should match #1..."
DispatchSample1 "this"
puts stdout "TEST #2, should match #2..."
DispatchSample1 "that"
puts stdout "TEST #3, should match #3..."
DispatchSample1 "foo"
puts stdout "TEST #4, should match #4..."
DispatchSample1 "test 4"
puts stdout "TEST #4a, should DEFAULT..."
DispatchSample1 "not_in_list"
puts stdout "TEST #5, should match #5,#6,#7..."
DispatchSample1 "bar"
puts stdout "TEST #6, should match #5,#6,#7..."
DispatchSample1 "FOO"
puts stdout "TEST #7, should match #5,#6,#7..."
DispatchSample1 "BAR"
###############################################################################
# series 2, do bad things
###############################################################################
puts stdout "TEST #8, should not match anything..."
DispatchSample2 "not_in_list"
puts stdout ""
puts stdout "TEST #9, should match, but not evaluate anything..."
DispatchSample2 "NOEVAL"
puts stdout ""
puts stdout "TEST #10, should give error..."
catch {DispatchSample3 "3"} dispatch_error
puts stdout "ERROR: `` $dispatch_error ``"
puts stdout ""
puts stdout "TEST #11, should give error (malformed dispatch)..."
catch {DispatchSample4 "1"} dispatch_error
puts stdout "ERROR: `` $dispatch_error ``"
puts stdout ""
puts stdout "TEST #12, should match glob..."
DispatchSample3 "4"
puts stdout "TEST #13, should match regexp IP..."
DispatchSample5 "198.102.29.10"
puts stdout "TEST #14, should NOT match regexp..."
DispatchSample5 "198.102.29.290"
puts stdout "TEST #15, should NOT match regexp..."
DispatchSample5 "*"
puts stdout "TEST #16, should match regexp email..."
DispatchSample5 "me@me.org"
puts stdout "TEST #17, should match regexp hyperlink..."
DispatchSample5 "<A HREF=\"http://www.scriptics.com/\">"
puts stdout "TEST #18, should match command test..."
DispatchSample6 "test"
puts stdout "TEST #19, should match command test * 2..."
DispatchSample6 "this_is_a_testthis_is_a_test"
puts stdout "TEST #20, should match fake command..."
set test20_var {\[fakecommand\]}
DispatchSample6 $test20_var
puts stdout "TEST #21, should match command test * 3 OR 4..."
DispatchSample6 "this_is_a_testthis_is_a_testthis_is_a_test"
puts stdout "TEST #22, should match command test * 3 OR 4..."
DispatchSample6 "this_is_a_testthis_is_a_testthis_is_a_testthis_is_a_test"
puts stdout "TEST #23, default string test..."
DispatchSample7 "8"
puts stdout "TEST #24, multiple test 1, should match 1, glob 1*, and default..."
DispatchSample8 "1"
puts stdout "TEST #25, multiple test 2, should match 2, glob 2*, and default..."
DispatchSample8 "2"
puts stdout "TEST #26, multiple test 3, should match default..."
DispatchSample8 "3"
puts stdout "TEST #27, invalid switch test, should give error..."
catch {DispatchSample9 "3"} dispatch_error
puts stdout "ERROR: `` $dispatch_error ``"
puts stdout "TEST #28, switch-like argument after end of switches test, should match -notvalid..."
DispatchSample10 ""Version History
07/Oct/2001 Version 1.00 -- initial version 19/Nov/2002 Version 2.40 -- initial public release version 06/May/2003 Version 2.60 -- updated, various internal changes 21/Aug/2003 Version 2.70 -- updated, added -expr switch, minor tweaks
elfring 2003-11-01 Is there a relationship to the function library "liboop"? Can an adaptor be created to achieve a cooperation?
