Tcl Source Code

\fBtcl_findLibrary \fIbasename version patch initScript enVarName varName\fR
\fBparray \fIarrayName\fR ?\fIpattern\fR?
\fBtcl_endOfWord \fIstr start\fR
\fBtcl_startOfNextWord \fIstr start\fR
\fBtcl_startOfPreviousWord \fIstr start\fR
\fBtcl_wordBreakAfter \fIstr start\fR
\fBtcl_wordBreakBefore \fIstr start\fR
.VS "Tcl 8.7, TIP 670"
\fBforeachLine \fIfilename varName body\fR
\fBreadFile \fIfilename\fR ?\fBtext\fR|\fBbinary\fR?
\fBwriteFile \fIfilename\fR ?\fBtext\fR|\fBbinary\fR? \fIcontents\fR
.VE "Tcl 8.7, TIP 670"
.BE
.SH INTRODUCTION
.PP
Tcl includes a library of Tcl procedures for commonly-needed functions.
The procedures defined in the Tcl library are generic ones suitable
for use by many different applications.
The location of the Tcl library is returned by the \fBinfo library\fR

.TP
\fBtcl_wordBreakBefore \fIstr start\fR
Returns the index of the first word boundary before the starting index
\fIstart\fR in the string \fIstr\fR.  Returns \-1 if there are no more
boundaries before the starting point in the given string.  The index
returned refers to the second character of the pair that comprises a
boundary.
.TP
\fBforeachLine \fIvarName filename body\fR
.VS "Tcl 8.7, TIP 670"
This reads in the text file named \fIfilename\fR one line at a time
(using system defaults for reading text files). It writes that line to the
variable named by \fIvarName\fR and then executes \fIbody\fR for that line.
The result value of \fIbody\fR is ignored, but \fBerror\fR, \fBreturn\fR,
\fBbreak\fR and \fBcontinue\fR may be used within it to produce an error,
return from the calling context, stop the loop, or go to the next line
respectively.
The overall result of \fBforeachLine\fR is the empty string (assuming no
errors from I/O or from evaluating the body of the loop); the file will be
closed prior to the procedure returning.
.VE "Tcl 8.7, TIP 670"
.TP
\fBreadFile \fIfilename\fR ?\fBtext\fR|\fBbinary\fR?
.VS "Tcl 8.7, TIP 670"
Reads in the file named in \fIfilename\fR and returns its contents.
The second argument says how to read in the file, either as \fBtext\fR
(using the system defaults for reading text files) or as \fBbinary\fR
(as uninterpreted bytes). The default is \fBtext\fR. When read as text, this
will include any trailing newline.
The file will be closed prior to the procedure returning.
.VE "Tcl 8.7, TIP 670"
.TP
\fBwriteFile \fIfilename\fR ?\fBtext\fR|\fBbinary\fR? \fIcontents\fR
.VS "Tcl 8.7, TIP 670"
Writes the \fIcontents\fR to the file named in \fIfilename\fR.
The optional second argument says how to write to the file, either as
\fBtext\fR (using the system defaults for writing text files) or as
\fBbinary\fR (as uninterpreted bytes). The default is \fBtext\fR.
If a trailing newline is required, it will need to be provided in
\fIcontents\fR. The result of this command is the empty string; the file will
be closed prior to the procedure returning.
.VE "Tcl 8.7, TIP 670"
.SH "VARIABLES"
.PP
The following global variables are defined or used by the procedures in
the Tcl library. They fall into two broad classes, handling unknown
commands and packages, and determining what are words.
.SS "AUTOLOADING AND PACKAGE MANAGEMENT VARIABLES"
.TP

# foreachLine:
# Iterate over the contents of a file, a line at a time.
# The body script is run for each, with variable varName set to the line
# contents.
#
# Copyright © 2023 Donal K Fellows.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

proc foreachLine {varName filename body} {
    upvar 1 $varName line
    set f [open $filename "r"]
    try {
	while {[gets $f line] >= 0} {
	    uplevel 1 $body
	}
    } on return {msg opt} {
	dict incr opt -level
	return -options $opt $msg
    } finally {
	close $f
    }
}

# readFile:
# Read the contents of a file.
#
# Copyright © 2023 Donal K Fellows.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

proc readFile {filename {mode text}} {
    # Parse the arguments
    set MODES {binary text}
    set ERR [list -level 1 -errorcode [list TCL LOOKUP MODE $mode]]
    set mode [tcl::prefix match -message "mode" -error $ERR $MODES $mode]

    # Read the file
    set f [open $filename [dict get {text r binary rb} $mode]]
    try {
	return [read $f]
    } finally {
	close $f
    }
}

