Return to convlib.tcl CVS log

Up to [Micropolis - Activity] / micropolis / src / tclx / tclsrc

Annotation of micropolis/src/tclx/tclsrc/convlib.tcl, revision 1.1.1.1

1.1       root        1: #
                      2: # convlib.tcl --
                      3: #
                      4: #     Convert Ousterhout style tclIndex files and associated libraries to a
                      5: # package library.
                      6: # 
                      7: #------------------------------------------------------------------------------
                      8: # Copyright 1992 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 2.0 1992/10/16 04:51:53 markd Rel $
                     18: #------------------------------------------------------------------------------
                     19: #
                     20: 
                     21: #@package: TclX-convertlib convert_lib
                     22: 
                     23: proc convert_lib {tclIndex packageLib {ignore {}}} {
                     24:     if {[file tail $tclIndex] != "tclindex"} {
                     25:         error "Tail file name numt be `tclindex': $tclIndex"}
                     26:     set srcDir [file dirname $tclIndex]
                     27: 
                     28:     if {[file extension $packageLib] != ".tlib"} {
                     29:         append packageLib ".tlib"}
                     30: 
                     31:     # Build an array addressed by file name containing all of the procs
                     32:     # defined in that file.
                     33: 
                     34:     set tclIndexFH [open $tclIndex r]
                     35:     while {[gets $tclIndexFH line] >= 0} {
                     36:         if {([cindex $line 0] == "#") || ([llength $line] != 2)} {
                     37:             continue}
                     38:         if {[lsearch $ignore [lindex $line 1]] >= 0} {
                     39:             continue}
                     40:         lappend entryTable([lindex $line 1]) [lindex $line 0]
                     41:     }
                     42:     close $tclIndexFH
                     43: 
                     44:     set libFH [open $packageLib w]
                     45:     foreach srcFile [array names entryTable] {
                     46:         set srcFH [open $srcDir/$srcFile r]
                     47:         puts $libFH "#@package: $srcFile $entryTable($srcFile)\n"
                     48:         copyfile $srcFH $libFH
                     49:         close $srcFH
                     50:     }
                     51:     close $libFH
                     52:     buildpackageindex $packageLib
                     53: }

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.