]>
Commit | Line | Data |
---|---|---|
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 | } |