# 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.2/*/*.[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.7 2002/01/15 17:55:30 dgp 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_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.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
}
# 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
|