paren checker

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