checkLibraryDoc.tcl [plain text]
lappend auto_path "c:/program\ files/tclpro1.2/win32-ix86/bin"
if {[catch {package require Tclx}]} {
puts "error: could not load TclX. Please set TCL_LIBRARY."
exit 1
}
set StructList {
Tcl_AsyncHandler \
Tcl_CallFrame \
Tcl_Condition \
Tcl_Encoding \
Tcl_EncodingState \
Tcl_EncodingType \
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 \
}
set CommentList {
Tcl_Create\[Obj\]Command \
Tcl_DecrRefCount\\n \
Tcl_NewObj\\n \
Tk_GetXXX \
}
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.2"
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
}
proc compare {list1 list2} {
set inter [intersect3 $list1 $list2]
return [list [lindex $inter 0] [lindex $inter 2]]
}
proc filter {code docs dir pkg {outFile stdout}} {
set apis {}
set cmds {}
set procs {}
set decls [grepDecl $dir $pkg]
set misc [grepMisc $dir $pkg]
set pat1 ".*(${pkg}_\[A-z0-9]+).*$"
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} {
} elseif {[lsearch -exact $misc $x] >= 0} {
} 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
}
proc dump {list title file} {
if {$list != {}} {
puts $file ""
puts $file $title
puts $file "---------------------------------------------------------"
foreach x $list {
puts $file $x
}
}
}
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]]
}
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]]
}
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]]
}
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