1# -*- tcl -*- 2# (C) 2008 Andreas Kupries <andreas_kupries@users.sourceforge.net> 3## 4# ### 5 6package require sak::animate 7package require sak::feedback 8package require sak::color 9 10getpackage textutil::repeat textutil/repeat.tcl 11getpackage doctools doctools/doctools.tcl 12 13namespace eval ::sak::validate::manpages { 14 namespace import ::textutil::repeat::blank 15 namespace import ::sak::color::* 16 namespace import ::sak::feedback::! 17 namespace import ::sak::feedback::>> 18 namespace import ::sak::feedback::+= 19 namespace import ::sak::feedback::= 20 namespace import ::sak::feedback::=| 21 namespace import ::sak::feedback::log 22 namespace import ::sak::feedback::summary 23 rename summary sum 24} 25 26# ### 27 28proc ::sak::validate::manpages {modules mode stem tclv} { 29 manpages::run $modules $mode $stem $tclv 30 manpages::summary 31 return 32} 33 34proc ::sak::validate::manpages::run {modules mode stem tclv} { 35 sak::feedback::init $mode $stem 36 sak::feedback::first log "\[ Documentation \] ===============================================" 37 sak::feedback::first unc "\[ Documentation \] ===============================================" 38 sak::feedback::first fail "\[ Documentation \] ===============================================" 39 sak::feedback::first warn "\[ Documentation \] ===============================================" 40 sak::feedback::first miss "\[ Documentation \] ===============================================" 41 sak::feedback::first none "\[ Documentation \] ===============================================" 42 43 # Preprocessing of module names to allow better formatting of the 44 # progress output, i.e. vertically aligned columns 45 46 # Per module we can distinguish the following levels of 47 # documentation completeness and validity 48 49 # Completeness: 50 # - No package has documentation 51 # - Some, but not all packages have documentation 52 # - All packages have documentation. 53 # 54 # Validity, restricted to the set packages which have documentation: 55 # - Documentation has errors and warnings 56 # - Documentation has errors, but no warnings. 57 # - Documentation has no errors, but warnings. 58 # - Documentation has neither errors nor warnings. 59 60 # Progress report per module: Packages it is working on. 61 # Summary at module level: 62 # - Number of packages, number of packages with documentation, 63 # - Number of errors, number of warnings. 64 65 # Full log: 66 # - Lists packages without documentation. 67 # - Lists packages with errors/warnings. 68 # - Lists the exact errors/warnings per package, and location. 69 70 # Global preparation: Pull information about all packages and the 71 # modules they belong to. 72 73 ::doctools::new dt -format desc -deprecated 1 74 75 Count $modules 76 MapPackages 77 78 InitCounters 79 foreach m $modules { 80 # Skip tcllibc shared library, not a module. 81 if {[string equal $m tcllibc]} continue 82 83 InitModuleCounters 84 ! 85 log "@@ Module $m" 86 Head $m 87 88 # Per module: Find all doctools manpages inside and process 89 # them. We get errors, warnings, and determine the package(s) 90 # they may belong to. 91 92 # Per package: Have they doc files claiming them? After that, 93 # are doc files left over (i.e. without a package)? 94 95 ProcessPages $m 96 ProcessPackages $m 97 ProcessUnclaimed 98 ModuleSummary 99 } 100 101 dt destroy 102 return 103} 104 105proc ::sak::validate::manpages::summary {} { 106 Summary 107 return 108} 109 110# ### 111 112proc ::sak::validate::manpages::ProcessPages {m} { 113 !claims 114 dt configure -module $m 115 foreach f [glob -nocomplain [file join [At $m] *.man]] { 116 ProcessManpage $f 117 } 118 return 119} 120 121proc ::sak::validate::manpages::ProcessManpage {f} { 122 =file $f 123 dt configure -file $f 124 125 if {[catch { 126 dt format [get_input $f] 127 } msg]} { 128 +e $msg 129 } else { 130 foreach {pkg _ _} $msg { +claim $pkg } 131 } 132 133 set warnings [dt warnings] 134 if {![llength $warnings]} return 135 136 foreach msg $warnings { +w $msg } 137 return 138} 139 140proc ::sak::validate::manpages::ProcessPackages {m} { 141 !used 142 if {![HasPackages $m]} return 143 144 foreach p [ThePackages $m] { 145 +pkg $p 146 if {[claimants $p]} { 147 +doc $p 148 } else { 149 nodoc $p 150 } 151 } 152 return 153} 154 155proc ::sak::validate::manpages::ProcessUnclaimed {} { 156 variable claims 157 if {![array size claims]} return 158 foreach p [lsort -dict [array names claims]] { 159 foreach fx $claims($p) { +u $fx } 160 } 161 return 162} 163 164### 165 166proc ::sak::validate::manpages::=file {f} { 167 variable current [file tail $f] 168 = "$current ..." 169 return 170} 171 172### 173 174proc ::sak::validate::manpages::!claims {} { 175 variable claims 176 array unset claims * 177 return 178} 179 180proc ::sak::validate::manpages::+claim {pkg} { 181 variable current 182 variable claims 183 lappend claims($pkg) $current 184 return 185} 186 187proc ::sak::validate::manpages::claimants {pkg} { 188 variable claims 189 expr { [info exists claims($pkg)] && [llength $claims($pkg)] } 190} 191 192 193### 194 195proc ::sak::validate::manpages::!used {} { 196 variable used 197 array unset used * 198 return 199} 200 201proc ::sak::validate::manpages::+use {pkg} { 202 variable used 203 variable claims 204 foreach fx $claims($pkg) { set used($fx) . } 205 unset claims($pkg) 206 return 207} 208 209### 210 211proc ::sak::validate::manpages::MapPackages {} { 212 variable pkg 213 array unset pkg * 214 215 ! 216 += Package 217 foreach {pname pdata} [ipackages] { 218 = "$pname ..." 219 foreach {pver pmodule} $pdata break 220 lappend pkg($pmodule) $pname 221 } 222 ! 223 =| {Packages mapped ...} 224 return 225} 226 227proc ::sak::validate::manpages::HasPackages {m} { 228 variable pkg 229 expr { [info exists pkg($m)] && [llength $pkg($m)] } 230} 231 232proc ::sak::validate::manpages::ThePackages {m} { 233 variable pkg 234 return [lsort -dict $pkg($m)] 235} 236 237### 238 239proc ::sak::validate::manpages::+pkg {pkg} { 240 variable mtotal ; incr mtotal 241 variable total ; incr total 242 return 243} 244 245proc ::sak::validate::manpages::+doc {pkg} { 246 variable mhavedoc ; incr mhavedoc 247 variable havedoc ; incr havedoc 248 = "$pkg Ok" 249 +use $pkg 250 return 251} 252 253proc ::sak::validate::manpages::nodoc {pkg} { 254 = "$pkg Bad" 255 log "@@ WARN No documentation: $pkg" 256 return 257} 258 259### 260 261proc ::sak::validate::manpages::+w {msg} { 262 variable mwarnings ; incr mwarnings 263 variable warnings ; incr warnings 264 variable current 265 foreach {a b c} [split $msg \n] break 266 log "@@ WARN $current: [Trim $a] [Trim $b] [Trim $c]" 267 return 268} 269 270proc ::sak::validate::manpages::+e {msg} { 271 variable merrors ; incr merrors 272 variable errors ; incr errors 273 variable current 274 log "@@ ERROR $current $msg" 275 return 276} 277 278proc ::sak::validate::manpages::+u {f} { 279 variable used 280 if {[info exists used($f)]} return 281 variable munclaimed ; incr munclaimed 282 variable unclaimed ; incr unclaimed 283 set used($f) . 284 log "@@ WARN Unclaimed documentation file: $f" 285 return 286} 287 288### 289 290proc ::sak::validate::manpages::Count {modules} { 291 variable maxml 0 292 ! 293 foreach m [linsert $modules 0 Module] { 294 = "M $m" 295 set l [string length $m] 296 if {$l > $maxml} {set maxml $l} 297 } 298 =| "Validate documentation (existence, errors, warnings) ..." 299 return 300} 301 302proc ::sak::validate::manpages::Head {m} { 303 variable maxml 304 += ${m}[blank [expr {$maxml - [string length $m]}]] 305 return 306} 307 308### 309 310proc ::sak::validate::manpages::InitModuleCounters {} { 311 variable mtotal 0 312 variable mhavedoc 0 313 variable munclaimed 0 314 variable merrors 0 315 variable mwarnings 0 316 return 317} 318 319proc ::sak::validate::manpages::ModuleSummary {} { 320 variable mtotal 321 variable mhavedoc 322 variable munclaimed 323 variable merrors 324 variable mwarnings 325 326 set complete [F $mhavedoc]/[F $mtotal] 327 set not "! [F [expr {$mtotal - $mhavedoc}]]" 328 set err "E [F $merrors]" 329 set warn "W [F $mwarnings]" 330 set unc "U [F $munclaimed]" 331 332 if {$munclaimed} { 333 set unc [=cya $unc] 334 >> unc 335 } 336 if {!$mhavedoc && $mtotal} { 337 set complete [=red $complete] 338 set not [=red $not] 339 >> none 340 } elseif {$mhavedoc < $mtotal} { 341 set complete [=yel $complete] 342 set not [=yel $not] 343 >> miss 344 } 345 if {$merrors} { 346 set err [=red $err] 347 set warn [=yel $warn] 348 >> fail 349 } elseif {$mwarnings} { 350 set warn [=yel $warn] 351 >> warn 352 } 353 354 =| "~~ $complete $not $unc $err $warn" 355 return 356} 357 358### 359 360proc ::sak::validate::manpages::InitCounters {} { 361 variable total 0 362 variable havedoc 0 363 variable unclaimed 0 364 variable errors 0 365 variable warnings 0 366 return 367} 368 369proc ::sak::validate::manpages::Summary {} { 370 variable total 371 variable havedoc 372 variable unclaimed 373 variable errors 374 variable warnings 375 376 set tot [F $total] 377 set doc [F $havedoc] 378 set udc [F [expr {$total - $havedoc}]] 379 380 set unc [F $unclaimed] 381 set per [format %6.2f [expr {$havedoc*100./$total}]] 382 set uper [format %6.2f [expr {($total - $havedoc)*100./$total}]] 383 set err [F $errors] 384 set wrn [F $warnings] 385 386 if {$errors} { set err [=red $err] } 387 if {$warnings} { set wrn [=yel $wrn] } 388 if {$unclaimed} { set unc [=cya $unc] } 389 390 if {!$havedoc && $total} { 391 set doc [=red $doc] 392 set udc [=red $udc] 393 } elseif {$havedoc < $total} { 394 set doc [=yel $doc] 395 set udc [=yel $udc] 396 } 397 398 sum "" 399 sum "Documentation statistics" 400 sum "#Packages: $tot" 401 sum "#Documented: $doc (${per}%)" 402 sum "#Undocumented: $udc (${uper}%)" 403 sum "#Unclaimed: $unc" 404 sum "#Errors: $err" 405 sum "#Warnings: $wrn" 406 return 407} 408 409### 410 411proc ::sak::validate::manpages::F {n} { format %6d $n } 412 413proc ::sak::validate::manpages::Trim {text} { 414 regsub {^[^:]*:} $text {} text 415 return [string trim $text] 416} 417 418### 419 420proc ::sak::validate::manpages::At {m} { 421 global distribution 422 return [file join $distribution modules $m] 423} 424 425# ### 426 427namespace eval ::sak::validate::manpages { 428 # Max length of module names and patchlevel information. 429 variable maxml 0 430 431 # Counters across all modules 432 variable total 0 ; # Number of packages overall. 433 variable havedoc 0 ; # Number of packages with documentation. 434 variable unclaimed 0 ; # Number of manpages not claimed by a specific package. 435 variable errors 0 ; # Number of errors found in all documentation. 436 variable warnings 0 ; # Number of warnings found in all documentation. 437 438 # Same counters, per module. 439 variable mtotal 0 440 variable mhavedoc 0 441 variable munclaimed 0 442 variable merrors 0 443 variable mwarnings 0 444 445 # Name of currently processed manpage 446 variable current "" 447 448 # Map from packages to files claiming to document them. 449 variable claims 450 array set claims {} 451 452 # Set of files taken by packages, as array 453 variable used 454 array set used {} 455 456 # Map from modules to packages contained in them 457 variable pkg 458 array set pkg {} 459} 460 461## 462# ### 463 464package provide sak::validate::manpages 1.0 465