Automatically insert commenting skeletons for procedures that lack documentation

autocomment.tcl

#!/usr/bin/env tclsh

set usage "autocomment.tcl filename..."

proc count {str chars} {
    set count 0
    foreach c [split $str ""] {
        foreach d [split $chars ""] {
            if { $d eq $c } {
                incr count
            }
        }
    }
    return $count
}

proc comment { fd pname vars {atleast 6} {align 8} } {
    set spaces [string repeat " " $atleast]
    puts $fd "# $pname -- descr"
    puts $fd "#"
    puts $fd "#${spaces}descr"
    puts $fd "#"
    puts $fd "# Arguments:"
    if { [llength $vars] } {
        foreach v $vars {
            if { [string length $v] > $align } {
                set align [string length $v]
            }
        }
        set spacer [string repeat " " $align]
        foreach v $vars {
            puts $fd "#${spaces}[string range ${v}${spacer} 0 [expr {$align-1}]] descr"
        }
    } else {
        puts $fd "#${spaces}None."
    }
    puts $fd "#"
    puts $fd "# Results:"
    puts $fd "#${spaces}None."
    puts $fd "#"
    puts $fd "# Side Effects:"
    puts $fd "#${spaces}None."
}

if {[llength $argv]} {
    foreach fpath $argv {
        set filename [file rootname $fpath].tmp[pid]
        set out [open $filename w]


        set in [open $fpath r]
        set pline ""
        set buffer {}
        while {![eof $in] } {
            set line [gets $in]
            if { [string first "proc" [string trim $line]] == 0 } {
                if { [string index $pline 0] ne "\#" } {
                    lappend buffer $line
                }
            }
            
            if { [llength $buffer] } {
                set opened 0; set closed 0
                foreach l $buffer {
                    incr opened [count $line "\{"]
                    incr closed [count $line "\}"]
                }
                
                if { $opened == $closed + 1 || $opened == $closed } {
                    set decl [concat {*}$buffer]
                    set first [string first "\{" $decl]
                    set last [string last "\}" $decl]
                    
                    set pname [string trim [string range $decl [string length "proc"] [expr {$first-1}]]]
                    set vars [list]
                    foreach vdecl [string range $decl [expr {$first+1}] [expr {$last-1}]] {
                        lappend vars [lindex $vdecl 0]
                    }
                    comment $out $pname $vars
                    
                    foreach l $buffer {
                        puts $out $l
                    }
                    set buffer {}
                }
                
                # Failsafe
                if { [llength $buffer] >= 5 } {
                    foreach l $buffer {
                        puts $out $l
                    }
                    set buffer {}                    
                }
            } else {
                puts $out $line
            }
            
            if { $line ne "" } {
                set pline $line
            }
        }
        close $in
        close $out    
        
        file rename -force -- $fpath [file rootname $fpath].bak
        file rename -force -- $filename $fpath
    }
}