* tests/package.test:

* library/tclIndex:
* library/package.tcl: Added ::package namespace and
::package::create function.

* library/init.tcl: Fixed problem with auto_load and determining
if commands were loaded.

* library/auto.tcl: "Fixed" issues with $ in files to be auto indexed.

* doc/Package.n: New man page for package::create function.

* doc/pkgMkIndex.n: Added additional information.

* doc/library.n: Added additional qualification regarding auto_mkindex.

4 files changed, 168 insertions, 37 deletions

diff --git a/library/auto.tcl b/library/auto.tcl
index 07b3116..9575f7b 100644
--- a/library/auto.tcl
+++ b/library/auto.tcl
@@ -3,7 +3,7 @@
 # utility procs formerly in init.tcl dealing with auto execution
 # of commands and can be auto loaded themselves.
 #
-# RCS: @(#) $Id: auto.tcl,v 1.5 2000/01/28 16:38:34 ericm Exp $
+# RCS: @(#) $Id: auto.tcl,v 1.6 2000/02/01 01:14:01 ericm Exp $
 #
 # Copyright (c) 1991-1993 The Regents of the University of California.
 # Copyright (c) 1994-1998 Sun Microsystems, Inc.
@@ -318,13 +318,13 @@ proc auto_mkindex_parser::mkindex {file} {
     # There is one problem with sourcing files into the safe
     # interpreter:  references like "$x" will fail since code is not
     # really being executed and variables do not really exist.
-    # Be careful to escape all naked "$" before evaluating.
-    regsub -expanded -all {
-	([^\\](?:(?:\\\\)*)) # match any even number of backslashes ...
-	\$                   # ... followed by an unescaped dollar sign ...
-	([^\$])              # ... followed by anything but another dollar sign
-    } $contents {\1\\$\2} contents; # add one backslash for the dollar sign
-
+    # To avoid this, we replace all $ with \0 (literally, the null char)
+    # later, when getting proc names we will have to reverse this replacement,
+    # in case there were any $ in the proc name.  This will cause a problem
+    # if somebody actually tries to have a \0 in their proc name.  Too bad
+    # for them.
+    regsub -all {\$} $contents "\0" contents
+    
     set index ""
     set contextStack ""
     set imports ""
@@ -466,10 +466,14 @@ proc auto_mkindex_parser::fullname {name} {
     }
 
     if {[string equal [namespace qualifiers $name] ""]} {
-        return [namespace tail $name]
+        set name [namespace tail $name]
     } elseif {![string match ::* $name]} {
-        return "::$name"
+        set name "::$name"
     }
+    
+    # Earlier, mkindex replaced all $'s with \0.  Now, we have to reverse
+    # that replacement.
+    regsub -all "\0" $name "\$" name
     return $name
 }
 
diff --git a/library/init.tcl b/library/init.tcl
index c5fff21..ecc926f 100644
--- a/library/init.tcl
+++ b/library/init.tcl
@@ -3,7 +3,7 @@
 # Default system startup file for Tcl-based applications.  Defines
 # "unknown" procedure and auto-load facilities.
 #
-# RCS: @(#) $Id: init.tcl,v 1.37 2000/01/29 00:12:46 ericm Exp $
+# RCS: @(#) $Id: init.tcl,v 1.38 2000/02/01 01:14:01 ericm Exp $
 #
 # Copyright (c) 1991-1993 The Regents of the University of California.
 # Copyright (c) 1994-1996 Sun Microsystems, Inc.
