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