set auto_index(::auto_mkindex_parser::cleanup) [list ::tcl::Pkg::source [file join $dir auto.tcl]]
set auto_index(::auto_mkindex_parser::mkindex) [list ::tcl::Pkg::source [file join $dir auto.tcl]]
set auto_index(::auto_mkindex_parser::hook) [list ::tcl::Pkg::source [file join $dir auto.tcl]]
set auto_index(::auto_mkindex_parser::childhook) [list ::tcl::Pkg::source [file join $dir auto.tcl]]
set auto_index(::auto_mkindex_parser::command) [list ::tcl::Pkg::source [file join $dir auto.tcl]]
set auto_index(::auto_mkindex_parser::commandInit) [list ::tcl::Pkg::source [file join $dir auto.tcl]]
set auto_index(::auto_mkindex_parser::fullname) [list ::tcl::Pkg::source [file join $dir auto.tcl]]
set auto_index(foreachLine) [list ::tcl::Pkg::source [file join $dir foreachline.tcl]]
set auto_index(history) [list ::tcl::Pkg::source [file join $dir history.tcl]]
set auto_index(::tcl::HistAdd) [list ::tcl::Pkg::source [file join $dir history.tcl]]
set auto_index(::tcl::HistKeep) [list ::tcl::Pkg::source [file join $dir history.tcl]]
set auto_index(::tcl::HistClear) [list ::tcl::Pkg::source [file join $dir history.tcl]]
set auto_index(::tcl::HistInfo) [list ::tcl::Pkg::source [file join $dir history.tcl]]
set auto_index(::tcl::HistRedo) [list ::tcl::Pkg::source [file join $dir history.tcl]]
set auto_index(::tcl::HistIndex) [list ::tcl::Pkg::source [file join $dir history.tcl]]
set auto_index(::tcl::HistEvent) [list ::tcl::Pkg::source [file join $dir history.tcl]]
set auto_index(::tcl::HistChange) [list ::tcl::Pkg::source [file join $dir history.tcl]]
set auto_index(pkg_mkIndex) [list ::tcl::Pkg::source [file join $dir package.tcl]]
set auto_index(tclPkgSetup) [list ::tcl::Pkg::source [file join $dir package.tcl]]
set auto_index(tclPkgUnknown) [list ::tcl::Pkg::source [file join $dir package.tcl]]
set auto_index(::tcl::MacOSXPkgUnknown) [list ::tcl::Pkg::source [file join $dir package.tcl]]
set auto_index(::pkg::create) [list ::tcl::Pkg::source [file join $dir package.tcl]]
set auto_index(parray) [list ::tcl::Pkg::source [file join $dir parray.tcl]]
set auto_index(readFile) [list ::tcl::Pkg::source [file join $dir readfile.tcl]]
set auto_index(::safe::InterpStatics) [list ::tcl::Pkg::source [file join $dir safe.tcl]]
set auto_index(::safe::InterpNested) [list ::tcl::Pkg::source [file join $dir safe.tcl]]
set auto_index(::safe::interpCreate) [list ::tcl::Pkg::source [file join $dir safe.tcl]]
set auto_index(::safe::interpInit) [list ::tcl::Pkg::source [file join $dir safe.tcl]]
set auto_index(::safe::CheckInterp) [list ::tcl::Pkg::source [file join $dir safe.tcl]]
set auto_index(::safe::interpConfigure) [list ::tcl::Pkg::source [file join $dir safe.tcl]]
set auto_index(::safe::InterpCreate) [list ::tcl::Pkg::source [file join $dir safe.tcl]]

set auto_index(::safe::AliasEncoding) [list ::tcl::Pkg::source [file join $dir safe.tcl]]
set auto_index(::safe::setSyncMode) [list ::tcl::Pkg::source [file join $dir safe.tcl]]
set auto_index(tcl_wordBreakAfter) [list ::tcl::Pkg::source [file join $dir word.tcl]]
set auto_index(tcl_wordBreakBefore) [list ::tcl::Pkg::source [file join $dir word.tcl]]
set auto_index(tcl_endOfWord) [list ::tcl::Pkg::source [file join $dir word.tcl]]
set auto_index(tcl_startOfNextWord) [list ::tcl::Pkg::source [file join $dir word.tcl]]
set auto_index(tcl_startOfPreviousWord) [list ::tcl::Pkg::source [file join $dir word.tcl]]
set auto_index(writeFile) [list ::tcl::Pkg::source [file join $dir writefile.tcl]]
set auto_index(::tcl::tm::add) [list ::tcl::Pkg::source [file join $dir tm.tcl]]
set auto_index(::tcl::tm::remove) [list ::tcl::Pkg::source [file join $dir tm.tcl]]
set auto_index(::tcl::tm::list) [list ::tcl::Pkg::source [file join $dir tm.tcl]]
set auto_index(::tcl::tm::Defaults) [list ::tcl::Pkg::source [file join $dir tm.tcl]]
set auto_index(::tcl::tm::UnknownHandler) [list ::tcl::Pkg::source [file join $dir tm.tcl]]
set auto_index(::tcl::tm::roots) [list ::tcl::Pkg::source [file join $dir tm.tcl]]
set auto_index(::tcl::tm::path) [list ::tcl::Pkg::source [file join $dir tm.tcl]]

