tclsh reformat.tcl ?-indent number? myfile.tcland as a Tcl proc :
source reformat.tcl set out [reformat $code]Sarnold on 2008-04-05 : I fixed a bug that caused duplicating newlines. The -unixnl option was removed because of that bug. I added the -indent option to specify the number of blanks of the indentation.NEM Could you describe what it does, exactly? Is it a pretty-printer for Tcl source code?GWM it neatens any text file, correcting and setting indentations. A bug has been fixed in handling lines with multiple braces in them (eg "} else {" or " } } }").[PM] on 2009-08-20 : fixed a bug causing commented lines including braces to increase/decrease indent, and added a swap through a temporary file to avoid getting an empty file if something goes wrong.[neatpick] on 2011-04-04: the reformatted file should have the same permissions as the original file.
reformat.tcl
proc reformat {tclcode {pad 4}} {
set lines [split $tclcode \n]
set out ""
set continued no
set oddquotes 0
set line [lindex $lines 0]
set indent [expr {([string length $line]-[string length [string trimleft $line \ \t]])/$pad}]
set pad [string repeat " " $pad]
foreach orig $lines {
set newline [string trim $orig \ \t]
set line [string repeat $pad $indent]$newline
if {[string index $line end] eq "\\"} {
if {!$continued} {
incr indent 2
set continued yes
}
} elseif {$continued} {
incr indent -2
set continued no
}
if { ! [regexp {^[ \t]*\#} $line] } {
# 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 \}]
set brace [string equal [string index $newline end] \{]
set unbrace [string equal [string index $newline 0] \}]
if {$nbbraces>0 || $brace} {
incr indent $nbbraces ;# [GWM] 010409 multiple open braces
}
if {$nbbraces<0 || $unbrace} {
incr indent $nbbraces ;# [GWM] 010409 multiple close braces
if {$indent<0} {
error "unbalanced braces"
}
## was: set line [string range $line [string length $pad] end]
# 010409 remove multiple brace indentations. Including case
# where "} else {" needs to unindent this line but not later lines.
set np [expr {$unbrace? [string length $pad]:-$nbbraces*[string length $pad]}]
set line [string range $line $np end]
}
} else {
# unbalanced quotes, preserve original indentation
set line $orig
}
}
append out $line\n
}
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 ?-indent number? filename"
if {[llength $argv]!=0} {
if {[lindex $argv 0] eq "-indent"} {
set indent [lindex $argv 1]
set argv [lrange $argv 2 end]
} else {
set indent 4
}
if {[llength $argv]>1} {
error $usage
}
set f [open $argv r]
set data [read $f]
close $f
set permissions [file attributes $argv -permissions]
set filename "$argv.tmp"
set f [open $filename w]
puts -nonewline $f [reformat [string map [list [eol] \n] $data] $indent]
close $f
file copy -force $filename $argv
file delete -force $filename
file attributes $argv -permissions $permissions
}GWM for interactive users I have created the code: # basic interface prompt for file and indent it by 2 spaces.
# I am sure an interested reader will be able to make the indent adjustable too.
set indent 2
set fin [tk_getOpenFile -title "File to be reformatted"]
set f [open $fin r]
set data [read $f]
close $f
#console show; puts "Ho look at $fin" ;update idletasks
set f [open ${fin}.txt w]
puts -nonewline $f [reformat [string map [list [eol] \n] $data] $indent]
close $fET the "} else {" in the #comment (below ## was:) seems to confuse the tcl interpreter, at least in my 8.6b1 it does; I'm guessing it is treating that as an end of block that happens to have a " at the end of it. I changed the 2 braces to something else and it quit complaining about a missing ".[EP] I think that if {$nbbraces>0 || $brace} {
incr indent $nbbraces ;# [GWM] 010409 multiple open braces
}
if {$nbbraces<0 || $unbrace} {should become if {$nbbraces!=0 || $brace || $unbrace}to handle the following situation:if { catch [ {
....
} } {
....
}