library/parray.tcl

   1 # parray:
   2 # Print the contents of a global array in command window.
   3 #
   4 # Copyright (c) 1991-1993 The Regents of the University of California.
   5 # Copyright (c) 1994 Sun Microsystems, Inc.
   6 # Copyright (c) 1995 Christian Werner
   7 #
   8 # See the file "license.terms" for information on usage and redistribution
   9 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  10 #
  11
  12 proc parray {a {pattern *}} {
  13     upvar 1 $a array
  14     if ![array exists array] {
  15         error "\"$a\" isn't an array"
  16     }
  17     set maxl 0
  18     foreach name [lsort [array names array $pattern]] {
  19         if {[string length $name] > $maxl} {
  20             set maxl [string length $name]
  21         }
  22     }
  23     set result ""
  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         append result \
  28             [format "set %-*s %s\n" $maxl $nameString [list $array($name)]]
  29     }
  30     return $result
  31 }