# writeFile:
# Write the contents of a file.
#
# Copyright © 2023 Donal K Fellows.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

proc writeFile {args} {
    # Parse the arguments
    switch [llength $args] {
	2 {
	    lassign $args filename data
	    set mode text
	}
	3 {
	    lassign $args filename mode data
	    set MODES {binary text}
	    set ERR [list -level 1 -errorcode [list TCL LOOKUP MODE $mode]]
	    set mode [tcl::prefix match -message "mode" -error $ERR $MODES $mode]
	}
	default {
	    set COMMAND [lindex [info level 0] 0]
	    return -code error -errorcode {TCL WRONGARGS} \
		"wrong # args: should be \"$COMMAND filename ?mode? data\""
	}
    }

    # Write the file
    set f [open $filename [dict get {text w binary wb} $mode]]
    try {
	puts -nonewline $f $data
    } finally {
	close $f
    }
}

# -*- tcl -*-
# Commands covered: open, close, gets, read, puts, seek, tell, eof, flush,
#		    fblocked, fconfigure, open, channel, fcopy,
#		    readFile, writeFile, foreachLine
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright © 1991-1994 The Regents of the University of California.
# Copyright © 1994-1996 Sun Microsystems, Inc.

    catch {thread::release $tida}
    thread::release $tidb
    set res
} -constraints {testchannel thread notValgrind} \
    -result {Owner lost}

# Tests of readFile

set BIN_DATA "\u0000\u0001\u0002\u0003\u0004\u001a\u001b\u000d\u000a\u0000"

