1# changelog.tcl -- 2# 3# Handling of ChangeLog's. 4# 5# Copyright (c) 2003-2008 Andreas Kupries <andreas_kupries@sourceforge.net> 6# 7# See the file "license.terms" for information on usage and redistribution 8# of this file, and for a DISCLAIMER OF ALL WARRANTIES. 9# 10# RCS: @(#) $Id: changelog.tcl,v 1.8 2008/07/08 23:03:58 andreas_kupries Exp $ 11 12 13# FUTURE -- Expand pre-parsed log (nested lists) into flat structures 14# FUTURE -- => date/author/file/cref + cref/text 15# FUTURE -- I.e. relational/tabular structure, useable in table displays, 16# FUTURE -- sort by date, author, file to see aggregated changes 17# FUTURE -- => Connectivity to 'struct::matrix', Reports! 18 19 20package require Tcl 8.2 21package require textutil 22 23namespace eval ::doctools {} 24namespace eval ::doctools::changelog { 25 namespace export scan toDoctools 26} 27 28# ::doctools::changelog::scan -- 29# 30# Scan a ChangeLog generated by 'emacs' and extract the relevant information. 31# 32# Result 33# List of entries. Each entry is a list of three elements. These 34# are date, author, and commentary. The commentary is a list of 35# sections. Each section is a list of two elements, a list of 36# files, and the associated text. 37 38 39proc ::doctools::changelog::scan {text} { 40 set text [split $text \n] 41 set n [llength $text] 42 43 set entries [list] 44 set clist [list] 45 set files [list] 46 set comment "" 47 set first 1 48 49 for {set i 0} {$i < $n} {incr i} { 50 set line [lindex $text $i] 51 52 if {[regexp "^\[^ \t\]" $line]} { 53 # No whitespace at the front, start a new entry 54 55 closeEntry 56 57 # For the upcoming entry. Quick extraction first, string 58 # based in case of failure. 59 60 if {[catch { 61 set date [string trim [lindex $line 0]] 62 set author [string trim [lrange $line 1 end]] 63 }]} { 64 set pos [string first " " $line] 65 set date [string trim [string range $line 0 $pos]] 66 set author [string trim [string range $line $pos end]] 67 } 68 continue 69 } 70 71 # Inside of an entry. 72 73 set line [string trim $line] 74 75 if {[string length $line] == 0} { 76 # Next comment section 77 closeSection 78 continue 79 } 80 81 # Line is not empty. Split into file and comment parts, 82 # remember the data. 83 84 if {[string first "* " $line] == 0} { 85 if {[regexp {^\* (.*):[ ]} $line full fname]} { 86 set line [string range $line [string length $full] end] 87 } elseif {[regexp {^\* (.*):$} $line full fname]} { 88 set line "" 89 } else { 90 # There is no filename 91 set fname "" 92 set line [string range $line 2 end] ; # Get rid of "* ". 93 } 94 95 set detail "" 96 while {[string first "(" $fname] >= 0} { 97 if {[regexp {\([^)]*\)} $fname detailx]} { 98 regsub {\([^)]*\)} $fname {} fnameNew 99 } elseif {[regexp {\([^)]*} $fname detailx]} { 100 regsub {\([^)]*} $fname {} fnameNew 101 } else { 102 break 103 } 104 append detail " " $detailx 105 set fname [string trim $fnameNew] 106 } 107 if {$detail != {}} {set line "$detail $line"} 108 if {$fname != {}} {lappend files $fname} 109 } 110 111 append comment $line\n 112 } 113 114 closeEntry 115 return $entries 116} 117 118 119proc ::doctools::changelog::closeSection {} { 120 upvar 1 clist clist comment comment files files 121 122 if { 123 ([string length $comment] > 0) || 124 ([llength $files] > 0) 125 } { 126 lappend clist [list $files [string trim $comment]] 127 set files [list] 128 set comment "" 129 } 130 return 131} 132 133proc ::doctools::changelog::closeEntry {} { 134 upvar 1 clist clist comment comment files files first first \ 135 date date author author entries entries 136 137 if {!$first} { 138 closeSection 139 lappend entries [list $date $author $clist] 140 } 141 set first 0 142 set clist [list] 143 set files [list] 144 set comment "" 145 return 146} 147 148# ::doctools::changelog::merge -- 149# 150# Merge several preprocessed changelogs (see scan) into one structure. 151 152 153proc ::doctools::changelog::merge {args} { 154 155 if {[llength $args] == 0} {return {}} 156 if {[llength $args] == 1} {return [lindex $args 0]} 157 158 set res [list] 159 array set tmp {} 160 161 # Merge up ... 162 163 foreach entries $args { 164 foreach e $entries { 165 foreach {date author comments} $e break 166 if {![info exists tmp($date,$author)]} { 167 lappend res [list $date $author] 168 set tmp($date,$author) $comments 169 } else { 170 foreach section $comments { 171 lappend tmp($date,$author) $section 172 } 173 } 174 } 175 } 176 177 # ... And construct the final result 178 179 set args $res 180 set res [list] 181 foreach key [lsort -decreasing $args] { 182 foreach {date author} $key break 183 lappend res [list $date $author $tmp($date,$author)] 184 } 185 return $res 186} 187 188 189# ::doctools::changelog::toDoctools -- 190# 191# Convert a preprocessed changelog log (see scan) into a doctools page. 192# 193# Arguments: 194# evar, cvar, fvar: Name of the variables containing the preprocessed log. 195# 196# Results: 197# A string containing a properly formatted ChangeLog. 198# 199 200proc ::doctools::changelog::q {text} {return "\[$text\]"} 201 202proc ::doctools::changelog::toDoctools {title module version entries} { 203 204 set linebuffer [list] 205 lappend linebuffer [q "manpage_begin [list ${title}-changelog n $version]"] 206 lappend linebuffer [q "titledesc [list "$title ChangeLog"]"] 207 lappend linebuffer [q "moddesc [list $module]"] 208 lappend linebuffer [q description] 209 lappend linebuffer [q "list_begin definitions compact"] 210 211 foreach entry $entries { 212 foreach {date author commentary} $entry break 213 214 lappend linebuffer [q "lst_item \"[q "emph [list $date]"] -- [string map {{"} {\"} {\"} {\\\"}} $author]\""] 215 216 if {[llength $commentary] > 0} { 217 lappend linebuffer [q nl] 218 } 219 220 foreach section $commentary { 221 foreach {files text} $section break 222 if {$text != {}} { 223 set text [string map {[ [lb] ] [rb]} [textutil::adjust $text]] 224 } 225 226 if {[llength $files] > 0} { 227 lappend linebuffer [q "list_begin definitions"] 228 229 foreach f $files { 230 lappend linebuffer [q "lst_item [q "file [list $f]"]"] 231 } 232 if {$text != {}} { 233 lappend linebuffer "" 234 lappend linebuffer $text 235 lappend linebuffer "" 236 } 237 238 lappend linebuffer [q list_end] 239 } elseif {$text != {}} { 240 # No files 241 lappend linebuffer [q "list_begin bullet"] 242 lappend linebuffer [q bullet] 243 lappend linebuffer "" 244 lappend linebuffer $text 245 lappend linebuffer "" 246 lappend linebuffer [q list_end] 247 } 248 } 249 lappend linebuffer [q nl] 250 } 251 252 lappend linebuffer [q list_end] 253 lappend linebuffer [q manpage_end] 254 return [join $linebuffer \n] 255} 256 257#------------------------------------ 258# Module initialization 259 260package provide doctools::changelog 1 261