Tcl Source Code

# init.tcl --
#
# Default system startup file for Tcl-based applications.  Defines
# "unknown" procedure and auto-load facilities.
#
# RCS: @(#) $Id: init.tcl,v 1.26 1999/02/11 03:04:46 stanton Exp $
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
................................................................................
	    }
	}
    }
    return 1
}

# auto_qualify --

# compute a fully qualified names list for use in the auto_index array.
# For historical reasons, commands in the global namespace do not have leading
# :: in the index key. The list has two elements when the command name is
# relative (no leading ::) and the namespace is not the global one. Otherwise
# only one name is returned (and searched in the auto_index).
#
# Arguments -
................................................................................
	    # ( foo::bar , ::sub ) -> ::sub::foo::bar ::foo::bar
	    return [list ${namespace}::$cmd ::$cmd]
	}
    }
}

# auto_import --

# invoked during "namespace import" to make see if the imported commands
# reside in an autoloaded library.  If so, the commands are loaded so
# that they will be available for the import links.  If not, then this
# procedure does nothing.
#
# Arguments -
# pattern	The pattern of commands being imported (like "foo::*")
................................................................................
	    return $auto_execs($name)
	}
    }
    return ""
}

}




# auto_reset --

# Destroy all cached information for auto-loading and auto-execution,
# so that the information gets recomputed the next time it's needed.
# Also delete any procedures that are listed in the auto-load index
# except those defined in this file.
#
# Arguments: 
# None.
................................................................................
	}
    }
    catch {unset auto_execs}
    catch {unset auto_index}
    catch {unset auto_oldpath}
}

# tcl_findLibrary

#	This is a utility for extensions that searches for a library directory
#	using a canonical searching algorithm. A side effect is to source
#	the initialization script and set a global library variable.

# Arguments:
# 	basename	Prefix of the directory name, (e.g., "tk")
#	version		Version number of the package, (e.g., "8.0")
#	patch		Patchlevel of the package, (e.g., "8.0.3")
#	initScript	Initialization script to source (e.g., tk.tcl)
#	enVarName	environment variable to honor (e.g., TK_LIBRARY)
#	varName		Global variable to set when done (e.g., tk_library)
................................................................................
    append msg "    $dirs\n\n"
    append msg "$errors\n\n"
    append msg "This probably means that $basename wasn't installed properly.\n"
    error $msg
}


# OPTIONAL SUPPORT PROCEDURES
# In Tcl 8.1 all the code below here has been moved to other files to
# reduce the size of init.tcl

# ----------------------------------------------------------------------
# auto_mkindex
# ----------------------------------------------------------------------
# The following procedures are used to generate the tclIndex file
# from Tcl source files.  They use a special safe interpreter to
# parse Tcl source files, writing out index entries as "proc"
# commands are encountered.  This implementation won't work in a
................................................................................
		$parser hide proc
		$parser hide namespace
		$parser hide eval
		$parser hide puts
		$parser invokehidden namespace delete ::
		$parser invokehidden proc unknown {args} {}

		#
		# We'll need access to the "namespace" command within the
		# interp.  Put it back, but move it out of the way.
		#
		$parser expose namespace
		$parser invokehidden rename namespace _%@namespace
		$parser expose eval
		$parser invokehidden rename eval _%@eval

		# Install all the registered psuedo-command implementations