test iocmd.readFile-1.1 "readFile procedure: syntax" -body {
    readFile
} -returnCodes error -result {wrong # args: should be "readFile filename ?mode?"}
test iocmd.readFile-1.2 "readFile procedure: syntax" -body {
    readFile a b c
} -returnCodes error -result {wrong # args: should be "readFile filename ?mode?"}
test iocmd.readFile-1.3 "readFile procedure: syntax" -body {
    readFile gorp gorp2
} -returnCodes error -result {bad mode "gorp2": must be binary or text}

test iocmd.readFile-2.1 "readFile procedure: behaviour" -setup {
    set f [makeFile readFile21.txt "File\nContents"]
} -body {
    readFile $f
} -cleanup {
    removeFile $f
} -result "File\nContents\n"
test iocmd.readFile-2.2 "readFile procedure: behaviour" -setup {
    set f [makeFile readFile22.txt "File\nContents"]
} -body {
    readFile $f text
} -cleanup {
    removeFile $f
} -result "File\nContents\n"
test iocmd.readFile-2.3 "readFile procedure: behaviour" -setup {
    set f [makeFile readFile23.bin ""]
    apply {filename {
	set ff [open $filename wb]
	puts -nonewline $ff $BIN_DATA
	close $ff
    }} $f
} -body {
    list [binary scan [readFile $f binary] c* x] $x
} -cleanup {
    removeFile $f
} -result {1 {0 1 2 3 4 26 27 13 10 0}}
# Need to set up ahead of the test
set f [makeFile readFile24.txt ""]
removeFile $f
test iocmd.readFile-2.4 "readFile procedure: behaviour" -body {
    readFile $f
} -returnCodes error -result "couldn't open \"$f\": no such file or directory"

# Tests of writeFile

test iocmd.writeFile-1.1 "writeFile procedure: syntax" -body {
    writeFile
} -returnCodes error -result {wrong # args: should be "writeFile filename ?mode? data"}
test iocmd.writeFile-1.2 "writeFile procedure: syntax" -body {
    writeFile a b c d
} -returnCodes error -result {wrong # args: should be "writeFile filename ?mode? data"}
test iocmd.writeFile-1.3 "writeFile procedure: syntax" -body {
    writeFile gorp gorp2 gorp3
} -returnCodes error -result {bad mode "gorp2": must be binary or text}

test iocmd.writeFile-2.1 "readFile procedure: behaviour" -setup {
    set f [makeFile writeFile21.txt ""]
    removeFile $f
} -body {
    list [writeFile $f "File\nContents\n"] [apply {filename {
	set f [open $filename]
	set text [read $f]
	close $f
	return $text
    }} $f]
} -cleanup {
    removeFile $f
} -result [list {} "File\nContents\n"]
test iocmd.writeFile-2.2 "readFile procedure: behaviour" -setup {
    set f [makeFile writeFile22.txt ""]
    removeFile $f
} -body {
    writeFile $f text "File\nContents\n"
    apply {filename {
	set f [open $filename]
	set text [read $f]
	close $f
	return $text
    }} $f
} -cleanup {
    removeFile $f
} -result "File\nContents\n"
test iocmd.writeFile-2.3 "readFile procedure: behaviour" -setup {
    set f [makeFile writeFile23.txt ""]
    removeFile $f
} -body {
    writeFile $f binary $BIN_DATA
    apply {filename {
	set f [open $filename rb]
	set bytes [read $f]
	close $f
	binary scan $bytes c* x
	return $x
    }} $f
} -cleanup {
    removeFile $f
} -result {0 1 2 3 4 26 27 13 10 0}

# Tests of foreachLine

test iocmd.foreachLine-1.1 "foreachLine procedure: syntax" -returnCodes error -body {
    foreachLine
} -result {wrong # args: should be "foreachLine varName filename body"}
test iocmd.foreachLine-1.2 "foreachLine procedure: syntax" -returnCodes error -body {
    foreachLine a b c d
} -result {wrong # args: should be "foreachLine varName filename body"}
test iocmd.foreachLine-1.3 "foreachLine procedure: basic errors" -setup {
    set f [makeFile foreachLine13.txt ""]
} -body {
    apply {filename {
	array set b {1 1}
        foreachLine b $filename {}
    }} $f
} -cleanup {
    removeFile $f
} -returnCodes error -result {can't set "line": variable is array}
set f [makeFile foreachLine14.txt ""]
removeFile $f
test iocmd.foreachLine-1.4 "foreachLine procedure: basic errors" -body {
    apply {filename {
	foreachLine var $filename {}
    }} $f
} -returnCodes error -result "couldn't open \"$f\": no such file or directory"

test iocmd.foreachLine-2.1 "foreachLine procedure: behaviour" -setup {
    set f [makeFile foreachLine21.txt "a\nb\nc"]
} -body {
    apply {filename {
	set lines {}
	foreachLine var $filename {
	    lappend lines $var
	}
    }} $f
} -cleanup {
    removeFile $f
} -result {a b c}
test iocmd.foreachLine-2.2 "foreachLine procedure: behaviour" -setup {
    set f [makeFile foreachLine22.txt "a\nbb\nc\ndd"]
} -body {
    apply {filename {
	set lines {}
	foreachLine var $filename {
	    if {[string length $var] == 1} continue
	    lappend lines $var
	}
	return $lines
    }} $f
} -cleanup {
    removeFile $f
} -result {bb dd}
test iocmd.foreachLine-2.3 "foreachLine procedure: behaviour" -setup {
    set f [makeFile foreachLine23.txt "a\nbb\nccc\ndd\ne"]
} -body {
    apply {filename {
	set lines {}
	foreachLine var $filename {
	    if {[string length $var] > 2} break
	    lappend lines $var
	}
	return $lines
    }} $f
} -cleanup {
    removeFile $f
} -result {a bb}
test iocmd.foreachLine-2.4 "foreachLine procedure: behaviour" -setup {
    set f [makeFile foreachLine24.txt "a\nbb\nccc\ndd\ne"]
} -body {
    apply {filename {
    	set lines {}
	foreachLine var $filename {
	    if {[string length $var] > 2} {
		return $var
	    }
	    lappend lines $var
	}
	return $lines
    }} $f
} -cleanup {
    removeFile $f
} -result {ccc}
test iocmd.foreachLine-2.5 "foreachLine procedure: behaviour" -setup {
    set f [makeFile foreachLine25.txt "a\nbb\nccc\ndd\ne"]
} -body {
    apply {filename {
	set lines {}
	foreachLine var $filename {
	    if {[string length $var] > 2} {
		error "line too long"
	    }
	    lappend lines $var
	}
	return $lines
    }} $f
} -cleanup {
    removeFile $f
} -returnCodes error -result {line too long}

# ### ### ### ######### ######### #########

# ### ### ### ######### ######### #########

rename track {}
# cleanup