@@ -312,10 +312,10 @@ proc auto_load {cmd {namespace {}}} {
 	    # name.  One is to use
 	    #    info commands $name
 	    # Unfortunately, if the name has glob-magic chars in it like *
-	    # or [], it may not match.  Since we really want an exact match,
-	    # a better route is to use 
-	    #    lsearch -exact [info commands] $name
-	    if {[lsearch -exact [info commands] $name] != -1 } {
+	    # or [], it may not match.  For our purposes here, a better
+	    # route is to use 
+	    #    namespace which -command $name
+	    if { ![string equal [namespace which -command $name] ""] } {
 		return 1
 	    }
 	}
diff --git a/library/package.tcl b/library/package.tcl
index c9506a8..c1f8415 100644
--- a/library/package.tcl
+++ b/library/package.tcl
@@ -3,7 +3,7 @@
 # utility procs formerly in init.tcl which can be loaded on demand
 # for package management.
 #
-# RCS: @(#) $Id: package.tcl,v 1.9 2000/01/28 19:32:05 ericm Exp $
+# RCS: @(#) $Id: package.tcl,v 1.10 2000/02/01 01:14:01 ericm Exp $
 #
 # Copyright (c) 1991-1993 The Regents of the University of California.
 # Copyright (c) 1994-1998 Sun Microsystems, Inc.
@@ -12,6 +12,10 @@
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
 
+# Create the package namespace
+namespace eval ::package {
+}
+
 # pkg_compareExtension --
 #
 #  Used internally by pkg_mkIndex to compare the extension of a file to
@@ -116,15 +120,6 @@ proc pkg_mkIndex {args} {
 	set patternList [list "*.tcl" "*[info sharedlibextension]"]
     }
 
-    append index "# Tcl package index file, version 1.1\n"
-    append index "# This file is generated by the \"pkg_mkIndex$more\" command\n"
-    append index "# and sourced either when an application starts up or\n"
-    append index "# by a \"package unknown\" script.  It invokes the\n"
-    append index "# \"package ifneeded\" command to set up package-related\n"
-    append index "# information so that packages will be loaded automatically\n"
-    append index "# in response to \"package require\" commands.  When this\n"
-    append index "# script is sourced, the variable \$dir must contain the\n"
-    append index "# full path name of this file's directory.\n"
     set oldDir [pwd]
     cd $dir
 
@@ -350,22 +345,33 @@ proc pkg_mkIndex {args} {
 	}
     }
 
+    append index "# Tcl package index file, version 1.1\n"
+    append index "# This file is generated by the \"pkg_mkIndex$more\" command\n"
+    append index "# and sourced either when an application starts up or\n"
+    append index "# by a \"package unknown\" script.  It invokes the\n"
+    append index "# \"package ifneeded\" command to set up package-related\n"
+    append index "# information so that packages will be loaded automatically\n"
+    append index "# in response to \"package require\" commands.  When this\n"
+    append index "# script is sourced, the variable \$dir must contain the\n"
+    append index "# full path name of this file's directory.\n"
+
     foreach pkg [lsort [array names files]] {
-	append index "\npackage ifneeded $pkg "
-	if {$direct} {
-	    set cmdList {}
-	    foreach elem $files($pkg) {
-		set file [lindex $elem 0]
-		set type [lindex $elem 1]
-		lappend cmdList "\[list $type \[file join \$dir\
-			[list $file]\]\]"
+	set cmd {}
+	foreach {name version} $pkg {
+	    break
+	}
+	lappend cmd ::package::create -name $name -version $version
+	foreach spec $files($pkg) {
+	    foreach {file type procs} $spec {
+		if { $direct } {
+		    set procs {}
+		}
+		lappend cmd "-$type" [list $file $procs]
 	    }
-	    append index [join $cmdList "\\n"]
-	} else {
-	    append index "\[list tclPkgSetup \$dir [lrange $pkg 0 0]\
-		    [lrange $pkg 1 1] [list $files($pkg)]\]"
 	}
+	append index "\n[eval $cmd]"
     }
+
     set f [open pkgIndex.tcl w]
     puts $f $index
     close $f
@@ -481,3 +487,123 @@ proc tclPkgUnknown {name version {exact {}}} {
 	}
     }
 }
