parray.tcl (816B)
1 # parray: 2 # Print the contents of a global array on stdout. 3 # 4 # Copyright (c) 1991-1993 The Regents of the University of California. 5 # Copyright (c) 1994 Sun Microsystems, Inc. 6 # 7 # See the file "license.terms" for information on usage and redistribution 8 # of this file, and for a DISCLAIMER OF ALL WARRANTIES. 9 # 10 11 proc parray {a {pattern *}} { 12 upvar 1 $a array 13 if {![array exists array]} { 14 return -code error "\"$a\" isn't an array" 15 } 16 set maxl 0 17 set names [lsort [array names array $pattern]] 18 foreach name $names { 19 if {[string length $name] > $maxl} { 20 set maxl [string length $name] 21 } 22 } 23 set maxl [expr {$maxl + [string length $a] + 2}] 24 foreach name $names { 25 set nameString [format %s(%s) $a $name] 26 puts stdout [format "%-*s = %s" $maxl $nameString $array($name)] 27 } 28 }