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