Richard Suchenwirth 2002-04-15 - In my simple ways of Tcl programming, I have never before created a package. However, as I will have to teach Tcl programming, I finally could not avoid this point - and as usual with Tcl, it was little hassle but fun ;-) . The following script creates the trivial but educational package futil, which in a namespace of the same name implements two procs for reading and writing complete text files, and the little introspection helper function, futil::?. The command to register the package (package provide) is executed only after all went well - this way, buggy source code, which raises an error during package require, will not be registered. (Other bugs you'd have to spot and fix for yourself...)
Common Tcl distribution practice has the good habit of profound testing, typically in a separate test directory. On the other hand, including a self-test in the same file with the code makes editing easier, so after the package provide comes a section only executed if this file is sourced as a top- level script, which exercises the commands defined in futil. Whether the string read should be equal to the string written is debatable - the present implementation appends \n to the string if it doesn't end in one, because some tools complain or misbehave if they don't see a final newline.
If the tests do not run into an error either, even the required construction of a package index is fired - assuming the simplified case that the directory contains only one package. Otherwise, you'd better remove these lines, and take care of index creation yourself.
A script that uses this package will only have to contain the two lines
lappend ::auto_path <directory of this file> package require futil
You can even omit the first line, if you install (copy) the directory with the source and pkgIndex.tcl below ${tcl_install_directory}/lib.
namespace eval futil {
set version 0.1
}
proc futil::read {filename} {
set fp [open $filename]
set string [::read $fp] ;# prevent name conflict with itself
close $fp
return $string
}
proc futil::write {filename string} {
set fp [open $filename w]
if {[string index $string end]!="\n"} {append string \n}
puts -nonewline $fp $string
close $fp
}
proc futil::? {} {lsort [info procs ::futil::*]}
# If execution comes this far, we have succeeded ;-)
package provide futil $futil::version
#--------------------------- Self-test code
if {[info ex argv0] && [file tail [info script]] == [file tail $argv0]} {
puts "package futil contains [futil::?]"
set teststring {
This is a teststring
in several lines...}
puts teststring:'$teststring'
futil::write test.tmp $teststring
set string2 [futil::read test.tmp]
puts string2:'$string2'
puts "strings are [expr {$teststring==$string2? {}:{not}}] equal"
file delete test.tmp ;# don't leave traces of testing
# Simple index generator, if the directory contains only this package
pkg_mkIndex -verbose [file dirn [info scr]] [file tail [info scr]]
}