]> git.zerfleddert.de Git - micropolis/blame - src/tcl/library/mkindex.tcl
fix height of windows in column 1
[micropolis] / src / tcl / library / mkindex.tcl
CommitLineData
6a5fa4e0
MG
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
18proc 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