Sarnold introduces here a script that provides this feature.
It works either as a command-line tool :
tclsh reformat.tcl ?-indent number? myfile.tcl
and 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 [ {
....
} } {
....
}srujan - 2013-10-07 06:41:29
hi,
can you please fix the below errors in the reformat.tcl script
tclsh ../../reformat.tcl -indent 4 run-setup_aressim6_orig_indent missing "
while compiling
"" needs to unindent this line but not later lines.
set np [expr {$unbrace? [string length $pad]:-$nbbraces*[string length $pad]}]..."
("if" else script line 1)
while compiling"if {$nbbraces!=0 || $brace || $unbrace} {
incr indent $nbbraces ;# [GWM] 010409 multiple close braces
if {$ind..."
("if" then script line 6)
while compiling"if {! $oddquotes} {
set nbbraces [count $line \{]
incr nbbraces -[count $line \}]
set brace [strin..."
("if" then script line 6)
while compiling"if { ! regexp {^[ \t*\#} $line] } {
# oddquotes contains : 0 when quotes are balanced
# and 1 when they are not
..."
("foreach" body line 14)
while compiling"foreach orig $lines {
set newline [string trim $orig \ \t]
set line [string repeat $pad $indent]$newline
if {[string index $li..."
(compiling body of proc "reformat", line 10)
invoked from within"reformat string map [list [eol \n] $data] $indent"
invoked from within
"if {llength $argv!=0} {
if {[lindex $argv 0] eq "-indent"} {
set indent [lindex $argv 1]
set argv [lrange $argv 2 end]
} els..."
(file "../../reformat.tcl" line 81)srujan - 2013-10-07 06:43:12
please fix the below errors
tclsh ../../reformat.tcl -indent 4 run-setup_aressim6_orig_indent
missing "
while compiling
"" needs to unindent this line but not later lines.
set np [expr {$unbrace? [string length $pad]:-$nbbraces*[string length $pad]}]
..."
("if" else script line 1)
while compiling
"if {$nbbraces!=0 || $brace || $unbrace} {
incr indent $nbbraces ;# [GWM] 010409 multiple close braces
if {$ind..."
("if" then script line 6)
while compiling
"if {! $oddquotes} {
set nbbraces [count $line \{]
incr nbbraces -[count $line \}]
set brace [strin..."
("if" then script line 6)
while compiling
"if { ! [regexp {^[ \t]*\#} $line] } {
# oddquotes contains : 0 when quotes are balanced
# and 1 when they are not
..."
("foreach" body line 14)
while compiling
"foreach orig $lines {
set newline [string trim $orig \ \t]
set line [string repeat $pad $indent]$newline
if {[string index $li..."
(compiling body of proc "reformat", line 10)
invoked from within
"reformat [string map [list [eol] \n] $data] $indent"
invoked from within
"if {[llength $argv]!=0} {
if {[lindex $argv 0] eq "-indent"} {
set indent [lindex $argv 1]
set argv [lrange $argv 2 end]
} els..."
(file "../../reformat.tcl" line 81)
Durgaram Corrected the code., now it is working fine for me
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
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
}
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 $fi used this code for indentation... working fine :)...
proc align {file} {
set split_line 0
set id [open $file r]
set cont [read $id]
close $id
set id [open $file w+]
set i 0
set lines [split $cont \n]
foreach line $lines {
set line [string trim $line]
if {$split_line} {
for {set j [expr $i -2]} {$j>=0} {incr j -1} {
puts -nonewline $id " "
}
puts $id " $line"
if {[string index $line end] == "\\"} {
set split_line 1
} else {
set split_line 0
}
set opens [regexp -all {\{} $line]
set closes [regexp -all {\}} $line]
incr i [expr $opens - $closes]
continue
}
if {[string index $line end] == "\\"} {
set split_line 1
} else {
set split_line 0
}
if [regexp {\} else \{} $line] {
for {set j [expr $i -2]} {$j>=0} {incr j -1} {
puts -nonewline $id " "
}
puts $id $line
continue
}
set opens [regexp -all {\{} $line]
set closes [regexp -all {\}} $line]
if {[expr $opens - $closes] == -1} {
incr i -1
for {set j [expr $i -1]} {$j>=0} {incr j -1} {
puts -nonewline $id " "
}
puts $id $line
continue
}
for {set j [expr $i -1]} {$j>=0} {incr j -1} {
puts -nonewline $id " "
}
puts $id $line
incr i [expr $opens - $closes]
}
close $id}
aplsimple - 2018-11-09 14:25:06
Still your last version has some issues that are listed below with code samples to be processed by the reformat procedure.
Issue #1.
The {"} is a legal (though tricky) variant of \". Not seen as legal by the reformat procedure.
set rc [open ./check.tcl r]
foreach line [split [read $rc] \n] {
if {[expr ([string length $line] - [string length [string map {{"} {}} $line]]) % 2]} {
puts " 2 --> Mismatching line: $line"
}
}
close $rc
Issue #2.
Third line (with ::message_box) starts a multi-line string. Processed incorrectly by the reformat procedure.
set ::start0 0
if {$::start0} {
::message_box "Run this with
wish test.tcl \"%s\" \[menu\]
as a test\n(see readme.md for details)."
proc1
}
Issue #3.
Total failure of the reformat procedure. Puts out the error of "unbalanced braces" though its input is a correct Tcl script.
set ::start0 0
if {$::start0=="Run this with
wish test.tcl \"%s\" \[menu\]
...line1
...line2
as a test\n(see readme.md for details)." } {
proc2
}
Issue #4.
Strange outputs of continuation lines.
set ::start0 0
if {$::start0=="some" && \
$::start2=="some2" && \
$::start3=="some3" && \
$::start4=="some4" } {
::message_box "Run this with
..."
if {somecond3} {
set res 3
}
}
exit
Issue #5.
In the last example supplied for the reformat just before this post, the last "}" after "close $id" is redundant and should cause the error at formatting. The reformat proc doesn't see the error and swallows the last "}". The reformat2 proc (below) raises the error as "Line 54: unbalanced braces!".
Issue #6.
All tests reveal an empty line that is added to the end of input code by the reformat procedure.
#=================================
These issues are resolved in the reformat2 proc below.
The reformat2 proc has the following features:
- it doesn't format the continuation lines leaving this to a coder (compare e.g. Python's PEP 8);
- it doesn't format the multi-line strings: the initial spaces in continuation strings may matter;
- it doesn't format the comment lines considering them being the coder's territory;
- it correctly processes the if and similar commands that are normally ended by "{" in the first line but a coder may not to follow this rule (as in issue #3);
- it sees {"} as a correct variant of \";
- it doesn't add an empty line to a code;
- it shows a line number in the case of error (i.e. in what line the "}" is redundant).
To be honest as for the cost: the reformat2 is twice slower than the reformat.
Please:
proc reformat2 {tclcode {pad 2}} {
set lines [split $tclcode \n]
set out ""
set nquot 0 ;# count of quotes
set ncont 0 ;# count of continued strings
set line [lindex $lines 0]
set indent [expr {([string length $line]-[string length [string trimleft $line \ \t]])/$pad}]
set padst [string repeat " " $pad]
foreach orig $lines {
incr lineindex
if {$lineindex>1} {append out \n}
set newline [string trimleft $orig]
if {$newline==""} continue
set is_quoted $nquot
set is_continued $ncont
if {[string index $orig end] eq "\\"} {
incr ncont
} else {
set ncont 0
}
if { [string index $newline 0]=="#" } {
set line $orig ;# don't touch comments
} else {
set npad [expr {$indent * $pad}]
set line [string repeat $padst $indent]$newline
set i [set ns [set nl [set nr [set body 0]]]]
for {set n [string length $newline]} {$i<$n} {incr i} {
set ch [string index $newline $i]
if {$ch=="\\"} {
set ns [expr {[incr ns] % 2}]
} elseif {!$ns} {
if {$ch=="\""} {
set nquot [expr {[incr nquot] % 2}]
} elseif {!$nquot} {
switch $ch {
"\{" {
if {[string range $newline $i $i+2]=="\{\"\}"} {
incr i 2 ;# quote in braces - correct (though tricky)
} else {
incr nl
set body -1
}
}
"\}" {
incr nr
set body 0
}
}
}
} else {
set ns 0
}
}
set nbbraces [expr {$nl - $nr}]
incr totalbraces $nbbraces
if {$totalbraces<0} {
error "Line $lineindex: unbalanced braces!"
}
incr indent $nbbraces
if {$nbbraces==0} { set nbbraces $body }
if {$is_quoted || $is_continued} {
set line $orig ;# don't touch quoted and continued strings
} else {
set np [expr {- $nbbraces * $pad}]
if {$np>$npad} { ;# for safety too
set np $npad
}
set line [string range $line $np end]
}
}
append out $line
}
return $out
}