home *** CD-ROM | disk | FTP | other *** search
/ Il CD di internet / CD.iso / SOURCE / TCL / ITCL / _ITCL.TAR / usr / lib / itcl / itcl_mkindex.tcl < prev    next >
Encoding:
Text File  |  1994-09-14  |  3.2 KB  |  78 lines
  1.  
  2. # itcl_mkindex:
  3. # Regenerate a tclIndex file from Tcl source files.  Takes as argument
  4. # the name of the directory in which the tclIndex file is to be placed,
  5. # floowed by any number of glob patterns to use in that directory to
  6. # locate all of the relevant files.
  7. #
  8. # ////////////////////////////////////////////////////////////////////////
  9. #                MODIFIED TO RECOGNIZED [incr Tcl] CLASSES
  10. # ////////////////////////////////////////////////////////////////////////
  11. #
  12. #   AUTHOR:  Michael J. McLennan       Phone: (610)712-2842
  13. #            AT&T Bell Laboratories   E-mail: michael.mclennan@att.com
  14. #
  15. #      RCS:  itcl_mkindex.tcl,v 1.1.1.1 1994/03/21 22:09:46 mmc Exp
  16. # ----------------------------------------------------------------------
  17. #               Copyright (c) 1993  AT&T Bell Laboratories
  18. # ======================================================================
  19. # Permission to use, copy, modify, and distribute this software and its
  20. # documentation for any purpose and without fee is hereby granted,
  21. # provided that the above copyright notice appear in all copies and that
  22. # both that the copyright notice and warranty disclaimer appear in
  23. # supporting documentation, and that the names of AT&T Bell Laboratories
  24. # any of their entities not be used in advertising or publicity
  25. # pertaining to distribution of the software without specific, written
  26. # prior permission.
  27. #
  28. # AT&T disclaims all warranties with regard to this software, including
  29. # all implied warranties of merchantability and fitness.  In no event
  30. # shall AT&T be liable for any special, indirect or consequential
  31. # damages or any damages whatsoever resulting from loss of use, data or
  32. # profits, whether in an action of contract, negligence or other
  33. # tortuous action, arising out of or in connection with the use or
  34. # performance of this software.
  35. # ======================================================================
  36.  
  37. proc itcl_mkindex {dir args} {
  38.     global errorCode errorInfo
  39.     set oldDir [pwd]
  40.     cd $dir
  41.     set dir [pwd]
  42.     append index "# Tcl autoload index file, version 2.0\n"
  43.     append index "# This file is generated by the \"itcl_mkindex\" command\n"
  44.     append index "# and sourced to set up indexing information for one or\n"
  45.     append index "# more commands.  Typically each line is a command that\n"
  46.     append index "# sets an element in the auto_index array, where the\n"
  47.     append index "# element name is the name of a command and the value is\n"
  48.     append index "# a script that loads the command.\n\n"
  49.     foreach file [eval glob $args] {
  50.     set f ""
  51.     set error [catch {
  52.         set f [open $file]
  53.         while {[gets $f line] >= 0} {
  54.         if [regexp {^proc[     ]+([^     ]*)} $line match procName] {
  55.             append index "set [list auto_index($procName)]"
  56.             append index " \"source \$dir/$file\"\n"
  57.         }
  58.         if [regexp {^itcl_class[     ]+([^     ]*)} $line match className] {
  59.             append index "set [list auto_index($className)]"
  60.             append index " \"source \$dir/$file\"\n"
  61.         }
  62.         }
  63.         close $f
  64.     } msg]
  65.     if $error {
  66.         set code $errorCode
  67.         set info $errorInfo
  68.         catch {close $f}
  69.         cd $oldDir
  70.         error $msg $info $code
  71.     }
  72.     }
  73.     set f [open tclIndex w]
  74.     puts $f $index nonewline
  75.     close $f
  76.     cd $oldDir
  77. }
  78.