home *** CD-ROM | disk | FTP | other *** search
/ PC World 2002 May / PCWorld_2002-05_cd.bin / Software / TemaCD / activetcltk / ActiveTcl8.3.4.1-8.win32-ix86.exe / ActiveTcl8.3.4.1-win32-ix86 / lib / tclX8.3 / autoload.tcl next >
Encoding:
Text File  |  2001-10-22  |  2.2 KB  |  83 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.6 1999/03/31 06:11:01 markd Exp $
  6. # from Tcl: init.tcl,v 1.1.2.4 1998/12/02 20:08:05 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. # auto_load_index --
  22. # Loads the contents of tclIndex files on the auto_path directory
  23. # list.  This is usually invoked within auto_load to load the index
  24. # of available commands.  Returns 1 if the index is loaded, and 0 if
  25. # the index is already loaded and up to date.
  26. #
  27. # Arguments: 
  28. # None.
  29.  
  30. proc auto_load_index {} {
  31.     global auto_index auto_oldpath auto_path errorInfo errorCode
  32.  
  33.     if {[info exists auto_oldpath]} {
  34.     if {$auto_oldpath == $auto_path} {
  35.         return 0
  36.     }
  37.     }
  38.     set auto_oldpath $auto_path
  39.  
  40.     # Check if we are a safe interpreter. In that case, we support only
  41.     # newer format tclIndex files.
  42.  
  43.     set issafe [interp issafe]
  44.     for {set i [expr {[llength $auto_path] - 1}]} {$i >= 0} {incr i -1} {
  45.     set dir [lindex $auto_path $i]
  46.         tclx_load_tndxs $dir
  47.     set f ""
  48.     if {$issafe} {
  49.         catch {source [file join $dir tclIndex]}
  50.     } elseif {[catch {set f [open [file join $dir tclIndex]]}]} {
  51.         continue
  52.     } else {
  53.         set error [catch {
  54.         set id [gets $f]
  55.         if {$id == "# Tcl autoload index file, version 2.0"} {
  56.             eval [read $f]
  57.         } elseif {$id == \
  58.             "# Tcl autoload index file: each line identifies a Tcl"} {
  59.             while {[gets $f line] >= 0} {
  60.             if {([string index $line 0] == "#")
  61.                 || ([llength $line] != 2)} {
  62.                 continue
  63.             }
  64.             set name [lindex $line 0]
  65.             set auto_index($name) \
  66.                 "source [file join $dir [lindex $line 1]]"
  67.             }
  68.         } else {
  69.             error \
  70.               "[file join $dir tclIndex] isn't a proper Tcl index file"
  71.         }
  72.         } msg]
  73.         if {$f != ""} {
  74.         close $f
  75.         }
  76.         if {$error} {
  77.         error $msg $errorInfo $errorCode
  78.         }
  79.     }
  80.     }
  81.     return 1
  82. }
  83.