+
+# ::package::create --
+#
+#	Given a package specification generate a "package ifneeded" statement
+#	for the package, suitable for inclusion in a pkgIndex.tcl file.
+#
+# Arguments:
+#	args		arguments used by the create function:
+#			-name		packageName
+#			-version	packageVersion
+#			-load		{filename ?{procs}?}
+#			...
+#			-source		{filename ?{procs}?}
+#			...
+#
+#			Any number of -load and -source parameters may be
+#			specified, so long as there is at least one -load or
+#			-source parameter.  If the procs component of a 
+#			module specifier is left off, that module will be
+#			set up for direct loading; otherwise, it will be
+#			set up for lazy loading.  If both -source and -load
+#			are specified, the -load'ed files will be loaded 
+#			first, followed by the -source'd files.
+#
+# Results:
+#	An appropriate "package ifneeded" statement for the package.
+
+proc ::package::create {args} {
+    append err(usage) "::package::create "
+    append err(usage) "-name packageName -version packageVersion"
+    append err(usage) "?-load {filename ?{procs}?}? ... "
+    append err(usage) "?-source {filename ?{procs}?}? ..."
+
+    set err(wrongNumArgs) "wrong # args: should be \"$err(usage)\""
+    set err(valueMissing) "value for \"%s\" missing: should be \"$err(usage)\""
+    set err(unknownOpt)   "unknown option \"%s\": should be \"$err(usage)\""
+    set err(noLoadOrSource) "at least one of -load and -source must be given"
+
+    # process arguments
+    set len [llength $args]
+    if { $len < 6 } {
+	error $err(wrongNumArgs)
+    }
+    
+    # Initialize parameters
+    set opts(-name)		{}
+    set opts(-version)		{}
+    set opts(-source)		{}
+    set opts(-load)		{}
+
+    # process parameters
+    for {set i 0} {$i < $len} {incr i} {
+	set flag [lindex $args $i]
+	incr i
+	switch -glob -- $flag {
+	    "-name"		-
+	    "-version"		{
+		if { $i >= $len } {
+		    error [format $err(valueMissing) $flag]
+		}
+		set opts($flag) [lindex $args $i]
+	    }
+	    "-source"		-
+	    "-load"		{
+		if { $i >= $len } {
+		    error [format $err(valueMissing) $flag]
+		}
+		lappend opts($flag) [lindex $args $i]
+	    }
+	    default {
+		error [format $err(unknownOpt) [lindex $args $i]]
+	    }
+	}
+    }
+
+    # Validate the parameters
+    if { [llength $opts(-name)] == 0 } {
+	error [format $err(valueMissing) "-name"]
+    }
+    if { [llength $opts(-version)] == 0 } {
+	error [format $err(valueMissing) "-version"]
+    }
+    
+    if { [llength $opts(-source)] == 0 && [llength $opts(-load)] == 0 } {
+	error $err(noLoadOrSource)
+    }
+
+    # OK, now everything is good.  Generate the package ifneeded statment.
+    set cmdline "package ifneeded $opts(-name) $opts(-version) "
+    
+    set cmdList {}
+    set lazyFileList {}
+
+    # Handle -load and -source specs
+    foreach key {load source} {
+	foreach filespec $opts(-$key) {
+	    foreach {filename proclist} {{} {}} {
+		break
+	    }
+	    foreach {filename proclist} $filespec {
+		break
+	    }
+	    
+	    if { [llength $proclist] == 0 } {
+		set cmd "\[list $key \[file join \$dir [list $filename]\]\]"
+		lappend cmdList $cmd
+	    } else {
+		lappend lazyFileList [list $filename $key $proclist]
+	    }
+	}
+    }
+
+    if { [llength $lazyFileList] > 0 } {
+	lappend cmdList "\[list tclPkgSetup \$dir $opts(-name)\
+		$opts(-version) [list $lazyFileList]\]"
+    }
+    append cmdline [join $cmdList "\\n"]
+    return $cmdline
+}
+
diff --git a/library/tclIndex b/library/tclIndex
index 35c7cf6..92500b2 100644
--- a/library/tclIndex
+++ b/library/tclIndex
@@ -33,6 +33,7 @@ set auto_index(pkg_mkIndex) [list source [file join $dir package.tcl]]
 set auto_index(tclPkgSetup) [list source [file join $dir package.tcl]]
 set auto_index(tclMacPkgSearch) [list source [file join $dir package.tcl]]
 set auto_index(tclPkgUnknown) [list source [file join $dir package.tcl]]
+set auto_index(::package::create) [list source [file join $dir package.tcl]]
 set auto_index(parray) [list source [file join $dir parray.tcl]]
 set auto_index(::safe::InterpStatics) [list source [file join $dir safe.tcl]]
 set auto_index(::safe::InterpNested) [list source [file join $dir safe.tcl]]