changecomments.tcl

DelphiDoc is a program for automatic generation of documentation on a Delphi-Project. At the momen

#!/usr/bin/tcl


#will be called for each {- and (*-comments
#should return the (changed) comment
proc comment comment {

  set result ""

  set start 0

  set param {-1 -1}

  if [ regexp -indices {( *)Parameter: } $comment indices paramspaces] {
    set param $indices
    set start [ lindex $indices 1 ]
  }
  set result {-1 -1}
  if [ regexp -indices -start $start { *R點kgabewert: } $comment indices ] {
    set result $indices
    set start [ lindex $indices 1 ]
  }
  set global {-1 -1}
  if [ regexp -indices -start $start { *[Gg]lobal: } $comment indices ] {
    set global $indices
    set start [ string length $comment ]
  }
  set calls {-1 -1}
  if [ regexp -indices -start $start { *[Rr]uft auf: } $comment indices ] {
    set calls $indices
    set start [ string length $comment ]
  }

  set end [ lindex $global 0 ]
  if { $end == -1 } {
    set end [ lindex $calls 0 ]
  }
  if { $end != -1 } {
    incr end -1
    if { "\n" == [string index $comment $end] } {
      incr end -1
    }
    set comment [ string range $comment 0 $end ]
  }

  set end [ lindex $result 0 ]
  if { $end != -1 } {
    set result "~result [ string range $comment [ expr [ lindex $result 1 ] + 1 ] end ]"
    set comment [ string range $comment 0 [ expr $end - 1 ] ]
  } {
    set result ""
  }

  set end [ lindex $param 0 ]
  if { $end != -1 } {
    set paramspaces [ string repeat " " [ expr [ lindex $paramspaces 1 ] - [ lindex $paramspaces 0 ] + 1 ] ]

    set param   "\n            [ string range $comment [ expr [ lindex $param 1 ] + 1 ] end ]"
    set comment [ string trimright [ string range $comment 0 [ expr $end - 1 ] ] ]

#                  Parameter:
    regsub -all "\n          *(\[_A-Za-z0-9\]+(, \[_A-Za-z0-9\]+)*): " $param "\n${paramspaces}~param \\1 " param
  } {
    set param ""
  }

  return "$comment$param$result"
}




#copy file infile to file outfile
#replace all {- and (*-comments by the what [ comment $comment ] returns
proc doit {infile outfile} {
  set fileid [open $infile r] 
  set source [read $fileid]
  close $fileid

  set dest ""


  while { "" != $source } {

#    puts [ string length $source ]

    if [ regexp -indices {\{|'|\(\*|//} $source indices ] {

      set end [ lindex $indices 1 ]
      set token [ string range $source [ lindex $indices 0 ] $end ]

      if { "//" == $token || "'" == $token } {

        if { "'" == $token } {
          set endtoken "'"
        } {
          set endtoken "\n"
        }

        set end [ string first $endtoken $source [ expr $end + 1 ] ]

        if { $end == -1 } {
          set $end end
        }

        append dest [ string range $source 0 $end ]
        set source [ string replace $source 0 $end ]

      } {
        append dest [ string range $source 0 $end ]
        set source [ string replace $source 0 $end ]

        if { "(*" == $token } {
          set endtoken "*)"
        } {
          set endtoken "\}"
        }

        set end [ string first $endtoken $source ]
        if { $end == -1 } {
          set $end end
        } {
          incr end -1
        }

        set comment [ string range $source 0 $end ]
        set source [ string replace $source 0 $end ]

        append dest [ comment $comment ]
      }
    } {
      append dest $source
      set source ""
    }
  }



  set fileid [open $outfile w 0666] 
  puts -nonewline $fileid $dest
  close $fileid
}



doit [lindex $argv 0] [lindex $argv 1]