Usenet 1994 January

home *** CD-ROM | disk | FTP | other *** search

/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / misc / volume26 / tclx / part06 < prev next >

Wrap

Text File | 1991-11-19 | 50.0 KB | 1,348 lines

Newsgroups: comp.sources.misc From: karl@sugar.neosoft.com (Karl Lehenbauer) Subject: v26i006: tclx - extensions and on-line help for tcl 6.1, Part06/23 Message-ID: <1991Nov19.005357.8648@sparky.imd.sterling.com> X-Md4-Signature: a7489b2c20ae22aa00501ba6d226e57f Date: Tue, 19 Nov 1991 00:53:57 GMT Approved: kent@sparky.imd.sterling.com Submitted-by: karl@sugar.neosoft.com (Karl Lehenbauer) Posting-number: Volume 26, Issue 6 Archive-name: tclx/part06 Environment: UNIX #! /bin/sh # This is a shell archive. Remove anything before this line, then unpack # it by saving it into a file and typing "sh file". To overwrite existing # files, type "sh file -c". You can also feed this as standard input via # unshar, or by typing "sh <file", e.g.. If this archive is complete, you # will see the following message at the end: # "End of archive 6 (of 23)." # Contents: extended/tcllib/help/commands/case # extended/tcllib/help/commands/open # extended/tcllib/help/commands/regexp # extended/tcllib/help/commands/regsub # extended/tcllib/help/commands/uplevel # extended/tcllib/help/extended/ctype # extended/tcllib/help/extended/scanmatch # extended/tcllib/help/intro/syntax # extended/tcllib/help/intro/variables extended/tclsrc/setfuncs.tcl # extended/tests/loop.test extended/tests/select.test # extended/tests/setfuncs.test extended/tests/string.test # extended/tests/testutil.tcl # Wrapped by karl@one on Wed Nov 13 21:50:17 1991 PATH=/bin:/usr/bin:/usr/ucb ; export PATH if test -f 'extended/tcllib/help/commands/case' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'extended/tcllib/help/commands/case'\" else echo shar: Extracting \"'extended/tcllib/help/commands/case'\" $2577 characters$ sed "s/^X//" >'extended/tcllib/help/commands/case' <<'END_OF_FILE' X case string ?in? patList body ?patList body ...? X X case string ?in? {patList body ?patList body ...?} X Match string against each of the patList arguments in X order. If one matches, then evaluate the following X body argument by passing it recursively to the Tcl X interpreter, and return the result of that evaluation. X Each patList argument consists of a single pattern or X list of patterns. Each pattern may contain any of the X wild-cards described under string match. If a patList X argument is default, the corresponding body will be X evaluated if no patList matches string. If no patList X argument matches string and no default is given, then X the case command returns an empty string. X X Two syntaxes are provided. The first uses a separate X argument for each of the patterns and commands; this X form is convenient if substitutions are desired on some X of the patterns or commands. The second form places X all of the patterns and commands together into a single X argument; the argument must have proper list structure, X with the elements of the list being the patterns and X commands. The second form makes it easy to construct X multi-line case commands, since the braces around the X whole list make it unnecessary to include a backslash X at the end of each line. Since the patList arguments X are in braces in the second form, no command or X variable substitutions are performed on them; this X makes the behavior of the second form different than X the first form in some cases. X X Below are some examples of case commands: X X case abc in {a b} {format 1} default {format 2} a* {format 3} X X will return 3, X X case a in { X {a b} {format 1} X default {format 2} X a* {format 3} X } X X will return 1, and X X case xyz { X {a b} X {format 1} X default X {format 2} X a* X {format 3} X } X X will return 2. X END_OF_FILE if test 2577 -ne `wc -c <'extended/tcllib/help/commands/case'`; then echo shar: \"'extended/tcllib/help/commands/case'\" unpacked with wrong size! fi # end of 'extended/tcllib/help/commands/case' fi if test -f 'extended/tcllib/help/commands/open' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'extended/tcllib/help/commands/open'\" else echo shar: Extracting \"'extended/tcllib/help/commands/open'\" $2794 characters$ sed "s/^X//" >'extended/tcllib/help/commands/open' <<'END_OF_FILE' X open fileName ?access? X Opens a file and returns an identifier that may be used X in future invocations of commands like read, write, and X close. FileName gives the name of the file to open; if X it starts with a tilde then tilde substitution is X performed as described for Tcl_TildeSubst. If the X first character of fileName is ``|'' then the remaining X characters of fileName are treated as a command X pipeline to invoke, in the same style as for exec. In X this case, the identifier returned by open may be used X to write to the command's input pipe or read from its X output pipe. The access argument indicates the way in X which the file (or command pipeline) is to be accessed. X It may have any of the following values: X X r X Open the file for reading only; the file must X already exist. X X r+ X Open the file for both reading and writing; the X file must already exist. X X w X Open the file for writing only. Truncate it if it X exists. If it doesn't exist, create a new file. X X w+ X Open the file for reading and writing. Truncate X it if it exists. If it doesn't exist, create a X new file. X X a X Open the file for writing only. The file must X already exist, and the file is positioned so that X new data is appended to the file. X X a+ X Open the file for reading and writing. The file X must already exist, and the initial access X position is set to the end of the file. X X Access defaults to r. If a file is opened for both X reading and writing, then seek must be invoked between X a read and a write, or vice versa (this restriction X does not apply to command pipelines opened with open). X When fileName specifies a command pipeline and a X write-only access is used, then standard output from X the pipeline is directed to the current standard output X unless overridden by the command. When fileName X specifies a command pipeline and a read-only access is X used, then standard input from the pipeline is taken X from the current standard input unless overridden by X the command. END_OF_FILE if test 2794 -ne `wc -c <'extended/tcllib/help/commands/open'`; then echo shar: \"'extended/tcllib/help/commands/open'\" unpacked with wrong size! fi # end of 'extended/tcllib/help/commands/open' fi if test -f 'extended/tcllib/help/commands/regexp' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'extended/tcllib/help/commands/regexp'\" else echo shar: Extracting \"'extended/tcllib/help/commands/regexp'\" $2353 characters$ sed "s/^X//" >'extended/tcllib/help/commands/regexp' <<'END_OF_FILE' X regexp ?-indices? ?-nocase? exp string ?matchVar? ?subMatchVar...? X Determines whether the regular expression exp matches X part or all of string and returns 1 if it does, 0 if it X doesn't. See REGULAR EXPRESSIONS above for complete X information on the syntax of exp and how it is matched X against string. X If the -nocase switch is specified then upper-case X characters in string are treated as lower case during X the matching process. The -nocase switch must be X specified before exp and may not be abbreviated. X X If additional arguments are specified after string then X they are treated as the names of variables to use to X return information about which part(s) of string X matched exp. MatchVar will be set to the range of X string that matched all of exp. The first subMatchVar X will contain the characters in string that matched the X leftmost parenthesized subexpression within exp, the X next subMatchVar will contain the characters that X matched the next parenthesized subexpression to the X right in exp, and so on. X X Normally, matchVar and the subMatchVars are set to hold X the matching characters from string. However, if the X -indices switch is specified then each variable will X contain a list of two decimal strings giving the X indices in string of the first and last characters in X the matching range of characters. The -indices switch X must be specified before the exp argument and may not X be abbreviated. X X If there are more more subMatchVar's than parenthesized X subexpressions within exp, or if a particular X subexpression in exp doesn't match the string (e.g. X because it was in a portion of the expression that X wasn't matched), then the corresponding subMatchVar X will be set to ``-1 -1'' if -indices has been specified X or to an empty string otherwise. END_OF_FILE if test 2353 -ne `wc -c <'extended/tcllib/help/commands/regexp'`; then echo shar: \"'extended/tcllib/help/commands/regexp'\" unpacked with wrong size! fi # end of 'extended/tcllib/help/commands/regexp' fi if test -f 'extended/tcllib/help/commands/regsub' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'extended/tcllib/help/commands/regsub'\" else echo shar: Extracting \"'extended/tcllib/help/commands/regsub'\" $2319 characters$ sed "s/^X//" >'extended/tcllib/help/commands/regsub' <<'END_OF_FILE' X regsub ?-all? ?-nocase? exp string subSpec varName X This command matches the regular expression exp against X string using the rules described in REGULAR EXPRESSIONS X above. If there is no match, then the command returns X 0 and does nothing else. If there is a match, then the X command returns 1 and also copies string to the X variable whose name is given by varName. When copying X string, the portion of string that matched exp is X replaced with subSpec. If subSpec contains a ``&'' or X ``\0'', then it is replaced in the substitution with X the portion of string that matched exp. If subSpec X contains a ``\n'', where n is a digit between 1 and 9, X then it is replaced in the substitution with the X portion of string that matched the n-th parenthesized X subexpression of exp. Additional backslashes may be X used in subSpec to prevent special interpretation of X ``&'' or ``\0'' or ``\n'' or backslash. The use of X backslashes in subSpec tends to interact badly with the X Tcl parser's use of backslashes, so it's generally X safest to enclose subSpec in braces if it includes X backslashes. If the -all argument is specified, then X all ranges in string that match exp are found and X substitution is performed for each of these ranges; X otherwise only the first matching range is found and X substituted. If -all is specified, then ``&'' and X ``\n'' sequences are handled for each substitution X using the information from the corresponding match. If X the -nocase argument is specified, then upper-case X characters in string are converted to lower-case before X matching against exp; however, substitutions specified X by subSpec use the original unconverted form of string. X The -all and -nocase arguments must be specified X exactly: no abbreviations are permitted. END_OF_FILE if test 2319 -ne `wc -c <'extended/tcllib/help/commands/regsub'`; then echo shar: \"'extended/tcllib/help/commands/regsub'\" unpacked with wrong size! fi # end of 'extended/tcllib/help/commands/regsub' fi if test -f 'extended/tcllib/help/commands/uplevel' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'extended/tcllib/help/commands/uplevel'\" else echo shar: Extracting \"'extended/tcllib/help/commands/uplevel'\" $2471 characters$ sed "s/^X//" >'extended/tcllib/help/commands/uplevel' <<'END_OF_FILE' X uplevel ?level? command ?command ...? X All of the command arguments are concatenated as if X they had been passed to concat; the result is then X evaluated in the variable context indicated by level. X Uplevel returns the result of that evaluation. If X level is an integer, then it gives a distance (up the X procedure calling stack) to move before executing the X command. If level consists of # followed by a number X then the number gives an absolute level number. If X level is omitted then it defaults to 1. Level cannot X be defaulted if the first command argument starts with X a digit or #. For example, suppose that procedure a X was invoked from top-level, and that it called b, and X that b called c. Suppose that c invokes the uplevel X command. If level is 1 or #2 or omitted, then the X command will be executed in the variable context of b. X If level is 2 or #1 then the command will be executed X in the variable context of a. If level is 3 or #0 then X the command will be executed at top-level (only global X variables will be visible). The uplevel command causes X the invoking procedure to disappear from the procedure X calling stack while the command is being executed. In X the above example, suppose c invokes the command X X uplevel 1 {set x 43; d} X X where d is another Tcl procedure. The set command will X modify the variable x in b's context, and d will X execute at level 3, as if called from b. If it in turn X executes the command X X uplevel {set x 42} X then the set command will modify the same variable x in X b's context: the procedure c does not appear to be on X the call stack when d is executing. The command ``info X level'' may be used to obtain the level of the current X procedure. Uplevel makes it possible to implement new X control constructs as Tcl procedures (for example, X uplevel could be used to implement the while construct X as a Tcl procedure). END_OF_FILE if test 2471 -ne `wc -c <'extended/tcllib/help/commands/uplevel'`; then echo shar: \"'extended/tcllib/help/commands/uplevel'\" unpacked with wrong size! fi # end of 'extended/tcllib/help/commands/uplevel' fi if test -f 'extended/tcllib/help/extended/ctype' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'extended/tcllib/help/extended/ctype'\" else echo shar: Extracting \"'extended/tcllib/help/extended/ctype'\" $3082 characters$ sed "s/^X//" >'extended/tcllib/help/extended/ctype' <<'END_OF_FILE' X X X ctype class string X Determine if all characters in string are in of the X specified class. Returns 1 if they are all of class X and 0 if they are not or if the string is null. This X command also provides another method (besides format X and scan) of converting between an ASCII character and X its numeric value. The following ctype commands are X available. X X ctype alnum string X Tests that all characters are alphabetic or X numeric characters as defined by the character X set. X X ctype alpha string X Tests that all characters are alphabetic X characters as defined by the character set. X X ctype ascii string X Tests that all characters are an ASCII character X (a non-negative number less than 0200). X X ctype char number X Converts the numeric value, string, to an ASCII X character. Number must be in the range 0 through X 255. X X ctype cntrl string X Tests that all characters are ``control X characters'' as defined by the character set. X X ctype digit string X Tests that all characters are valid decimal X digits, i.e. 0 through 9. X X ctype graph string X Tests that all characters within are any character X for which ctype print is true, except for space X characters. X X ctype lower string X Tests that all characters are lowercase letters as X defined by the character set. X X ctype ord character X Convert a character into its decimal numeric X value. The string must be one character long. X X ctype space string X Tests that all characters are either a space, X horizontal-tab, carriage return, newline, X vertical-tab, or form-feed. X X ctype print string X Tests that all characters are a space or any X character for which ctype alnum or ctype punct is X true or other ``printing character'' as defined by X the character set. X X ctype punct string X Tests that all characters are made up of any of X the characters other than the ones for which X alnum, cntrl, or space is true. X X ctype upper string X Tests that all characters are uppercase letters as X defined by the character set. X X ctype xdigit string X Tests that all characters are valid hexadecimal X digits, that is 0 through 9, a through f or A X through F. END_OF_FILE if test 3082 -ne `wc -c <'extended/tcllib/help/extended/ctype'`; then echo shar: \"'extended/tcllib/help/extended/ctype'\" unpacked with wrong size! fi # end of 'extended/tcllib/help/extended/ctype' fi if test -f 'extended/tcllib/help/extended/scanmatch' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'extended/tcllib/help/extended/scanmatch'\" else echo shar: Extracting \"'extended/tcllib/help/extended/scanmatch'\" $2373 characters$ sed "s/^X//" >'extended/tcllib/help/extended/scanmatch' <<'END_OF_FILE' X X X scanmatch [-nocase] contexthandle [regexp] commands X Specify Tcl commands, to be evaluated when regexp is X matched by a scanfile command. The match is added to X the scan context specified by contexthandle. Several X match statements may be specified for a give context. X Regexp is a regular expression (see the regexp X command). If -nocase is specified as the first X argument, the pattern is matched regardless of X alphabetic case. X X If regexp is not specified, then a default match is X specified for the scan context. The default match will X be executed when a line of the file does not match any X of the specified regular expressions. X X The array, matchInfo, is available when the Tcl code is X executed and contains information about the file being X scanned. It is local to the top level of the match X command unless declared global at that level. If it is X to be used as a global it must be declared global X before scanfile is called (since scanfile sets the X matchInfo before the match code is executed, a X subsequent global will override the local variable). X The text of the file line that was matched is in X matchInfo(line). The byte offset into the file of the X line that was matched is in matchInfo(offset). The X line number of the line that was matched is in X matchInfo(linenum). This is relative to the first line X scanned, not the first line of the file. The first X line is line number one. The file handle of the file X being scanned is in matchInfo(handle). X X All scanmatch patterns that match a line will be processed X in the order that the specifications were added to the scan X context. The remainder of the scanmatch pattern-command X pairs may be skipped for a file line if a continue is X executed in the match command. If a return is executed in X the body of the match command, the scanfile command in X progress returns with the value passed to return as it's X value. END_OF_FILE if test 2373 -ne `wc -c <'extended/tcllib/help/extended/scanmatch'`; then echo shar: \"'extended/tcllib/help/extended/scanmatch'\" unpacked with wrong size! fi # end of 'extended/tcllib/help/extended/scanmatch' fi if test -f 'extended/tcllib/help/intro/syntax' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'extended/tcllib/help/intro/syntax'\" else echo shar: Extracting \"'extended/tcllib/help/intro/syntax'\" $2552 characters$ sed "s/^X//" >'extended/tcllib/help/intro/syntax' <<'END_OF_FILE' X BASIC COMMAND SYNTAX X The Tcl language has syntactic similarities to both the Unix X shells and Lisp. However, the interpretation of commands is X different in Tcl than in either of those other two systems. X A Tcl command string consists of one or more commands X separated by newline characters or semi-colons. Each X command consists of a collection of fields separated by X white space (spaces or tabs). The first field must be the X name of a command, and the additional fields, if any, are X arguments that will be passed to that command. For example, X the command X X set a 22 X X has three fields: the first, set, is the name of a Tcl X command, and the last two, a and 22, will be passed as X arguments to the set command. The command name may refer X either to a built-in Tcl command, an application-specific X command bound in with the library procedure X Tcl_CreateCommand, or a command procedure defined with the X proc built-in command. Arguments are passed literally as X text strings. Individual commands may interpret those X strings in any fashion they wish. The set command, for X example, will treat its first argument as the name of a X variable and its second argument as a string value to assign X to that variable. For other commands arguments may be X interpreted as integers, lists, file names, or Tcl commands. X X Command names should normally be typed completely (e.g. no X abbreviations). However, if the Tcl interpreter cannot X locate a command it invokes a special command named unknown X which attempts to find or create the command. For example, X at many sites unknown will search through library X directories for the desired command and create it as a Tcl X procedure if it is found. The unknown command often X provides automatic completion of abbreviated commands, but X usually only for commands that were typed interactively. X It's probably a bad idea to use abbreviations in command X scripts and other forms that will be re-used over time: X changes to the command set may cause abbreviations to become X ambiguous, resulting in scripts that no longer work. END_OF_FILE if test 2552 -ne `wc -c <'extended/tcllib/help/intro/syntax'`; then echo shar: \"'extended/tcllib/help/intro/syntax'\" unpacked with wrong size! fi # end of 'extended/tcllib/help/intro/syntax' fi if test -f 'extended/tcllib/help/intro/variables' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'extended/tcllib/help/intro/variables'\" else echo shar: Extracting \"'extended/tcllib/help/intro/variables'\" $2641 characters$ sed "s/^X//" >'extended/tcllib/help/intro/variables' <<'END_OF_FILE' X VARIABLES - SCALARS AND ARRAYS X Tcl allows the definition of variables and the use of their X values either through $-style variable substitution, the set X command, or a few other mechanisms. Variables need not be X declared: a new variable will automatically be created each X time a new variable name is used. X X Tcl supports two types of variables: scalars and arrays. A X scalar variable has a single value, whereas an array X variable can have any number of elements, each with a name X (called its ``index'') and a value. Array indexes may be X arbitrary strings; they need not be numeric. Parentheses X are used refer to array elements in Tcl commands. For X example, the command X X set x(first) 44 X X will modify the element of x whose index is first so that X its new value is 44. Two-dimensional arrays can be X simulated in Tcl by using indexes that contain multiple X concatenated values. For example, the commands X X set a(2,3) 1 X set a(3,6) 2 X set the elements of a whose indexes are 2,3 and 3,6. X X In general, array elements may be used anywhere in Tcl that X scalar variables may be used. If an array is defined with a X particular name, then there may not be a scalar variable X with the same name. Similarly, if there is a scalar X variable with a particular name then it is not possible to X make array references to the variable. To convert a scalar X variable to an array or vice versa, remove the existing X variable with the unset command. X X The array command provides several features for dealing with X arrays, such as querying the names of all the elements of X the array and searching through the array one element at a X time. X X Variables may be either global or local. If a variable name X is used when a procedure isn't being executed, then it X automatically refers to a global variable. Variable names X used within a procedure normally refer to local variables X associated with that invocation of the procedure. Local X variables are deleted whenever a procedure exits. The X global command may be used to request that a name refer to a X global variable for the duration of the current procedure X (this is somewhat analogous to extern in C). END_OF_FILE if test 2641 -ne `wc -c <'extended/tcllib/help/intro/variables'`; then echo shar: \"'extended/tcllib/help/intro/variables'\" unpacked with wrong size! fi # end of 'extended/tcllib/help/intro/variables' fi if test -f 'extended/tclsrc/setfuncs.tcl' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'extended/tclsrc/setfuncs.tcl'\" else echo shar: Extracting \"'extended/tclsrc/setfuncs.tcl'\" $2706 characters$ sed "s/^X//" >'extended/tclsrc/setfuncs.tcl' <<'END_OF_FILE' X#@package: set_functions union intersect intersect3 lrmdups X X# X# return the logical union of two lists, removing any duplicates X# Xproc union {lista listb} { X set full_list [lsort [concat $lista $listb]] X set check_element [lindex $full_list 0] X set outlist $check_element X foreach element [lrange $full_list 1 end] { X if {$check_element == $element} continue X lappend outlist $element X set check_element $element X } X return $outlist X} X X# X# sort a list, returning the sorted version minus any duplicates X# Xproc lrmdups {list} { X # guarantee last doesn't match the first element X set last "NOMATCH[lindex $list 0]" X set result "" X foreach element [lsort $list] { X if {$last != $element} { X lappend result $element X set last $element X } X } X return $result X} X X# X# intersect3 - perform the intersecting of two lists, returning a list X# containing three lists. The first list is everything in the first X# list that wasn't in the second, the second list contains the intersection X# of the two lists, the third list contains everything in the second list X# that wasn't in the first. X# X Xproc intersect3 {list1 list2} { X set list1Result "" X set list2Result "" X set intersectList "" X X set list1 [lrmdups $list1] X set list2 [lrmdups $list2] X X while {1} { X if [lempty $list1] { X if ![lempty $list2] { X set list2Result [concat $list2Result $list2] X } X break X } X if [lempty $list2] { X set list1Result [concat $list1Result $list1] X break X } X set compareResult [string compare [lindex $list1 0] [lindex $list2 0]] X X if {$compareResult < 0} { X lappend list1Result [lvarpop list1] X continue X } X if {$compareResult > 0} { X lappend list2Result [lvarpop list2] X continue X } X lappend intersectList [lvarpop list1] X lvarpop list2 X } X return [list $list1Result $intersectList $list2Result] X} X X# X# intersect - perform an intersection of two lists, returning a list X# containing every element that was present in both lists X# Xproc intersect {list1 list2} { X set intersectList "" X X set list1 [lsort $list1] X set list2 [lsort $list2] X X while {1} { X if {[lempty $list1] || [lempty $list2]} break X X set compareResult [string compare [lindex $list1 0] [lindex $list2 0]] X X if {$compareResult < 0} { X lvarpop list1 X continue X } X X if {$compareResult > 0} { X lvarpop list2 X continue X } X X lappend intersectList [lvarpop list1] X lvarpop list2 X } X return $intersectList X} X END_OF_FILE if test 2706 -ne `wc -c <'extended/tclsrc/setfuncs.tcl'`; then echo shar: \"'extended/tclsrc/setfuncs.tcl'\" unpacked with wrong size! fi # end of 'extended/tclsrc/setfuncs.tcl' fi if test -f 'extended/tests/loop.test' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'extended/tests/loop.test'\" else echo shar: Extracting \"'extended/tests/loop.test'\" $2692 characters$ sed "s/^X//" >'extended/tests/loop.test' <<'END_OF_FILE' X# X# loop.test X# X# Tests for the loop command. X#--------------------------------------------------------------------------- X# Copyright 1991 Karl Lehenbauer and Mark Diekhans. X# X# Permission to use, copy, modify, and distribute this software and its X# documentation for any purpose and without fee is hereby granted, provided X# that the above copyright notice appear in all copies. Karl Lehenbauer and X# Mark Diekhans make no representations about the suitability of this X# software for any purpose. It is provided "as is" without express or X# implied warranty. X# X Xglobal ModuleName Xset ModuleName "loop" Xsource testutil.tcl X X# Check "loop" and its use of continue and break. X Xset a {} Xset i 1 Xloop i 1 6 { X set a [concat $a $i] X set i [expr $i+1] X} Xcheck $a {1 2 3 4 5} 1.1 X Xset a {} Xloop i 1 6 { X if $i==4 {set i [expr $i+1];continue} X set a [concat $a $i] X set i [expr $i+1] X} Xcheck $a {1 2 3 5} 1.2 X Xset a {} Xloop i 1 6 { X if $i==4 break X set a [concat $a $i] X set i [expr $i+1] X} X Xcheck $a {1 2 3} 1.3 Xdo1cmd {loop 1 2 3} msg 1.4 Xset b {wrong # args: loop var lo hi [incr] command} Xcheck $msg $b 1.4 Xdo1cmd {loop 1 2 3 4 5 6} msg 1.5 Xcheck $msg $b 1.5 X Xset a {xyz} Xloop i 1 6 { X set i [expr $i+1] X} Xcheck $a xyz 1.6 X Xset a {} Xloop i 1 6 { X set a [concat $a $i] X set i [expr $i+1] X if $i==4 break X} Xcheck $a {1 2 3} 1.7 X Xset a {} Xset i 1 Xloop i 1 6 1 { X set a [concat $a $i] X set i [expr $i+1] X} Xcheck $a {1 2 3 4 5} 2.1 X Xset a {} Xloop i 1 6 1 { X if $i==4 {set i [expr $i+1];continue} X set a [concat $a $i] X set i [expr $i+1] X} Xcheck $a {1 2 3 5} 2.2 X Xset a {} Xloop i 1 6 1 { X if $i==4 break X set a [concat $a $i] X set i [expr $i+1] X} Xcheck $a {1 2 3} 2.3 X Xset a {xyz} Xloop i 1 6 1 { X set i [expr $i+1] X} Xcheck $a xyz 2.4 X Xset a {} Xloop i 1 6 1 { X set a [concat $a $i] X set i [expr $i+1] X if $i==4 break X} Xcheck $a {1 2 3} 2.5 X Xset a {} Xset i 1 Xloop i 6 1 -1 { X set a [concat $a $i] X set i [expr $i+1] X} Xcheck $a {6 5 4 3 2} 3.1 X Xset a {} Xloop i 6 1 -1 { X if $i==4 {set i [expr $i+1];continue} X set a [concat $a $i] X set i [expr $i+1] X} Xcheck $a {6 5 3 2} 3.2 X Xset a {} Xloop i 6 1 -1 { X if $i==4 break X set a [concat $a $i] X set i [expr $i+1] X} Xcheck $a {6 5} 3.3 X Xset a {xyz} Xloop i 6 1 -1 { X set i [expr $i+1] X} Xcheck $a xyz 3.4 X Xset a {} Xloop i 6 1 -1 { X if $i==4 break X set a [concat $a $i] X set i [expr $i+1] X} Xcheck $a {6 5} 3.5 X Xset j 0 Xloop i 65536 65556 { X incr j X} Xcheck $j 20 4.1 X Xset j 0 Xloop i 65556 65536 -1 { X incr j 1 X} Xcheck $j 20 4.2 X Xset j 0 Xloop i 0 655360 65536 { X incr j 1 X} Xcheck $j 10 4.3 X Xset j 0 Xloop i 655360 0 -65536 { X incr j 1 X} Xcheck $j 10 4.4 X END_OF_FILE if test 2692 -ne `wc -c <'extended/tests/loop.test'`; then echo shar: \"'extended/tests/loop.test'\" unpacked with wrong size! fi # end of 'extended/tests/loop.test' fi if test -f 'extended/tests/select.test' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'extended/tests/select.test'\" else echo shar: Extracting \"'extended/tests/select.test'\" $2818 characters$ sed "s/^X//" >'extended/tests/select.test' <<'END_OF_FILE' X# X# select.test X# X# Tests for the select command. X#--------------------------------------------------------------------------- X# Copyright 1991 Karl Lehenbauer and Mark Diekhans. X# X# Permission to use, copy, modify, and distribute this software and its X# documentation for any purpose and without fee is hereby granted, provided X# that the above copyright notice appear in all copies. Karl Lehenbauer and X# Mark Diekhans make no representations about the suitability of this X# software for any purpose. It is provided "as is" without express or X# implied warranty. X# Xif {[info procs test] != "test"} then {source defs} X Xcatch {select} msg Xif {"$msg" == "select is not available on this version of Unix"} { X echo "**** $msg" X echo "**** tests skipped" X return X} X Xpipe pipe1ReadFh pipe1WriteFh Xfcntl $pipe1ReadFh nobuf 1 Xfcntl $pipe1WriteFh nobuf 1 X Xpipe pipe2ReadFh pipe2WriteFh Xfcntl $pipe2ReadFh nobuf 1 Xfcntl $pipe2WriteFh nobuf 1 X Xset pipeReadList [list $pipe1ReadFh $pipe2ReadFh] Xset pipeWriteList [list $pipe1WriteFh $pipe2WriteFh] X Xtest iocmds-1.1 {select tests} { X select $pipeReadList $pipeWriteList {} 0.5 X} [list {} $pipeWriteList {}] X Xtest iocmds-1.2 {select tests} { X puts $pipe1WriteFh "Written to pipe 1" X set ret [select $pipeReadList $pipeWriteList {} 0.5] X list $ret [gets $pipe1ReadFh] X} [list [list $pipe1ReadFh $pipeWriteList {}] "Written to pipe 1"] X Xtest iocmds-1.3 {select tests} { X puts $pipe2WriteFh "Written to pipe 2" X set ret [select $pipeReadList $pipeWriteList {} 0.5] X list $ret [gets $pipe2ReadFh] X} [list [list $pipe2ReadFh $pipeWriteList {}] "Written to pipe 2"] X Xtest iocmds-1.4 {select tests} { X puts $pipe1WriteFh "Written to pipe 1" X puts $pipe2WriteFh "Written to pipe 2" X set ret [select $pipeReadList $pipeWriteList {} 0.5] X list $ret [gets $pipe1ReadFh] [gets $pipe2ReadFh] X} [list [list $pipeReadList $pipeWriteList {}] "Written to pipe 1" \ X "Written to pipe 2"] X Xtest iocmds-1.5 {select tests} { X select $pipeReadList $pipeWriteList {} 0 X} [list {} $pipeWriteList {}] X Xtest iocmds-1.6 {select tests} { X puts $pipe1WriteFh "Written to pipe 1" X set ret [select $pipeReadList $pipeWriteList] X list $ret [gets $pipe1ReadFh] X} [list [list $pipe1ReadFh $pipeWriteList {}] "Written to pipe 1"] X Xtest iocmds-1.7 {select tests} { X puts $pipe1WriteFh "Written to pipe 1" X set ret [select $pipeReadList $pipeWriteList {} 0] X list $ret [gets $pipe1ReadFh] X} [list [list $pipe1ReadFh $pipeWriteList {}] "Written to pipe 1"] X Xtest iocmds-1.8 {select tests} { X list [catch {select foo $pipeWriteList {} 0} msg] $msg X} {1 {bad file identifier "foo"}} X Xtest iocmds-1.8 {select tests} { X list [catch {select $pipeReadList $pipeWriteList {} X} msg] $msg X} {1 {expected floating-point number but got "X"}} X END_OF_FILE if test 2818 -ne `wc -c <'extended/tests/select.test'`; then echo shar: \"'extended/tests/select.test'\" unpacked with wrong size! fi # end of 'extended/tests/select.test' fi if test -f 'extended/tests/setfuncs.test' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'extended/tests/setfuncs.test'\" else echo shar: Extracting \"'extended/tests/setfuncs.test'\" $3165 characters$ sed "s/^X//" >'extended/tests/setfuncs.test' <<'END_OF_FILE' X# X# setfuncs.test X# X# Tests for tcl.tlib set functions. X#--------------------------------------------------------------------------- X# Copyright 1991 Karl Lehenbauer and Mark Diekhans. X# X# Permission to use, copy, modify, and distribute this software and its X# documentation for any purpose and without fee is hereby granted, provided X# that the above copyright notice appear in all copies. Karl Lehenbauer and X# Mark Diekhans make no representations about the suitability of this X# software for any purpose. It is provided "as is" without express or X# implied warranty. X# X Xif {[string compare test [info procs test]] == 1} then {source defs} Xrename SAVED_UNKNOWN unknown X Xtest setfuncs-1.1 {union command} { X union "" "" X} "" X Xtest setfuncs-1.2 {union command} { X union a "" X} "a" X Xtest setfuncs-1.3 {union command} { X union "a b" "b c" X} "a b c" X Xtest setfuncs-1.4 {union command} { X union "a b c d" "a b c d" X} "a b c d" X Xtest setfuncs-1.5 {union command} { X union "a d c d b" "b d c a a b d a b c d" X} "a b c d" X Xtest setfuncs-1.6 {union command} { X union "d c b a e f" "" X} "a b c d e f" X Xtest setfuncs-1.7 {union command} { X union "" "f e d c b a" X} "a b c d e f" X Xtest setfuncs-1.8 {union command} { X union "{n p}" "f e d c b a" X} "a b c d e f {n p}" X Xtest setfuncs-1.9 {union command} { X union "{n p}" "f e d c {n p} b a" X} "a b c d e f {n p}" X Xtest setfuncs-1.10 {union command} { X union "{n p} z {n p} z" "f e d c {n p} b a" X} "a b c d e f {n p} z" X X Xtest setfuncs-2.1 {intersect command} { X intersect "" "" X} "" X Xtest setfuncs-2.2 {intersect command} { X intersect "a b c" "" X} "" X Xtest setfuncs-2.3 {intersect command} { X intersect "" "a b c" X} "" X Xtest setfuncs-2.4 {intersect command} { X intersect "d f b" "a b c" X} "b" X Xtest setfuncs-2.5 {intersect command} { X intersect "a p q d v m b n o z t d f b" "a b c" X} "a b" X Xtest setfuncs-2.6 {intersect command} { X intersect "d c b a e f" "{n p}" X} "" X Xtest setfuncs-2.7 {intersect command} { X intersect "d c" "f e d c b a" X} "c d" X Xtest setfuncs-2.8 {intersect command} { X intersect "a f {n p} e" "f e d c b a" X} "a e f" X Xtest setfuncs-2.9 {intersect command} { X intersect "{n p} f d" "f e d c {n p} b a" X} "d f {n p}" X Xtest setfuncs-2.10 {intersect command} { X intersect "{n p} z {n p} z" "f e d c {n p} b a" X} "{n p}" X Xtest setfuncs-3.1 {intersect3 command} { X intersect3 "" "" X} "{} {} {}" X Xtest setfuncs-3.2 {intersect3 command} { X intersect3 "a b c" "" X} "{a b c} {} {}" X Xtest setfuncs-3.3 {intersect3 command} { X intersect3 "" "a b c" X} "{} {} {a b c}" X Xtest setfuncs-3.4 {intersect3 command} { X intersect3 "d f b" "a b c" X} "{d f} b {a c}" X Xtest setfuncs-3.5 {intersect3 command} { X intersect3 "a p q d v m b n o z t d f b" "a b c" X} "{d f m n o p q t v z} {a b} c" X Xtest setfuncs-4.1 {lrmdups command} { X lrmdups {a d b c eee b d 1} X} {1 a b c d eee} X Xtest setfuncs-4.2 {lrmdups command} { X lrmdups {aaa aaa aaaa aaa aaa } X} {aaa aaaa} X Xtest setfuncs-4.3 {lrmdups command} { X lrmdups {{} aaa {} aaa aaa } X} {{} aaa} X Xtest setfuncs-4.4 {lrmdups command} { X lrmdups {aaa} X} {aaa} X Xrename unknown SAVED_UNKNOWN X END_OF_FILE if test 3165 -ne `wc -c <'extended/tests/setfuncs.test'`; then echo shar: \"'extended/tests/setfuncs.test'\" unpacked with wrong size! fi # end of 'extended/tests/setfuncs.test' fi if test -f 'extended/tests/string.test' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'extended/tests/string.test'\" else echo shar: Extracting \"'extended/tests/string.test'\" $3025 characters$ sed "s/^X//" >'extended/tests/string.test' <<'END_OF_FILE' X# X# string.test X# X# Tests for the cindex, clength, crange, replicate, csubstr, and translit X# commands. X#--------------------------------------------------------------------------- X# Copyright 1991 Karl Lehenbauer and Mark Diekhans. X# X# Permission to use, copy, modify, and distribute this software and its X# documentation for any purpose and without fee is hereby granted, provided X# that the above copyright notice appear in all copies. Karl Lehenbauer and X# Mark Diekhans make no representations about the suitability of this X# software for any purpose. It is provided "as is" without express or X# implied warranty. X# Xif {[info procs test] != "test"} then {source defs} X X# Test the 'cindex' command. X Xtest string-1.1 {cindex tests} { X cindex ABCDEFG 1 X} {B} X Xtest string-1.2 {cindex tests} { X cindex ABCDEFG 4 X} {E} X Xtest string-1.3 {cindex tests} { X cindex ABCDEFG 6 X} {G} X Xtest string-1.4 {cindex tests} { X cindex ABCDEFG 7 X} {} X X# Test the 'clength' command. X Xtest string-2.1 {clength tests} { X clength ABCDEFG X} {7} X Xtest string-2.2 {clength tests} { X clength "ABCD XYZ" X} {8} X Xtest string-2.3 {clength tests} { X list [catch {clength} msg] $msg X} {1 {wrong # args: clength string}} X X# Test the crange command. X Xtest string-3.1 {crange tests} { X crange ABCDEFG 1 3 X} {BCD} X Xtest string-3.2 {crange tests} { X crange ABCDEFG 2 end X} {CDEFG} X Xtest string-3.3 {crange tests} { X set foo [replicate ABCD 500] X crange $foo 100 499 X} [replicate ABCD 100] X Xtest string-3.4 {crange tests} { X list [catch {crange} msg] $msg X} {1 {wrong # args: crange string first last}} X Xtest string-3.5 {crange tests} { X crange ABCD 4 1 X} {} X X# Test the 'replicate' command X Xtest string-4.1 {replicate tests} { X replicate AbCd 4 X} {AbCdAbCdAbCdAbCd} X Xtest string-4.2 {replicate tests} { X replicate X 1000 X} "[replicate X 250][replicate X 250][replicate X 250][replicate X 250]" X Xtest string-4.3 {replicate tests} { X list [catch {replicate X} msg] $msg X} {1 {wrong # args: replicate string count}} X X# Test the csubstr command. X Xtest string-5.1 {csubstr tests} { X csubstr ABCDEFG 1 3 X} {BCD} X Xtest string-5.2 {csubstr tests} { X csubstr ABCDEFG 2 end X} {CDEFG} X Xtest string-5.3 {csubstr tests} { X set foo [replicate ABCD 500] X csubstr $foo 100 400 X} [replicate ABCD 100] X Xtest string-5.4 {csubstr tests} { X list [catch {csubstr} msg] $msg X} {1 {wrong # args: csubstr string first length}} X Xtest string-5.5 {csubstr tests} { X csubstr ABCD 4 1 X} {} X Xtest string-5.6 {translit tests} { X set str "Captain Midnight Secret Decoder Ring" X translit {A-MN-Za-mn-z} {N-ZA-Mn-za-m} $str X} {Pncgnva Zvqavtug Frperg Qrpbqre Evat} X Xtest string-5.7 {translit tests} { X set str "Captain Midnight Secret Decoder Ring" X set str2 [translit {A-MN-Za-mn-z} {N-ZA-Mn-za-m} $str] X translit {A-MN-Za-mn-z} {N-ZA-Mn-za-m} $str2 X} {Captain Midnight Secret Decoder Ring} X Xtest string-5.8 {translit tests} { X list [catch {translit} msg] $msg X} {1 {wrong # args: translit from to string}} X END_OF_FILE if test 3025 -ne `wc -c <'extended/tests/string.test'`; then echo shar: \"'extended/tests/string.test'\" unpacked with wrong size! fi # end of 'extended/tests/string.test' fi if test -f 'extended/tests/testutil.tcl' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'extended/tests/testutil.tcl'\" else echo shar: Extracting \"'extended/tests/testutil.tcl'\" $2468 characters$ sed "s/^X//" >'extended/tests/testutil.tcl' <<'END_OF_FILE' X# testutil.tcl -- X# X# Utility procedures for TCL test packages. These procedures all expect a X# global "ModuleName" to be define, which contains the name of the test package X# being run. This may be a short string. X X X# Check that a value is equal to what was expected. If not, generate X# an error X Xproc check {got expect idnum} { X global ModuleName currentTestNumber X set currentTestNumber $idnum X if {"$got" != "$expect"} { X echo [replicate "-" 70] X echo [format {%s test error %s: wanted "%s", got "%s"} \ X $ModuleName $idnum $expect $got] X echo [replicate "-" 70] X } X} X X X# Check that a numeric value is equal to what was expected. If not, generate X# an error X Xproc checknum {got expect idnum} { X global ModuleName currentTestNumber X set currentTestNumber $idnum X if {$got != $expect} { X echo [replicate "-" 70] X echo [format {%s test error %s: wanted "%s", got "%s"} \ X $ModuleName $idnum $expect $got] X echo [replicate "-" 70] X } X} X X# Run and verify a command that should return TCL_ERROR, pass back the returned X# error message X Xproc do1cmd {cmd msgvar idnum} { X global ModuleName currentTestCommand currentTestNumber X set currentTestCommand $cmd X set currentTestNumber $idnum X if {[catch {uplevel $cmd} msg] != 1} { X echo [replicate "-" 70] X echo [format {%s test error %s: No error returned: %s} \ X $ModuleName $idnum $cmd] X echo [replicate "-" 70] X } X uplevel set $msgvar [list $msg] X} X X X# Increment a name. This takes a name and "adds one" to it, that is advancing X# each digit lexically through "0"..."9" -> "A"-"Z" -> "a"..."z". When one X# digit wraps, the next one is advanced. Optional arg forces upper case only X# if true and start with all upper case or digits. X Xproc IncrName {Name args} { X set Upper [expr {([llength $args] == 1) && [lindex $args 0]}] X set Last [expr [clength $Name]-1] X set Begin [csubstr $Name 0 $Last] X set Digit [cindex $Name $Last] X set Recurse 0 X case $Digit in { X {9} {set Digit A} X {Z} {if {$Upper} {set Recurse 1} else {set Digit a}} X {z} {set Recurse 1} X default {set Digit [ctype char [expr [ctype ord $Digit]+1]]} X } X if {$Recurse} { X if {$Last == 0} then { X return 0 ;# Wrap around X } else { X return "[IncrName $Begin]0" X } X } X return "$Begin$Digit" X} X X END_OF_FILE if test 2468 -ne `wc -c <'extended/tests/testutil.tcl'`; then echo shar: \"'extended/tests/testutil.tcl'\" unpacked with wrong size! fi # end of 'extended/tests/testutil.tcl' fi echo shar: End of archive 6 $of 23$. cp /dev/null ark6isdone MISSING="" for I in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 ; do if test ! -f ark${I}isdone ; then MISSING="${MISSING} ${I}" fi done if test "${MISSING}" = "" ; then echo You have unpacked all 23 archives. echo "Now cd to "extended", edit the makefile, then do a "make"" rm -f ark[1-9]isdone ark[1-9][0-9]isdone else echo You still need to unpack the following archives: echo " " ${MISSING} fi ## End of shell archive. exit 0 exit 0 # Just in case... -- Kent Landfield INTERNET: kent@sparky.IMD.Sterling.COM Sterling Software, IMD UUCP: uunet!sparky!kent Phone: (402) 291-8300 FAX: (402) 291-4362 Please send comp.sources.misc-related mail to kent@uunet.uu.net.