# checkLibraryDoc.tcl -- # # This script attempts to determine what APIs exist in the source base that # have not been documented. By grepping through all of the doc/*.3 man # pages, looking for "Pkg_*" (e.g., Tcl_ or Tk_), and comparing this list # against the list of Pkg_ APIs found in the source (e.g., tcl8.1/*/*.[ch]) # we create six lists: # 1) APIs in Source not in Docs. # 2) APIs in Docs not in Source. # 3) Internal APIs and structs. # 4) Misc APIs and structs that we are not documenting. # 5) Command APIs (e.g., Tcl_ArrayObjCmd.) # 6) Proc pointers (e.g., Tcl_CloseProc.) # # Note: Each list is "a best guess" approximation. If developers write # non-standard code, this script will produce erroneous results. Each # list should be carefully checked for accuracy. # # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # # RCS: @(#) $Id: checkLibraryDoc.tcl,v 1.4 1999/04/17 00:18:26 surles Exp $ lappend auto_path "c:/program\ files/tclpro1.2/win32-ix86/bin" #lappend auto_path "/home/surles/cvs/tclx8.0/tcl/unix" if {[catch {package require Tclx}]} { puts "error: could not load TclX. Please set TCL_LIBRARY." exit 1 } # A list of structs that are known to be undocumented. set StructList { Tcl_AsyncHandler \ Tcl_CallFrame \ Tcl_Condition \ Tcl_Encoding \ Tcl_EncodingState \ Tcl_EncodingType \ Tcl_EolTranslation \ Tcl_HashEntry \ Tcl_HashSearch \ Tcl_HashTable \ Tcl_Mutex \ Tcl_Pid \ Tcl_QueuePosition \ Tcl_ResolvedVarInfo \ Tcl_SavedResult \ Tcl_ThreadDataKey \ Tcl_ThreadId \ Tcl_Time \ Tcl_TimerToken \ Tcl_Token \ Tcl_Trace \ Tcl_Value \ Tcl_ValueType \ Tcl_Var \ Tk_3DBorder \ Tk_ArgvInfo \ Tk_BindingTable \ Tk_Canvas \ Tk_CanvasTextInfo \ Tk_ConfigSpec \ Tk_ConfigTypes \ Tk_Cursor \ Tk_CustomOption \ Tk_ErrorHandler \ Tk_FakeWin \ Tk_Font \ Tk_FontMetrics \ Tk_GeomMgr \ Tk_Image \ Tk_ImageMaster \ Tk_ImageType \ Tk_Item \ Tk_ItemType \ Tk_OptionSpec\ Tk_OptionTable \ Tk_OptionType \ Tk_PhotoHandle \ Tk_PhotoImageBlock \ Tk_PhotoImageFormat \ Tk_PostscriptInfo \ Tk_SavedOption \ Tk_SavedOptions \ Tk_SegType \ Tk_TextLayout \ Tk_Window \ } # Misc junk that appears in the comments of the source. This just # allows us to filter comments that "fool" the script. set CommentList { Tcl_Create\[Obj\]Command \ Tcl_DecrRefCount\\n \ Tcl_NewObj\\n \ Tk_GetXXX \ } # Main entry point to this script. proc main {} { global argv0 global argv set len [llength $argv] if {($len != 2) && ($len != 3)} { puts "usage: $argv0 pkgName pkgDir \[outFile\]" puts " pkgName == Tcl,Tk" puts " pkgDir == /home/surles/cvs/tcl8.1" exit 1 } set pkg [lindex $argv 0] set dir [lindex $argv 1] if {[llength $argv] == 3} { set file [open [lindex $argv 2] w] } else { set file stdout } foreach {c d} [compare [grepCode $dir $pkg] [grepDocs $dir $pkg]] {} filter $c $d $dir $pkg $file if {$file != "stdout"} { close $file } return } # Intersect the two list and write out the sets of APIs in one # list that is not in the other. proc compare {list1 list2} { set inter [intersect3 $list1 $list2] return [list [lindex $inter 0] [lindex $inter 2]] } # Filter the lists into the six lists we report on. Then write # the results to the file. proc filter {code docs dir pkg {outFile stdout}} { set apis {} # A list of Tcl command APIs. These are not documented. # This list should just be verified for accuracy. set cmds {} # A list of proc pointer structs. These are not documented. # This list should just be verified for accuracy. set procs {} # A list of internal declarations. These are not documented. # This list should just be verified for accuracy. set decls [grepDecl $dir $pkg] # A list of misc. procedure declarations that are not documented. # This list should just be verified for accuracy. set misc [grepMisc $dir $pkg] set pat1 ".*(${pkg}_\[A-z0-9]+).*$" # A list of APIs in the source, not in the docs. # This list should just be verified for accuracy. foreach x $code { if {[string match *Cmd $x]} { if {[string match ${pkg}* $x]} { lappend cmds $x } } elseif {[string match *Proc $x]} { if {[string match ${pkg}* $x]} { lappend procs $x } } elseif {[lsearch -exact $decls $x] >= 0} { # No Op. } elseif {[lsearch -exact $misc $x] >= 0} { # No Op. } else { lappend apis $x } } dump $apis "APIs in Source not in Docs." $outFile dump $docs "APIs in Docs not in Source." $outFile dump $decls "Internal APIs and structs." $outFile dump $misc "Misc APIs and structs that we are not documenting." $outFile dump $cmds "Command APIs." $outFile dump $procs "Proc pointers." $outFile return } # Print the list of APIs if the list is not null. proc dump {list title file} { if {$list != {}} { puts $file "" puts $file $title puts $file "---------------------------------------------------------" foreach x $list { puts $file $x } } } # Grep into "dir/*/*.[ch]" looking for APIs that match $pkg_*. # (e.g., Tcl_Exit). Return a list of APIs. proc grepCode {dir pkg} { set apis [myGrep "${pkg}_\.\*" "${dir}/\*/\*\.\[ch\]"] set pat1 ".*(${pkg}_\[A-z0-9]+).*$" foreach a $apis { if {[regexp -- $pat1 $a main n1]} { set result([string trim $n1]) 1 } } return [lsort [array names result]] } # Grep into "dir/doc/*.3" looking for APIs that match $pkg_*. # (e.g., Tcl_Exit). Return a list of APIs. proc grepDocs {dir pkg} { set apis [myGrep "\\fB${pkg}_\.\*\\fR" "${dir}/doc/\*\.3"] set pat1 ".*(${pkg}_\[A-z0-9]+)\\\\fR.*$" foreach a $apis { if {[regexp -- $pat1 $a main n1]} { set result([string trim $n1]) 1 } } return [lsort [array names result]] } # Grep into "generic/pkgIntDecls.h" looking for APIs that match $pkg_*. # (e.g., Tcl_Export). Return a list of APIs. proc grepDecl {dir pkg} { set file [file join $dir generic "[string tolower $pkg]IntDecls.h"] set apis [myGrep "^EXTERN.*\[ \t\]${pkg}_.*" $file] set pat1 ".*(${pkg}_\[A-z0-9]+).*$" foreach a $apis { if {[regexp -- $pat1 $a main n1]} { set result([string trim $n1]) 1 } } return [lsort [array names result]] } # Grep into "*/*.[ch]" looking for APIs that match $pkg_Db*. # (e.g., Tcl_DbCkalloc). Return a list of APIs. proc grepMisc {dir pkg} { global CommentList global StructList set apis [myGrep "^EXTERN.*\[ \t\]${pkg}_Db.*" "${dir}/\*/\*\.\[ch\]"] set pat1 ".*(${pkg}_\[A-z0-9]+).*$" foreach a $apis { if {[regexp -- $pat1 $a main n1]} { set dbg([string trim $n1]) 1 } } set result {} eval {lappend result} $StructList eval {lappend result} [lsort [array names dbg]] eval {lappend result} $CommentList return $result } proc myGrep {searchPat globPat} { set result {} foreach file [glob -nocomplain $globPat] { set file [open $file r] set data [read $file] close $file foreach line [split $data "\n"] { if {[regexp "^.*${searchPat}.*\$" $line]} { lappend result $line } } } return $result } main