mingw/lib/tcl8.5/parray.tcl

   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         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 }