]>
Commit | Line | Data |
---|---|---|
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 | ||
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 | } |