Server : Apache System : Linux copper.netcy.com 2.6.32-754.27.1.el6.centos.plus.x86_64 #1 SMP Thu Jan 30 13:54:25 UTC 2020 x86_64 User : montcaro ( 581) PHP Version : 7.4.28 Disable Function : NONE Directory :  /usr/lib64/tcl8.5/tclx8.4/

Upload File : current_dir [ Writeable ] document_root [ Writeable ]

#
# convlib.tcl --
#
#     Convert Ousterhout style tclIndex files and associated libraries to a
# package library.
# 
#------------------------------------------------------------------------------
# Copyright 1992-1999 Karl Lehenbauer and Mark Diekhans.
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted, provided
# that the above copyright notice appear in all copies.  Karl Lehenbauer and
# Mark Diekhans make no representations about the suitability of this
# software for any purpose.  It is provided "as is" without express or
# implied warranty.
#------------------------------------------------------------------------------
# $Id: convlib.tcl,v 1.1 2001/10/24 23:31:48 hobbs Exp $
#------------------------------------------------------------------------------
#

#@package: TclX-convertlib convert_lib

namespace eval TclX {

    #--------------------------------------------------------------------------
    # ParseTclIndex
    # Parse a tclIndex file, returning an array of file names with the list of
    # procedures in each package. This is done by sourcing the file and then
    # going through the local auto_index array that was created. Issues
    # warnings for lines that can't be converted. 
    #
    # Returns 1 if all lines are converted, 0 if some failed.
    #

    proc ParseTclIndex {tclIndex fileTblVar ignore} {
        upvar $fileTblVar fileTbl
        set allOK 1

        # Open and validate the file.

        set tclIndexFH [open $tclIndex r]
        try_eval {
            set hdr [gets $tclIndexFH]
            if {!([cequal $hdr {# Tcl autoload index file, version 2.0}] ||
                [cequal $hdr == {# Tcl autoload index file, version 2.0 for [incr Tcl]}])} {
                    error "can only convert version 2.0 Tcl auto-load files"
                }
            set dir [file dirname $tclIndex]  ;# Expected by the script.
            eval [read $tclIndexFH]
        }  {} {
            close $tclIndexFH
        }
        foreach procName [array names auto_index] {
            if ![string match "source *" $auto_index($procName)] {
                puts stderr "WARNING: Can't convert load command for\
                        \"$procName\": $auto_index($procName)"
                set allOK 0
                continue
            }
            set filePath [lindex $auto_index($procName) 1]
            set fileName [file tail $filePath] 
            if {[lsearch $ignore $fileName] >= 0} continue
            
            lappend fileTbl($filePath) $procName
        }
        if ![info exists fileTbl] {
            error "no entries could be converted in $tclIndex"
        }
        return $allOK
    }
} ;# namespace TclX

#--------------------------------------------------------------------------
# convert_lib:
# Convert a tclIndex library to a .tlib. ignore any files in the ignore
# list

proc convert_lib {tclIndex packageLib {ignore {}}} {
    if {[file tail $tclIndex] != "tclIndex"} {
        error "Tail file name must be `tclIndex': $tclIndex"}
    if ![file readable $tclIndex] {
        error "File not readable: $tclIndex"
    }

    # Parse the file.

    set allOK [TclX::ParseTclIndex $tclIndex fileTbl $ignore]

    # Generate the .tlib package names with contain the directory and
    # file name, less any extensions.

    if {[file extension $packageLib] != ".tlib"} {
        append packageLib ".tlib"
    }
    set libFH [open $packageLib w]

    foreach srcFile [array names fileTbl] {
        set pkgName [file tail [file dirname $srcFile]]/[file tail [file root $srcFile]]
        set srcFH [open $srcFile r]
        puts $libFH "#@package: $pkgName $fileTbl($srcFile)\n"
        copyfile $srcFH $libFH
        close $srcFH
    }
    close $libFH
    buildpackageindex $packageLib
    if !$allOK {
        error "*** Not all entries converted, but library generated"
    }
}