Updated 2007-03-09 19:11:07

This is a little script I Dan Smart use to check that my brackets balance, there are numerous more powerful tools around, but this quickly finds my most common mistake.
 proc K {x y} {set x}

 proc popBack {lst} {
    upvar 1 $lst l
    if {[llength $l]} {
	set r [lindex $l end]
	set l [lreplace [K $l [set l {}]] end end]
    } else {
	error "pop of empty list"
    }
    return $r
 }
 proc fileread {name} {
    set chan [open $fname "r"]
    fconfigure $chan -encoding binary
    set contents [::read $chan]
    close $chan
    return $contents
 }
 proc main {argv} {
    foreach {oparen cparen osquare csquare obrace cbrace} {
	\( \) \[ \] \{ \}
    } {}

    set script [fileread $argv]
    set ie [string length $script]
    set ln 1
    set plist [list]
    for {set is 0} {$is < $ie} {incr is} {
	set char [string index $script $is]
	switch -exact -- $char $oparen {
	    lappend plist [list $oparen $cparen $ln]
	} $osquare {
	    lappend plist [list $osquare $csquare $ln]
	} $obrace {
	    lappend plist [list $obrace $cbrace $ln]
	} $cparen - $csquare - $cbrace {
	    if {[catch {popBack plist} last]} {
		puts "No matching open for $char on $ln"
	    } elseif {![string equal [lindex $last 1] $char]} {
		puts "Mismatched [lindex $last 0]$char open: [lindex $last 2] close: $ln"
		exit 1
	    }
	} "\n" {
	    incr ln
	}
    }
    if {[llength $plist]} {
	puts "Missing closes for: "
	while {[llength $plist]} {
	    set last [popBack plist]
	    puts "[lindex $last 0] on line $ln"
	}
    }
 }

 main $argv

Category Dev. Tools