1# checkLibraryDoc.tcl --
2#
3# This script attempts to determine what APIs exist in the source base that
4# have not been documented.  By grepping through all of the doc/*.3 man
5# pages, looking for "Pkg_*" (e.g., Tcl_ or Tk_), and comparing this list
6# against the list of Pkg_ APIs found in the source (e.g., tcl8.2/*/*.[ch])
7# we create six lists:
8#      1) APIs in Source not in Docs.
9#      2) APIs in Docs not in Source.
10#      3) Internal APIs and structs.
11#      4) Misc APIs and structs that we are not documenting.
12#      5) Command APIs (e.g., Tcl_ArrayObjCmd.)
13#      6) Proc pointers (e.g., Tcl_CloseProc.)
14#
15# Note: Each list is "a best guess" approximation.  If developers write
16# non-standard code, this script will produce erroneous results.  Each
17# list should be carefully checked for accuracy.
18#
19# Copyright (c) 1998-1999 by Scriptics Corporation.
20# All rights reserved.
21#
22# RCS: @(#) $Id: checkLibraryDoc.tcl,v 1.7 2002/01/15 17:55:30 dgp Exp $
23
24
25lappend auto_path "c:/program\ files/tclpro1.2/win32-ix86/bin"
26#lappend auto_path "/home/surles/cvs/tclx8.0/tcl/unix"
27if {[catch {package require Tclx}]} {
28    puts "error: could not load TclX.  Please set TCL_LIBRARY."
29    exit 1
30}
31
32# A list of structs that are known to be undocumented.
33
34set StructList {
35    Tcl_AsyncHandler \
36    Tcl_CallFrame \
37    Tcl_Condition \
38    Tcl_Encoding \
39    Tcl_EncodingState \
40    Tcl_EncodingType \
41    Tcl_HashEntry \
42    Tcl_HashSearch \
43    Tcl_HashTable \
44    Tcl_Mutex \
45    Tcl_Pid \
46    Tcl_QueuePosition \
47    Tcl_ResolvedVarInfo \
48    Tcl_SavedResult \
49    Tcl_ThreadDataKey \
50    Tcl_ThreadId \
51    Tcl_Time \
52    Tcl_TimerToken \
53    Tcl_Token \
54    Tcl_Trace \
55    Tcl_Value \
56    Tcl_ValueType \
57    Tcl_Var \
58    Tk_3DBorder \
59    Tk_ArgvInfo \
60    Tk_BindingTable \
61    Tk_Canvas \
62    Tk_CanvasTextInfo \
63    Tk_ConfigSpec \
64    Tk_ConfigTypes \
65    Tk_Cursor \
66    Tk_CustomOption \
67    Tk_ErrorHandler \
68    Tk_FakeWin \
69    Tk_Font \
70    Tk_FontMetrics \
71    Tk_GeomMgr \
72    Tk_Image \
73    Tk_ImageMaster \
74    Tk_ImageType \
75    Tk_Item \
76    Tk_ItemType \
77    Tk_OptionSpec\
78    Tk_OptionTable \
79    Tk_OptionType \
80    Tk_PhotoHandle \
81    Tk_PhotoImageBlock \
82    Tk_PhotoImageFormat \
83    Tk_PostscriptInfo \
84    Tk_SavedOption \
85    Tk_SavedOptions \
86    Tk_SegType \
87    Tk_TextLayout \
88    Tk_Window \
89}
90
91# Misc junk that appears in the comments of the source.  This just
92# allows us to filter comments that "fool" the script.
93
94set CommentList {
95    Tcl_Create\[Obj\]Command \
96    Tcl_DecrRefCount\\n \
97    Tcl_NewObj\\n \
98    Tk_GetXXX \
99}
100
101# Main entry point to this script.
102
103proc main {} {
104    global argv0
105    global argv
106
107    set len [llength $argv]
108    if {($len != 2) && ($len != 3)} {
109	puts "usage: $argv0 pkgName pkgDir \[outFile\]"
110	puts "   pkgName == Tcl,Tk"
111	puts "   pkgDir  == /home/surles/cvs/tcl8.2"
112	exit 1
113    }
114
115    set pkg [lindex $argv 0]
116    set dir [lindex $argv 1]
117    if {[llength $argv] == 3} {
118	set file [open [lindex $argv 2] w]
119    } else {
120	set file stdout
121    }
122
123    foreach {c d} [compare [grepCode $dir $pkg] [grepDocs $dir $pkg]] {}
124    filter $c $d $dir $pkg $file
125
126    if {$file != "stdout"} {
127	close $file
128    }
129    return
130}
131
132# Intersect the two list and write out the sets of APIs in one
133# list that is not in the other.
134
135proc compare {list1 list2} {
136    set inter [intersect3 $list1 $list2]
137    return [list [lindex $inter 0] [lindex $inter 2]]
138}
139
140# Filter the lists into the six lists we report on.  Then write
141# the results to the file.
142
143proc filter {code docs dir pkg {outFile stdout}} {
144    set apis  {}
145
146    # A list of Tcl command APIs.  These are not documented.
147    # This list should just be verified for accuracy.
148
149    set cmds  {}
150
151    # A list of proc pointer structs.  These are not documented.
152    # This list should just be verified for accuracy.
153
154    set procs {}
155
156    # A list of internal declarations.  These are not documented.
157    # This list should just be verified for accuracy.
158
159    set decls [grepDecl $dir $pkg]
160
161    # A list of misc. procedure declarations that are not documented.
162    # This list should just be verified for accuracy.
163
164    set misc [grepMisc $dir $pkg]
165
166    set pat1 ".*(${pkg}_\[A-z0-9]+).*$"
167
168    # A list of APIs in the source, not in the docs.
169    # This list should just be verified for accuracy.
170
171    foreach x $code {
172	if {[string match *Cmd $x]} {
173	    if {[string match ${pkg}* $x]} {
174		lappend cmds $x
175	    }
176	} elseif {[string match *Proc $x]} {
177	    if {[string match ${pkg}* $x]} {
178		lappend procs $x
179	    }
180	} elseif {[lsearch -exact $decls $x] >= 0} {
181	    # No Op.
182	} elseif {[lsearch -exact $misc $x] >= 0} {
183	    # No Op.
184	} else {
185	    lappend apis $x
186	}
187    }
188
189    dump $apis  "APIs in Source not in Docs." $outFile
190    dump $docs  "APIs in Docs not in Source." $outFile
191    dump $decls "Internal APIs and structs."  $outFile
192    dump $misc  "Misc APIs and structs that we are not documenting." $outFile
193    dump $cmds  "Command APIs."  $outFile
194    dump $procs "Proc pointers." $outFile
195    return
196}
197
198# Print the list of APIs if the list is not null.
199
200proc dump {list title file} {
201    if {$list != {}} {
202	puts $file ""
203	puts $file $title
204	puts $file "---------------------------------------------------------"
205	foreach x $list {
206	    puts $file $x
207	}
208    }
209}
210
211# Grep into "dir/*/*.[ch]" looking for APIs that match $pkg_*.
212# (e.g., Tcl_Exit).  Return a list of APIs.
213
214proc grepCode {dir pkg} {
215    set apis [myGrep "${pkg}_\.\*" "${dir}/\*/\*\.\[ch\]"]
216    set pat1 ".*(${pkg}_\[A-z0-9]+).*$"
217
218    foreach a $apis {
219	if {[regexp --  $pat1 $a main n1]} {
220	    set result([string trim $n1]) 1
221	}
222    }
223    return [lsort [array names result]]
224}
225
226# Grep into "dir/doc/*.3" looking for APIs that match $pkg_*.
227# (e.g., Tcl_Exit).  Return a list of APIs.
228
229proc grepDocs {dir pkg} {
230    set apis [myGrep "\\fB${pkg}_\.\*\\fR" "${dir}/doc/\*\.3"]
231    set pat1 ".*(${pkg}_\[A-z0-9]+)\\\\fR.*$"
232
233    foreach a $apis {
234	if {[regexp -- $pat1 $a main n1]} {
235	    set result([string trim $n1]) 1
236	}
237    }
238    return [lsort [array names result]]
239}
240
241# Grep into "generic/pkgIntDecls.h" looking for APIs that match $pkg_*.
242# (e.g., Tcl_Export).  Return a list of APIs.
243
244proc grepDecl {dir pkg} {
245    set file [file join $dir generic "[string tolower $pkg]IntDecls.h"]
246    set apis [myGrep "^EXTERN.*\[ \t\]${pkg}_.*" $file]
247    set pat1 ".*(${pkg}_\[A-z0-9]+).*$"
248
249    foreach a $apis {
250	if {[regexp -- $pat1 $a main n1]} {
251	    set result([string trim $n1]) 1
252	}
253    }
254    return [lsort [array names result]]
255}
256
257# Grep into "*/*.[ch]" looking for APIs that match $pkg_Db*.
258# (e.g., Tcl_DbCkalloc).  Return a list of APIs.
259
260proc grepMisc {dir pkg} {
261    global CommentList
262    global StructList
263
264    set apis [myGrep "^EXTERN.*\[ \t\]${pkg}_Db.*" "${dir}/\*/\*\.\[ch\]"]
265    set pat1 ".*(${pkg}_\[A-z0-9]+).*$"
266
267    foreach a $apis {
268	if {[regexp -- $pat1 $a main n1]} {
269	    set dbg([string trim $n1]) 1
270	}
271    }
272
273    set result {}
274    eval {lappend result} $StructList
275    eval {lappend result} [lsort [array names dbg]]
276    eval {lappend result} $CommentList
277    return $result
278}
279
280proc myGrep {searchPat globPat} {
281    set result {}
282    foreach file [glob -nocomplain $globPat] {
283	set file [open $file r]
284	set data [read $file]
285	close $file
286	foreach line [split $data "\n"] {
287	    if {[regexp "^.*${searchPat}.*\$" $line]} {
288		lappend result $line
289	    }
290	}
291    }
292    return $result
293}
294main
295
296