................................................................................
	    variable parser
	    interp delete $parser
	    unset parser
	}
    }

    # auto_mkindex_parser::mkindex --

    # Used by the "auto_mkindex" command to create a "tclIndex" file for
    # the given Tcl source file.  Executes the commands in the file, and
    # handles things like the "proc" command by adding an entry for the
    # index file.  Returns a string that represents the index file.
    #
    # Arguments: 
    # file -		Name of Tcl source file to be indexed.

    proc auto_mkindex_parser::mkindex {file} {
	variable parser
	variable index
	variable scriptFile
	variable contextStack
	variable imports
................................................................................
	foreach name $imports {
	    catch {$parser eval [list _%@namespace forget $name]}
	}
	return $index
    }

    # auto_mkindex_parser::hook command

    # Registers a Tcl command to evaluate when initializing the
    # slave interpreter used by the mkindex parser.
    # The command is evaluated in the master interpreter, and can
    # use the variable auto_mkindex_parser::parser to get to the slave

    proc auto_mkindex_parser::hook {cmd} {
	variable initCommands

	lappend initCommands $cmd
    }

    # auto_mkindex_parser::slavehook command

    # Registers a Tcl command to evaluate when initializing the
    # slave interpreter used by the mkindex parser.
    # The command is evaluated in the slave interpreter.

    proc auto_mkindex_parser::slavehook {cmd} {
	variable initCommands




	lappend initCommands [list \$parser eval $cmd]
    }

    # auto_mkindex_parser::command --

    # Registers a new command with the "auto_mkindex_parser" interpreter
    # that parses Tcl files.  These commands are fake versions of things
    # like the "proc" command.  When you execute them, they simply write
    # out an entry to a "tclIndex" file for auto-loading.
    #
    # This procedure allows extensions to register their own commands
    # with the auto_mkindex facility.  For example, a package like
    # [incr Tcl] might register a "class" command so that class definitions
    # could be added to a "tclIndex" file for auto-loading.
    #
    # Arguments:
    # name -		Name of command recognized in Tcl files.
    # arglist -		Argument list for command.
    # body -		Implementation of command to handle indexing.

    proc auto_mkindex_parser::command {name arglist body} {
	hook [list auto_mkindex_parser::commandInit $name $arglist $body]
    }

    # auto_mkindex_parser::commandInit --

    # This does the actual work set up by auto_mkindex_parser::command
    # This is called when the interpreter used by the parser is created.






    proc auto_mkindex_parser::commandInit {name arglist body} {
	variable parser

	set ns [namespace qualifiers $name]
	set tail [namespace tail $name]
	if {$ns == ""} {
................................................................................
	} else {
	    set fakeName "_%@fake_$name"
	    regsub -all {::} $fakeName "_" fakeName
	    set fakeName "[namespace current]::$fakeName"
	}
	proc $fakeName $arglist $body

	#
	# YUK!  Tcl won't let us alias fully qualified command names,
	# so we can't handle names like "::itcl::class".  Instead,
	# we have to build procs with the fully qualified names, and
	# have the procs point to the aliases.
	#
	if {[regexp {::} $name]} {
	    set exportCmd [list _%@namespace export [namespace tail $name]]
	    $parser eval [list _%@namespace eval $ns $exportCmd]
	    set alias [namespace tail $fakeName]












	    $parser invokehidden proc $name {args} [list _%@eval $alias \$args]
	    $parser alias $alias $fakeName
	} else {
	    $parser alias $name $fakeName
	}
	return
    }

# init.tcl --
#
# Default system startup file for Tcl-based applications.  Defines
# "unknown" procedure and auto-load facilities.
#
# RCS: @(#) $Id: init.tcl,v 1.27 1999/03/31 18:58:14 welch Exp $
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
................................................................................
	    }
	}
    }
    return 1
}

# auto_qualify --
#
# compute a fully qualified names list for use in the auto_index array.
# For historical reasons, commands in the global namespace do not have leading
# :: in the index key. The list has two elements when the command name is
# relative (no leading ::) and the namespace is not the global one. Otherwise
# only one name is returned (and searched in the auto_index).
#
# Arguments -
................................................................................
	    # ( foo::bar , ::sub ) -> ::sub::foo::bar ::foo::bar
	    return [list ${namespace}::$cmd ::$cmd]
	}
    }
}

# auto_import --
#
# invoked during "namespace import" to make see if the imported commands
# reside in an autoloaded library.  If so, the commands are loaded so
# that they will be available for the import links.  If not, then this
# procedure does nothing.
#
# Arguments -
# pattern	The pattern of commands being imported (like "foo::*")
................................................................................
	    return $auto_execs($name)
	}
    }
    return ""
}

}
# OPTIONAL SUPPORT PROCEDURES
# In Tcl 8.1 all the code below here has been moved to other files to
# reduce the size of init.tcl

# auto_reset --
#
# Destroy all cached information for auto-loading and auto-execution,
# so that the information gets recomputed the next time it's needed.
# Also delete any procedures that are listed in the auto-load index
# except those defined in this file.
#
# Arguments: 
# None.
................................................................................
	}
    }
    catch {unset auto_execs}
    catch {unset auto_index}
    catch {unset auto_oldpath}
}

# tcl_findLibrary --
#
#	This is a utility for extensions that searches for a library directory
#	using a canonical searching algorithm. A side effect is to source
#	the initialization script and set a global library variable.
#
# Arguments:
# 	basename	Prefix of the directory name, (e.g., "tk")
#	version		Version number of the package, (e.g., "8.0")
#	patch		Patchlevel of the package, (e.g., "8.0.3")
#	initScript	Initialization script to source (e.g., tk.tcl)
#	enVarName	environment variable to honor (e.g., TK_LIBRARY)
#	varName		Global variable to set when done (e.g., tk_library)
................................................................................
    append msg "    $dirs\n\n"
    append msg "$errors\n\n"
    append msg "This probably means that $basename wasn't installed properly.\n"
    error $msg
}






