]> git.zerfleddert.de Git - micropolis/blob - src/tcl/library/mkindex.tcl
fe17903bb12c84831ef0ee548dea9cef53f923a8
[micropolis] / src / tcl / library / mkindex.tcl
1 # auto_mkindex:
2 # Given a directory and a glob-style specification for files in that
3 # directory, generate a "tclIndex" file in the directory that is suitable
4 # for use in auto-loading. Returns a null string.
5 #
6 # $Header: /user6/ouster/tcl/scripts/RCS/mkindex.tcl,v 1.2 91/12/16 08:29:25 ouster Exp $ SPRITE (Berkeley)
7 #
8 # Copyright 1991 Regents of the University of California
9 # Permission to use, copy, modify, and distribute this
10 # software and its documentation for any purpose and without
11 # fee is hereby granted, provided that this copyright
12 # notice appears in all copies. The University of California
13 # makes no representations about the suitability of this
14 # software for any purpose. It is provided "as is" without
15 # express or implied warranty.
16 #
17
18 proc auto_mkindex {dir files} {
19 global errorCode errorInfo
20 set oldDir [pwd]
21 cd $dir
22 set dir [pwd]
23 append index "# Tcl autoload index file: each line identifies a Tcl\n"
24 append index "# procedure and the file where that procedure is\n"
25 append index "# defined. Generated by the \"auto_mkindex\" command.\n"
26 append index "\n"
27 foreach file [glob $files] {
28 set f ""
29 set error [catch {
30 set f [open $file]
31 while {[gets $f line] >= 0} {
32 if [regexp {^proc[ ]+([^ ]*)} $line match procName] {
33 append index "[list $procName $file]\n"
34 }
35 }
36 close $f
37 } msg]
38 if $error {
39 set code $errorCode
40 set info $errorInfo
41 catch [close $f]
42 cd $oldDir
43 error $msg $info $code
44 }
45 }
46 set f [open tclindex w]
47 puts $f $index nonewline
48 close $f
49 cd $oldDir
50 }
Impressum, Datenschutz