Version 1 of Reformatting Tcl code indentation

Updated 2006-04-11 12:09:04

Sarnold introduces here a script that provides this feature.

It works either as a command-line tool :

 tclsh reformat.tcl ?-unixnl? myfile.tcl

and as a Tcl proc :

 source reformat.tcl
 set out [reformat $code]

reformat.tcl

    proc reformat {tclcode {unix no} {indent 0}} {
        set lines [split [string map [list [eol] \n] $tclcode] \n]
        set out ""
        set continued no
        set oddquotes 0
        if {$unix} {set eol \n} {set eol [eol]}

        foreach orig $lines {
            set line [string trimleft $orig \ \t]
            set line [string repeat " " $indent]$line
            if {[string index $line end] eq "\\"} {
                incr indent 8
                set continued yes
            } elseif {$continued} {
                incr indent -8
                set continued no
            }
            # oddquotes contains : 0 when quotes are balanced
            # and 1 when they are not
            set oddquotes [expr {([count $line \"] + $oddquotes) % 2}]
            if {! $oddquotes} {
                set  nbbraces  [count $line \{]
                incr nbbraces -[count $line \}]
                if {$nbbraces>0} {
                    incr indent 4
                }
                if {$nbbraces<0} {
                    incr indent -4
                    if {$indent<0} {
                        error "unbalanced braces"
                    }
                    set line [string range $line 4 end]
                }
            } else {
                # unbalanced quotes, preserve original indentation
                set line $orig
            }
            append out $line$eol
        }
        return $out
    }

    proc eol {} {
        switch -- $::tcl_platform(platform) {
            windows {return \r\n}
            unix {return \n}
            macintosh {return \r}
            default {error "no such platform: $::tc_platform(platform)"}
        }
    }

    proc count {string char} {
        set count 0
        while {[set idx [string first $char $string]]>=0} {
            set backslashes 0
            set nidx $idx
            while {[string equal [string index $string [incr nidx -1]] \\]} {
                incr backslashes
            }
            if {$backslashes % 2 == 0} {
                incr count
            }
            set string [string range $string [incr idx] end]
        }
        return $count
    }

    set usage "reformat.tcl ?-unixnl? filename"

    if {[llength $argv]!=0} {
        if {[lindex $argv 0] eq "-unixnl"} {
            set unix yes
            set argv [lrange $argv 1 end]
        } else  {
            set unix no
        }
        if {[llength $argv]>1} {
            error $usage
        }
        set f [open $argv r]
        set data [read $f]
        close $f
        set f [open $argv w]
        puts $f [reformat $data $unix]
        close $f
    }

Category Dev. Tools