# ----------------------------------------------------------------------
# auto_mkindex
# ----------------------------------------------------------------------
# The following procedures are used to generate the tclIndex file
# from Tcl source files.  They use a special safe interpreter to
# parse Tcl source files, writing out index entries as "proc"
# commands are encountered.  This implementation won't work in a
................................................................................
		$parser hide proc
		$parser hide namespace
		$parser hide eval
		$parser hide puts
		$parser invokehidden namespace delete ::
		$parser invokehidden proc unknown {args} {}


		# We'll need access to the "namespace" command within the
		# interp.  Put it back, but move it out of the way.

		$parser expose namespace
		$parser invokehidden rename namespace _%@namespace
		$parser expose eval
		$parser invokehidden rename eval _%@eval

		# Install all the registered psuedo-command implementations

................................................................................
	    variable parser
	    interp delete $parser
	    unset parser
	}
    }

    # auto_mkindex_parser::mkindex --
    #
    # Used by the "auto_mkindex" command to create a "tclIndex" file for
    # the given Tcl source file.  Executes the commands in the file, and
    # handles things like the "proc" command by adding an entry for the
    # index file.  Returns a string that represents the index file.
    #
    # Arguments: 
    #	file	Name of Tcl source file to be indexed.

    proc auto_mkindex_parser::mkindex {file} {
	variable parser
	variable index
	variable scriptFile
	variable contextStack
	variable imports
................................................................................
	foreach name $imports {
	    catch {$parser eval [list _%@namespace forget $name]}
	}
	return $index
    }

    # auto_mkindex_parser::hook command
    #
    # Registers a Tcl command to evaluate when initializing the
    # slave interpreter used by the mkindex parser.
    # The command is evaluated in the master interpreter, and can
    # use the variable auto_mkindex_parser::parser to get to the slave

    proc auto_mkindex_parser::hook {cmd} {
	variable initCommands

	lappend initCommands $cmd
    }

    # auto_mkindex_parser::slavehook command
    #
    # Registers a Tcl command to evaluate when initializing the
    # slave interpreter used by the mkindex parser.
    # The command is evaluated in the slave interpreter.

    proc auto_mkindex_parser::slavehook {cmd} {
	variable initCommands

	# The $parser variable is defined to be the name of the
	# slave interpreter when this command is used later.

	lappend initCommands "\$parser eval [list $cmd]"
    }

    # auto_mkindex_parser::command --
    #
    # Registers a new command with the "auto_mkindex_parser" interpreter
    # that parses Tcl files.  These commands are fake versions of things
    # like the "proc" command.  When you execute them, they simply write
    # out an entry to a "tclIndex" file for auto-loading.
    #
    # This procedure allows extensions to register their own commands
    # with the auto_mkindex facility.  For example, a package like
    # [incr Tcl] might register a "class" command so that class definitions
    # could be added to a "tclIndex" file for auto-loading.
    #
    # Arguments:
    #	name 	Name of command recognized in Tcl files.
    #	arglist	Argument list for command.
    #	body 	Implementation of command to handle indexing.

    proc auto_mkindex_parser::command {name arglist body} {
	hook [list auto_mkindex_parser::commandInit $name $arglist $body]
    }

    # auto_mkindex_parser::commandInit --
    #
    # This does the actual work set up by auto_mkindex_parser::command
    # This is called when the interpreter used by the parser is created.
    #
    # Arguments:
    #	name 	Name of command recognized in Tcl files.
    #	arglist	Argument list for command.
    #	body 	Implementation of command to handle indexing.

    proc auto_mkindex_parser::commandInit {name arglist body} {
	variable parser

	set ns [namespace qualifiers $name]
	set tail [namespace tail $name]
	if {$ns == ""} {
................................................................................
	} else {
	    set fakeName "_%@fake_$name"
	    regsub -all {::} $fakeName "_" fakeName
	    set fakeName "[namespace current]::$fakeName"
	}
	proc $fakeName $arglist $body


	# YUK!  Tcl won't let us alias fully qualified command names,
	# so we can't handle names like "::itcl::class".  Instead,
	# we have to build procs with the fully qualified names, and
	# have the procs point to the aliases.

	if {[regexp {::} $name]} {
	    set exportCmd [list _%@namespace export [namespace tail $name]]
	    $parser eval [list _%@namespace eval $ns $exportCmd]
	    set alias [namespace tail $fakeName]

	    # The following proc definition does not work if you
	    # want to tolerate space or something else diabolical
	    # in the procedure name, (i.e., space in $alias)
	    # The following does not work:
	    # 	"_%@eval {$alias} \$args"
	    # because $alias gets concat'ed to $args.
	    # The following does not work because $cmd is somehow undefined
	    #	"set cmd {$alias} \; _%@eval {\$cmd} \$args"
	    # A gold star to someone that can make test
	    # autoMkindex-3.3 work properly

	    $parser invokehidden proc $name {args} "_%@eval {$alias} \$args"
	    $parser alias $alias $fakeName
	} else {
	    $parser alias $name $fakeName
	}
	return
    }