tcl/tools/checkLibraryDoc.tcl

   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$
  23
  24
  25 lappend auto_path "c:/program\ files/tclpro1.2/win32-ix86/bin"
  26 #lappend auto_path "/home/surles/cvs/tclx8.0/tcl/unix"
  27 if {[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
  34 set 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
  94 set 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
 103 proc 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
 135 proc 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
 143 proc 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
 200 proc 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
 214 proc 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
 229 proc 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
 244 proc 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
 260 proc 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
 280 proc 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 }
 294 main
 295