home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / misc / volume25 / tcl / part01 / tcl6.1 / library / mkindex.tcl next >
Encoding:
Text File  |  1991-11-14  |  1.6 KB  |  52 lines
  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: /sprite/src/lib/tcl/scripts/RCS/mkindex.tcl,v 1.1 91/09/26 09:55:03 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.     set oldDir [pwd]
  20.     cd $dir
  21.     set dir [pwd]
  22.     append index "# Tcl autoload index file: each line identifies a Tcl\n"
  23.     append index "# procedure and the file where that procedure is\n"
  24.     append index "# defined.  Generated by the \"auto_mkindex\" command.\n"
  25.     append index "\n"
  26.     foreach file [glob $files] {
  27.     set f ""
  28.     set error [catch {
  29.         set f [open $file]
  30.         while {[gets $f line] >= 0} {
  31.         if [regexp {^proc[     ]+([^     ]*)} $line match indices] {
  32.             set procName [string range $line [lindex $indices 0] \
  33.                 [lindex $indices 1]]
  34.             append index "[list $procName $file]\n"
  35.         }
  36.         }
  37.         close $f
  38.     } msg]
  39.     if $error {
  40.         set code $errorCode
  41.         set info $errorInfo
  42.         catch [close $f]
  43.         cd $oldDir
  44.         error $msg $info $code
  45.     }
  46.     }
  47.     set f [open tclIndex w]
  48.     puts $f $index nonewline
  49.     close $f
  50.     cd $oldDir
  51. }
  52.