home *** CD-ROM | disk | FTP | other *** search
/ Complete Linux / Complete Linux.iso / docs / devel / tcl / tclx7_31.z / tclx7_31 / tcldev / tclX7.3a-p1 / tclsrc / convlib.tcl < prev    next >
Encoding:
Text File  |  1993-11-19  |  3.7 KB  |  111 lines
  1. #
  2. # convlib.tcl --
  3. #
  4. #     Convert Ousterhout style tclIndex files and associated libraries to a
  5. # package library.
  6. # 
  7. #------------------------------------------------------------------------------
  8. # Copyright 1992-1993 Karl Lehenbauer and Mark Diekhans.
  9. #
  10. # Permission to use, copy, modify, and distribute this software and its
  11. # documentation for any purpose and without fee is hereby granted, provided
  12. # that the above copyright notice appear in all copies.  Karl Lehenbauer and
  13. # Mark Diekhans make no representations about the suitability of this
  14. # software for any purpose.  It is provided "as is" without express or
  15. # implied warranty.
  16. #------------------------------------------------------------------------------
  17. # $Id: convlib.tcl,v 3.0 1993/11/19 07:00:16 markd Rel $
  18. #------------------------------------------------------------------------------
  19. #
  20.  
  21. #@package: TclX-convertlib convert_lib
  22.  
  23. #------------------------------------------------------------------------------
  24. # tclx:ParseTclIndex
  25. # Parse a tclIndex file, returning an array of file names with the list of
  26. # procedures in each package. This is done by sourcing the file and then
  27. # going through the local auto_index array that was created. Issues warnings
  28. # for lines that can't be converted.  tclIndex should be an absolute path
  29. # name.  Returns 1 if all lines are converted, 0 if some failed.
  30. #
  31.  
  32. proc tclx:ParseTclIndex {tclIndex fileTblVar ignore} {
  33.     upvar $fileTblVar fileTbl
  34.     set allOK 1
  35.  
  36.     # Open and validate the file.
  37.  
  38.     set tclIndexFH [open $tclIndex r]
  39.     set hdr [gets $tclIndexFH]
  40.     if {$hdr != "# Tcl autoload index file, version 2.0"} {
  41.         error "can only convert version 2.0 Tcl auto-load files"
  42.     }
  43.     set dir [file dirname $tclIndex]  ;# Expected by the script.
  44.     eval [read $tclIndexFH]
  45.     close $tclIndexFH
  46.  
  47.     foreach procName [array names auto_index] {
  48.         if ![string match "source *" $auto_index($procName)] {
  49.             puts stderr "WARNING: Can't convert load command for \"$procName\": $auto_index($procName)"
  50.             set allOK 0
  51.             continue
  52.         }
  53.         set filePath [lindex $auto_index($procName) 1]
  54.         set fileName [file tail $filePath] 
  55.         if {[lsearch $ignore $fileName] >= 0} continue
  56.  
  57.         lappend fileTbl($filePath) $procName
  58.     }
  59.     if ![info exists fileTbl] {
  60.         error "no entries could be converted in $tclIndex"
  61.     }
  62.     return $allOK
  63. }
  64.  
  65. #------------------------------------------------------------------------------
  66. # convert_lib:
  67. # Convert a tclIndex library to a .tlib. ignore any files in the ignore
  68. # list
  69.  
  70. proc convert_lib {tclIndex packageLib {ignore {}}} {
  71.     source [info library]/buildidx.tcl
  72.  
  73.     if {[file tail $tclIndex] != "tclIndex"} {
  74.         error "Tail file name must be `tclIndex': $tclIndex"}
  75.     if ![file readable $tclIndex] {
  76.         error "File not readable: $tclIndex"
  77.     }
  78.  
  79.     # Expand to root relative file name.
  80.  
  81.     set tclIndex [glob $tclIndex]
  82.     if ![string match "/*" $tclIndex] {
  83.         set tclIndex "[pwd]/$tclIndex"
  84.     }
  85.  
  86.     # Parse the file.
  87.  
  88.     set allOK [tclx:ParseTclIndex $tclIndex fileTbl $ignore]
  89.  
  90.     # Generate the .tlib package names with contain the directory and
  91.     # file name, less any extensions.
  92.  
  93.     if {[file extension $packageLib] != ".tlib"} {
  94.         append packageLib ".tlib"
  95.     }
  96.     set libFH [open $packageLib w]
  97.  
  98.     foreach srcFile [array names fileTbl] {
  99.         set pkgName [file tail [file dirname $srcFile]]/[file tail [file root $srcFile]]
  100.         set srcFH [open $srcFile r]
  101.         puts $libFH "#@package: $pkgName $fileTbl($srcFile)\n"
  102.         copyfile $srcFH $libFH
  103.         close $srcFH
  104.     }
  105.     close $libFH
  106.     buildpackageindex $packageLib
  107.     if !$allOK {
  108.         error "*** Not all entries converted, but library generated"
  109.     }
  110. }
  111.