File: parray.tcl

package info (click to toggle)
libapache2-mod-rivet 2.3.3-1
  • links: PTS
  • area: main
  • in suites: stretch
  • size: 5,156 kB
  • ctags: 1,093
  • sloc: xml: 7,696; tcl: 6,939; ansic: 5,682; sh: 4,862; makefile: 199; sql: 91; lisp: 78
file content (37 lines) | stat: -rw-r--r-- 1,272 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
###
## parray <arrayName> ?pattern?
##    An html version of the standard Tcl 'parray' command.
##    Displays the entire contents of an array in a sorted, nicely-formatted
##    way.  Mostly used for debugging purposes.
##
##    arrayName - Name of the array to display.
##    pattern   - A wildcard pattern of variables within the array to display.
##
## $Id: parray.tcl 1519325 2013-09-01 23:58:19Z mxmanghi $
##
###

namespace eval ::rivet {

    proc parray {arrayName {pattern *}} {
        upvar 1 $arrayName array
        if {![array exists array]} {
            return -code error "\"$arrayName\" isn't an array"
        }
        set maxl 0
        foreach name [lsort [array names array $pattern]] {
            if {[string length $name] > $maxl} {
                set maxl [string length $name]
            }
        }
        puts stdout "<PRE><B>$arrayName</B>"
        set maxl [expr {$maxl + [string length $arrayName] + 2}]
        foreach name [lsort [array names array $pattern]] {
            set nameString [format %s(%s) $arrayName [::rivet::escape_sgml_chars $name]]
            puts stdout [format "%-*s = %s" $maxl $nameString [::rivet::escape_sgml_chars $array($name)]]
        }
        puts stdout "</PRE>"
    }

    namespace export parray
}