| # auto_mkindex: |
| # Given a directory and a glob-style specification for files in that |
| # directory, generate a "tclIndex" file in the directory that is suitable |
| # for use in auto-loading. Returns a null string. |
| # |
| # $Header$ SPRITE (Berkeley) |
| # |
| # Copyright 1991 Regents of the University of California |
| # Permission to use, copy, modify, and distribute this |
| # software and its documentation for any purpose and without |
| # fee is hereby granted, provided that this copyright |
| # notice appears in all copies. The University of California |
| # makes no representations about the suitability of this |
| # software for any purpose. It is provided "as is" without |
| # express or implied warranty. |
| # |
| |
| proc auto_mkindex {dir files} { |
| global errorCode errorInfo |
| set oldDir [pwd] |
| cd $dir |
| set dir [pwd] |
| append index "# Tcl autoload index file: each line identifies a Tcl\n" |
| append index "# procedure and the file where that procedure is\n" |
| append index "# defined. Generated by the \"auto_mkindex\" command.\n" |
| append index "\n" |
| foreach file [glob $files] { |
| set f "" |
| set error [catch { |
| set f [open $file] |
| while {[gets $f line] >= 0} { |
| if [regexp {^proc[ ]+([^ ]*)} $line match procName] { |
| append index "[list $procName $file]\n" |
| } |
| } |
| close $f |
| } msg] |
| if $error { |
| set code $errorCode |
| set info $errorInfo |
| catch [close $f] |
| cd $oldDir |
| error $msg $info $code |
| } |
| } |
| set f [open tclIndex w] |
| puts $f $index nonewline |
| close $f |
| cd $oldDir |
| } |