micropolis

Fork

# 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: /user6/ouster/tcl/scripts/RCS/mkindex.tcl,v 1.2 91/12/16 08:29:25 ouster Exp $ 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
}