[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 $f
======

[ET] 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 $f
======

i 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, 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).

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 trim $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 ns 0         ;# count of slashes
      set nl 0         ;# count of left brace
      set nr 0         ;# count of right brace
      set body 0
      for {set i 0; 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!"
        return ""
      }
      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
 }

<<categories>> Dev. Tools