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