[micropolis] / src / tcl / library / mkindex.tcl

# 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
}