parray.tcl 816 B

1234567891011121314151617181920212223242526272829
  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. proc parray {a {pattern *}} {
  11. upvar 1 $a array
  12. if {![array exists array]} {
  13. return -code error "\"$a\" isn't an array"
  14. }
  15. set maxl 0
  16. set names [lsort [array names array $pattern]]
  17. foreach name $names {
  18. if {[string length $name] > $maxl} {
  19. set maxl [string length $name]
  20. }
  21. }
  22. set maxl [expr {$maxl + [string length $a] + 2}]
  23. foreach name $names {
  24. set nameString [format %s(%s) $a $name]
  25. puts stdout [format "%-*s = %s" $maxl $nameString $array($name)]
  26. }
  27. }