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