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