1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/library/parray.tcl	Fri Jun 15 03:10:57 2012 +0200
     1.3 @@ -0,0 +1,29 @@
     1.4 +# parray:
     1.5 +# Print the contents of a global array on stdout.
     1.6 +#
     1.7 +# RCS: @(#) $Id: parray.tcl,v 1.3 1998/09/14 18:40:03 stanton Exp $
     1.8 +#
     1.9 +# Copyright (c) 1991-1993 The Regents of the University of California.
    1.10 +# Copyright (c) 1994 Sun Microsystems, Inc.
    1.11 +#
    1.12 +# See the file "license.terms" for information on usage and redistribution
    1.13 +# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
    1.14 +#
    1.15 +
    1.16 +proc parray {a {pattern *}} {
    1.17 +    upvar 1 $a array
    1.18 +    if {![array exists array]} {
    1.19 +	error "\"$a\" isn't an array"
    1.20 +    }
    1.21 +    set maxl 0
    1.22 +    foreach name [lsort [array names array $pattern]] {
    1.23 +	if {[string length $name] > $maxl} {
    1.24 +	    set maxl [string length $name]
    1.25 +	}
    1.26 +    }
    1.27 +    set maxl [expr {$maxl + [string length $a] + 2}]
    1.28 +    foreach name [lsort [array names array $pattern]] {
    1.29 +	set nameString [format %s(%s) $a $name]
    1.30 +	puts stdout [format "%-*s = %s" $maxl $nameString $array($name)]
    1.31 +    }
    1.32 +}