Commit | Line | Data |
---|---|---|
920dae64 AT |
1 | # parray: |
2 | # Print the contents of a global array on stdout. | |
3 | # | |
4 | # RCS: @(#) $Id: parray.tcl,v 1.3 1998/09/14 18:40:03 stanton 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 | ||
13 | proc 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 | foreach name [lsort [array names array $pattern]] { | |
20 | if {[string length $name] > $maxl} { | |
21 | set maxl [string length $name] | |
22 | } | |
23 | } | |
24 | set maxl [expr {$maxl + [string length $a] + 2}] | |
25 | foreach name [lsort [array names array $pattern]] { | |
26 | set nameString [format %s(%s) $a $name] | |
27 | puts stdout [format "%-*s = %s" $maxl $nameString $array($name)] | |
28 | } | |
29 | } |