scripts/decomment.tcl

   1 proc tlc::decomment {text} {
   2         if {[string first "#" $text] == -1} {return $text}
   3
   4         set build               {}
   5         foreach line [split $text \n] {
   6                 if {[string index [string trim $line] 0] == "#"} continue
   7                 set idx         [string first "# " $line]
   8                 if {$idx == -1} {
   9                         lappend build $line
  10                 } else {
  11                         incr idx        -1
  12                         lappend build   [string range $line 0 $idx]
  13                 }
  14         }
  15
  16         return [join $build \n]
  17 }
  18
  19 proc tlc::splitcomments {text} {
  20 #   the aim of this proc is to preserve comments for a text file.
  21 #       the output will be a hash array where element 0 is the
  22 #       stripped config file, and elements thereafter are indexed
  23 #       per line and constitute the comments on that line
  24         if {[string first "#" $text] == -1} {
  25                 set ret(0) $text
  26                 return [array get ret]
  27         }
  28
  29         set build               {}
  30         set linenum             1
  31         foreach line [split $text \n] {
  32                 if {[string index [string trim $line] 0] == "#"} {
  33                         set ret($linenum) "\n$line"
  34                 } else {
  35                         set idx         [string first "# " $line]
  36                         if {$idx == -1} {
  37                                 set ret(0) "$ret(0)\n$line"
  38                         } else {
  39                                 set tmp [split $line "#"]
  40                                 set ret(0)                      "$ret(0)\n[lindex $tmp 0]"
  41                                 set ret($linenum)       "#[lindex $tmp 1]"
  42                         }
  43                 }
  44                 incr linenum
  45         }
  46
  47 }
  48
  49 proc tlc::rebuildcomments {arr_text} {
  50 #       this proc is to perform the reverse of the above procedure.
  51 #               it expects the result of an [array get] to be passed, since
  52 #               it will be working with an array internally
  53 #               the procedure assumes that line numbers have not been altered
  54 #               in between the call above and this one, or that the input
  55 #               array has been compensated for line number changes
  56 #               As you could see from examination of the proc above,
  57 #               comments that are on the same line as useful text are
  58 #               distinguished from whole-line comments by the fact that
  59 #               they have no leading \n.
  60
  61         set conftext [lindex arr_text 1]
  62         set comments [lrange arr_text 2 end]
  63         set offset 0
  64         foreach {line comment} $comments {
  65                 if {[string first "\n" $comment] == 0} {
  66                         set conftext [linsert $conftext [expr {$line+$offset}] $comment]
  67                         incr offset
  68                 } else {
  69                         set conftext [lreplace $line $line "[lindex $conftext $line] $comment"]
  70                 }
  71         }
  72         return $conftext
  73 }