4590313 [rkeene@sledge /home/rkeene/projects/rivet-cgi/rivet-tcl]$ cat -n parray.tcl
   1: ###
   2: ## parray <arrayName> ?pattern?
   3: ##    An html version of the standard Tcl 'parray' command.
   4: ##    Displays the entire contents of an array in a sorted, nicely-formatted
   5: ##    way.  Mostly used for debugging purposes.
   6: ##
   7: ##    arrayName - Name of the array to display.
   8: ##    pattern   - A wildcard pattern of variables within the array to display.
   9: ###
  10: 
  11: proc parray {arrayName {pattern *}} {
  12:     upvar 1 $arrayName array
  13:     if {![array exists array]} {
  14:         return -code error "\"$arrayName\" isn't an array"
  15:     }
  16:     set maxl 0
  17:     foreach name [lsort [array names array $pattern]] {
  18:         if {[string length $name] > $maxl} {
  19:             set maxl [string length $name]
  20:         }
  21:     }
  22:     puts stdout "<PRE><B>$arrayName</B>"
  23:     set maxl [expr {$maxl + [string length $arrayName] + 2}]
  24:     foreach name [lsort [array names array $pattern]] {
  25:         set nameString [format %s(%s) $arrayName $name]
  26:         puts stdout [format "%-*s = %s" $maxl $nameString $array($name)]
  27:     }
  28:     puts stdout "</PRE>"
  29: }
4590314 [rkeene@sledge /home/rkeene/projects/rivet-cgi/rivet-tcl]$

Click here to go back to the directory listing.
Click here to download this file.
last modified: 2002-01-08 09:35:16