home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 December / PCWorld_2000-12_cd.bin / Komunikace / Comanche / comanche.exe / lib / tclX8.0.5 / autoload.tcl next >
Text File  |  1999-02-24  |  2KB  |  85 lines
  1. #
  2. # Modified version of the standard Tcl auto_load_index proc that calls a TclX
  3. # command load TclX .tndx library indices. 
  4. #
  5. # $Id: autoload.tcl,v 8.3.2.4 1998/12/05 20:50:51 markd Exp $
  6. # from Tcl: init.tcl,v 1.22 1998/11/12 05:54:02 welch Exp 
  7. #
  8.  
  9. # init.tcl --
  10. #
  11. # Default system startup file for Tcl-based applications.  Defines
  12. # "unknown" procedure and auto-load facilities.
  13. #
  14. # Copyright (c) 1991-1993 The Regents of the University of California.
  15. # Copyright (c) 1994-1996 Sun Microsystems, Inc.
  16. #
  17. # See the file "license.terms" for information on usage and redistribution
  18. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  19. #
  20.  
  21.  
  22. # auto_load_index --
  23. # Loads the contents of tclIndex files on the auto_path directory
  24. # list.  This is usually invoked within auto_load to load the index
  25. # of available commands.  Returns 1 if the index is loaded, and 0 if
  26. # the index is already loaded and up to date.
  27. #
  28. # Arguments: 
  29. # None.
  30.  
  31. proc auto_load_index {} {
  32.     global auto_index auto_oldpath auto_path errorInfo errorCode
  33.  
  34.     if {[info exists auto_oldpath]} {
  35.     if {$auto_oldpath == $auto_path} {
  36.         return 0
  37.     }
  38.     }
  39.     set auto_oldpath $auto_path
  40.  
  41.     # Check if we are a safe interpreter. In that case, we support only
  42.     # newer format tclIndex files.
  43.  
  44.     set issafe [interp issafe]
  45.     for {set i [expr {[llength $auto_path] - 1}]} {$i >= 0} {incr i -1} {
  46.     set dir [lindex $auto_path $i]
  47.         tclx_load_tndxs $dir
  48.     set f ""
  49.     if {$issafe} {
  50.         catch {source [file join $dir tclIndex]}
  51.     } elseif {[catch {set f [open [file join $dir tclIndex]]}]} {
  52.         continue
  53.     } else {
  54.         set error [catch {
  55.         set id [gets $f]
  56.         if {$id == "# Tcl autoload index file, version 2.0"} {
  57.             eval [read $f]
  58.         } elseif {$id == \
  59.             "# Tcl autoload index file: each line identifies a Tcl"} {
  60.             while {[gets $f line] >= 0} {
  61.             if {([string index $line 0] == "#")
  62.                 || ([llength $line] != 2)} {
  63.                 continue
  64.             }
  65.             set name [lindex $line 0]
  66.             set auto_index($name) \
  67.                 "source [file join $dir [lindex $line 1]]"
  68.             }
  69.         } else {
  70.             error \
  71.               "[file join $dir tclIndex] isn't a proper Tcl index file"
  72.         }
  73.         } msg]
  74.         if {$f != ""} {
  75.         close $f
  76.         }
  77.         if {$error} {
  78.         error $msg $errorInfo $errorCode
  79.         }
  80.     }
  81.     }
  82.     return 1
  83. }
  84.  
  85.