############################################################################
#
# File: io.icn
#
# Subject: Procedures for input and output
#
# Author: Ralph E. Griswold
#
# Date: July 11, 1998
#
############################################################################
#
# This file is in the public domain.
#
############################################################################
#
# Contributors: Paul Abrahams, Bob Alexander, David A. Gamey, Richard L.
# Goerwitz, Will Menagarini, Charles Sharstis, and Gregg
# Townsend.
#
############################################################################
#
# They provide facilities for handling input, output, and files.
#
# There are other modules in the Icon program library that deal with
# input and output. They are not included here because they conflict
# with procedures here or each other.
#
############################################################################
#
# Requires: Appropriate operating system for procedures used. Some
# require loadfunc().
#
############################################################################
#
# Links: random, strings
#
############################################################################
#
# File copying:
#
# fcopy(fn1, fn2) copies a file named fn1 to file named fn2.
#
############################################################################
#
# File existence:
#
# exists(name) succeeds if name exists as a file but fails
# otherwise.
#
############################################################################
#
# File lists:
#
# filelist(s,x) returns a list of the file names that match the
# specification s. If x is nonnull, any direcory
# is stripped off. At present it only works for
# UNIX. Users of other platforms are invited to add
# code for their platforms.
#
############################################################################
#
# Reading and writing files:
#
# filetext(f) reads the lines of f into a list and returns that
# list
#
# readline(file) assembles backslash-continued lines from the specified
# file into a single line. If the last line in a file
# ends in a backslash, that character is included in the
# last line read.
#
# splitline(file, line, limit)
# splits line into pieces at first blank after
# the limit, appending a backslash to identify split
# lines (if a line ends in a backslash already, that's
# too bad). The pieces are written to the specified file.
#
############################################################################
#
# Buffered input and output:
#
# ClearOut() remove contents of output buffer without writing
# Flush() flush output buffer
# GetBack() get back line writen
# LookAhead() look ahead at next line
# PutBack(s) put back a line
# Read() read a line
# ReadAhead(n) read ahead n lines
# Write(s) write a line
#
############################################################################
#
# Path searching:
#
# dopen(s) opens and returns the file s on DPATH.
#
# dpath(s) returns the path to s on DPATH.
#
# Both fail if the file is not found.
#
# pathfind(fname, path)
# returns the full path of fname if found along the space-
# separated list of directories "path", else fails. If no path
# is given, getenv("DPATH") is the default. As is customary in
# Icon path searching, "." is prepended to the path.
#
# pathload(fname, entry)
# calls loadfunc() to load entry from the file fname found on the
# function path. If the file or entry point cannot be found, the
# program is aborted. The function path consists of the current
# directory, then getenv("FPATH"), and finally any additional
# directories configured in the code.
#
############################################################################
#
# Parsing file names:
#
# suffix() parses a hierarchical file name, returning a 2-element
# list: [prefix,suffix]. E.g. suffix("/a/b/c.d") ->
# ["/a/b/c","d"]
#
# tail() parses a hierarchical file name, returning a 2-element
# list: [head,tail]. E.g. tail("/a/b/c.d") ->
# ["/a/b","c.d"].
#
# components() parses a hierarchical file name, returning a list of
# all directory names in the file path, with the file
# name (tail) as the last element. For example,
# components("/a/b/c.d") -> ["/","a","b","c.d"].
#
############################################################################
#
# Temporary files:
#
# tempfile(prefix, suffix, path, len)
# produces a "temporary" file that can be written. The name
# is chosen so as not to overwrite an existing file.
# The prefix and suffix are prepended and appended, respectively,
# to a randomly chosen number. They default to the empty
# string. The path is prepended to the file name; its default
# is "." The randomly chosen number is fit into a field of len
# (default 8) by truncation or right filling with zeros as
# necessary.
#
# It is the user's responsibility to remove the file when it is
# no longer needed.
#
# tempname(prefix, suffix, path, len)
# produces the name of a temporary file.
#
############################################################################
#
# DOS helpers:
#
# dosdir(diropts) generates records of type dirinfo for each file
# found in the directory, failing when no more files
# are available, as in
#
# every dirent := dosdir("*.*") do ....
#
# known problems:
#
# When used to traverse directories and sub-directories in nested every
# loops it doesn't work as expected - requires further investigation.
# Bypass by building lists of the subdirectories to be traversed.
#
# dosdirlist( dpath, dpart2, infotab )
# returns a list containing the qualified file names for files
# in dpath and matching file patterns and/or options specified
# in dpart2. For example,
#
# dirlist := dosdirlist( "..", "*.* /o:n /a:r-d" )
#
# returns a list of all read-only-non-directory files in the
# parent directory on a MS-DOS compatible system.
#
# If the optional infotab is specified,
#
# (1) it must be a table or a run time error will result
# (2) the contents of the table will be updated as follows
# a dirinfo record will be created for each filename
# (3) the filename will be the key to the table
#
# For example,
#
# t := table()
# dirlist := dosdirlist( "..", "*.* /o:n /a:r-d", t )
# maxsize := 0 ; every maxsize <:= t[!dirlist].size
#
# calculates the maximum size of the files.
#
# dosfiles(pfn) accepts a DOS filename possibly containing wildcards.
# The filename can also include a drive letter and path.
# If the filename ends in "\" or ":", "*.*" is appended.
# The result sequence is a sequence of the filenames
# corresponding to pfn.
#
# dosname(s) converts a file name by truncating to the
# MS-DOS 8.3 format. Forward slashes are converted
# to backslashes and all letters are converted to
# lower case.
#
# Every disk drive on a MS-DOS system has a "working directory", which is
# the directory referred to by any references to that drive that don't begin
# with a backslash (& so are either direct references to that working
# directory, or paths relative to it). There is also 1 "current drive", &
# its working directory is called the "current working directory". Any paths
# that don't explicitly specify a drive refer to the current drive. For
# example, "name.ext" refers to the current drive's working directory, aka
# the current working directory; "\name.ext" refers to the current drive's
# root directory; & "d:name.ext" refers to the working directory on d:.
#
# It's reasonable to want to inquire any of these values. The CD command
# displays both, in the form of a complete path to the current working
# directory. However, passing such a path to either CD or the Icon function
# chdir() doesn't change to that dir on that drive; it changes that drive's
# working directory to the specified path without changing the current
# drive. The command to change the current drive is the system() function
# of a command consisting of just the drive letter followed by ":".
#
# This affects the design of inquiry functions. They could be implemented
# with system( "CD >" || ( name := tempname() ) ) & read(open(name)), but
# because this requires a slow disk access (which could fail on a full disk)
# it's unacceptable to need to do that *twice*, once for the drive & again
# for the dir; so if that strategy were used, it'd be necessary to return a
# structure containing the current drive & the working directory. That
# structure, whether table, list, or string, would then need to be either
# indexed or string-scanned to get the individual values, making the code
# cumbersome & obscure. It's much better to have 2 separate inquiry
# functions, 1 for each value; but for this to be acceptably efficient, it's
# necessary to forgo the disk access & implement the functions with
# interrupts.
#
# getdrive() returns the current drive as a lowercase string with
# the ":".
#
# getwd("g")
# getwd("g:") return the working directory on drive g:, or
# fail if g: doesn't exist. getwd() returns the current
# working directory. getwd(...) always returns
# lowercase. It prepends the relevant drive letter
# with its colon; that's harmless in a chdir(), & useful
# in an open().
#
# DOS_FileParts(s) takes a DOS file name and returns
# a record containing various representations of
# the file name and its components. The name
# given is returned in the fullname field.
# Fields that cannot be determined are returned
# as empty strings.
#
############################################################################
link random
link strings
global buffer_in, buffer_out, Eof
record _DOS_FileParts_(fullname,devpath,device,path,name,extension)
record dirinfo( name, ext, size, date, time )
procedure ClearOut() #: remove contents of output buffer
buffer_out := []
end
procedure DOS_FileParts(filename) #: parse DOSfile name
local dev, path, name, ext, p, d
filename ? {
dev := 1( tab( upto(':') ), move(1) ) | ""
d := &pos - 1
tab(0)
} ? {
p := 1
path := tab( ( every p := upto('\\') + 1 ) | p )
tab(0)
} ? {
name := 1( tab( upto('.') ), move(1) ) | tab(0)
ext := tab(0)
}
return _DOS_FileParts_(filename,filename[1:d + p],dev,path,name,ext)
end
procedure Flush() #: flush output buffer
while write(pull(buffer_out))
return
end
procedure GetBack() #: get back line written
return get(buffer_out)
end
procedure LookAhead() #: look at next line
return buffer_in[1]
end
procedure PutBack(s) #: put back line read
push(buffer_in,s)
return
end
procedure Read() #: read a line in buffered mode
initial{
buffer_in := []
}
if *buffer_in = 0 then
put(buffer_in,read()) | (Eof := 1)
return get(buffer_in)
end
procedure ReadAhead(n) #: read ahead
while *buffer_in < n do
put(buffer_in,read()) | {
Eof := 1
fail
}
return
end
procedure Write(s) #: write in buffered mode
initial buffer_out := []
push(buffer_out,s)
return s
end
procedure components(s,separator) #: get components of file name
local x,head
/separator := "/"
x := tail(s,separator)
return case head := x[1] of {
separator: [separator]
"": []
# C. Shartsis: 4/23/95 - fix for MS-DOS
# default: components(head)
default: components(head, separator)
} ||| ([&null ~=== x[2]] | [])
end
procedure dopen(s) #: open file on DPATH
local file, paths, path
if file := open(s) then return file # look in current directory
paths := getenv("DPATH") | fail
s := "/" || s # platform-specific
paths ? {
while path := tab(upto(' ') | 0) do {
if file := open(path || s) then return file
tab(many(' ')) | break
}
}
fail
end
procedure dosdir( diropts ) #: process DOS directory
local de, line
static tempfn, tempf, dosdir_ver
initial {
close(open(tempfn := tempname(),"w"))
system("ver > " || tempfn)
(tempf := open(tempfn,"r")) |
stop("Unable to open ",tempfn," from dosdir.")
while line := read(tempf) do
if find("MS-DOS",line) then
if find("6.20",line) then
dosdir_ver := dosdir_62
else
dosdir_ver := dosdir_xx
close(tempf)
system("erase " || tempfn)
}
close(open(tempfn := tempname(),"w")) # ensure useable file
system("dir " || diropts || " > " || tempfn) # get dir
tempf := open(tempfn,"r") # open file
while line := map(read(tempf)) do {
line ?
if de := dosdir_ver() then
suspend de
else
next
}
close(tempf)
system("erase " || tempfn)
end
procedure dosdir_62()
static nb
local de
initial nb := ~' '
if *&subject = 43 & (tab(any(nb)), move(-1)) then {
de := dirinfo()
(de.name := trim(move(8)), move(1),
de.ext := trim(move(3)), move(1),
de.size := move(13), move(1),
de.date := move(8), move(2),
de.time := tab(0))
every de.size ?:= 1(tab(upto(',')),move(1)) || tab(0)
return de
}
end
procedure dosdir_xx()
static nb
local de
initial nb := ~' '
if *&subject = 39 & (tab(any(nb)), move(-1)) then {
de := dirinfo()
(de.name := trim(move(8)), move(1),
de.ext := trim(move(3)), move(1),
de.size := integer(move(9)), move(1),
de.date := move(8), move(2),
de.time := tab(0))
return de
}
end
procedure dosdirlist( #: get list of DOS directory
dpath, dpart2, infotab
)
local dl, di, fn
if type(\infotab) ~== "table" then
runerr( 124, infotab )
dpath ||:= dpath[-1] ~== "\\"
/dpart2 := "*.*"
dl := []
every di := dosdir( dpath || dpart2 ) do
if not ( di.name == ("." | "..") ) then {
put( dl, fn := ( dpath || di.name || "." || trim(di.ext) ) )
(\infotab)[fn] := di
}
return dl
end
$ifdef _MSDOS
procedure dosfiles(pfn) #: DOS file names
local asciiz, fnr, prefix, k, name
local ds, dx, result, fnloc, string_block
# Get Disk Transfer Address; filename locn is 30 beyond that.
result := Int86([16r21, 16r2f00] ||| list(7,0))
# pointer arithmetic wrong: fnloc := 16 * result[8] + result[3]+ 30
fnloc := ishift( result[8], 16 ) + result[3] + 30
# Get the generalized filename.
fnr := reverse(pfn)
k := upto("\\:", fnr) | *fnr + 1
prefix := reverse(fnr[k:0])
name := "" ~== reverse(fnr[1:k]) | "*.*"
# Get the first file in the sequence.
asciiz := prefix || name || "\x00"
Poke(string_block := GetSpace(*asciiz), asciiz) |
stop( "dosfiles(): GetSpace() failed." )
# pointer arithmetic wrong: ds := string_block / 16
# pointer arithmetic wrong: dx := string_block % 16
ds := ishift( string_block, -16 )
dx := iand( string_block, 16rffff )
result := Int86([16r21, 16r4e00, 0, 0, dx, 0, 0, 0, ds])
FreeSpace(string_block)
case result[2] of {
0 : {}
18 : fail
default : stop("I/O Error ", result[2])
}
suspend prefix || extract_name(fnloc)
# Get the remaining files in the sequence.
while Int86([16r21, 16r4f00, 0, 0, 0, 0, 0, 0, 0])[2] = 0 do
suspend prefix || extract_name(fnloc)
end
$endif
procedure dosname(namein) #: convert file name to DOS format
local prefix, base, extension, pair, extended_name
namein := replace(namein, "/", "\\")
pair := tail(namein, "\\")
prefix := pair[1]
extended_name := pair[2]
pair := suffix(extended_name)
base := pair[1]
extension := pair[2]
base := base[1:9]
extension := extension[1:4]
return map(prefix || "\\" || base || "." || extension)
end
procedure dpath(s) #: full path to file on DPATH
local file, paths, path, result
if exists(s) then return s # look in current directory
paths := getenv("DPATH") | fail
s := "/" || s # platform-specific
paths ? {
while path := tab(upto(' ') | 0) do {
if exists(result := path || s) then return result
tab(many(' ')) | break
}
}
fail
end
procedure exists(name) #: test file existence
return close(open(name))
end
$ifdef _MSDOS
procedure extract_name(fnloc)
local asciiz
asciiz := Peek(fnloc, 13)
return asciiz[1:upto("\x00", asciiz)]
end
$endif
procedure fcopy(fn1,fn2) #: copy file
local f1, f2, buf
f1 := open(fn1,"ru") | stop("Can't open ",fn1)
f2 := open(fn2,"wu") | stop("Can't open ",fn2," for writing")
while buf := reads(f1,512) do writes(f2,buf)
every close(f2 | f1)
return fn2
end
procedure filelist(spec, x) #: get list of files
local flist, ls, f
/spec := ""
flist := []
if &features == "UNIX" then {
ls := open("ls " || spec || " 2>/dev/null", "p")
every f := !ls do {
if \x then f ?:= {
while tab(upto("/") + 1)
tab(0)
}
put(flist, f)
}
close(ls)
return flist
}
else fail # don't take control away from caller
end
procedure filetext(f) #: read file into list
local input, file, text
input := open(f) | stop("cannot open input file")
text := []
while put(text,read(input))
close(input)
return text
end
$ifdef _MSDOS
procedure getdrive() #: get current DOS drive
return &lcase[iand( Int86([33,16r1900,0,0,0,0,0,0,0])[2], 255 )+1] || ":"
end
procedure getwd(drive) #: get DOS working directory
local A, dx, si, cf, ds
A := GetSpace(64) | stop( "getwd(): GetSpace() failed." )
dx := ("36r" || !\drive) - 9 | 0
si := iand( A, 16rffff ); ds := ishift( A, -16 )
cf := !Int86([33,16r4700,0,0,dx,si,0,0,ds]) % 2
Peek( A , 64 ) ? path := tab(many(~'\0')) | ""
FreeSpace(A)
cf = 0 | fail
return ( map(!\drive) || ":" | getdrive() ) || "\\" || map(path)
end
$endif
procedure pathfind(fname, path) #: find file on path
local f, dir, fullname
fname ? {
if ="/" & close(open(fname)) then
return fname # full absolute path works
while tab(upto('/') + 1)
fname := tab(0) # get final component of path
}
/path := getenv("DPATH")
/path := ""
path := ". " || path
path ? while not pos(0) do {
dir := tab(upto(' ') | 0)
fullname := trim(dir, '/') || "/" || fname
if close(open(fullname)) then
return fullname
tab(many(' '))
}
fail
end
# default path configuration to try after getenv("FPATH")
$define FUNCPATH "/usr/local/lib/icon"
procedure pathload(fname, entry) #: load C function from $FPATH
local path, found
path := (getenv("FPATH") | "") || " " || FUNCPATH
found := pathfind(fname, path)
if /found then
stop ("cannot find \"", fname, "\" on path \". ", path, "\"")
return loadfunc(found, entry) # aborts if unsuccessful
end
procedure readline(file) #: assemble backslash-continued lines
local line
line := read(file) | fail
while line[-1] == "\\" do
line := line[1:-1] || read(file) | break
return line
end
procedure splitline(file,line,limit) #: split line into pieces
local i, j
if *line = 0 then { # don't fail to write empty line
write(file,line)
return
}
while *line > limit do {
line ?:= {
i := j := 0
every i := find(" ") do { # find a point to split
if i >= limit then break
else j := i
}
if j = 0 then { # can't split
write(file,line)
return
}
write(file,tab(j + 1),"\\")
tab(0) # update line
}
}
if *line > 0 then write(file,line) # the rest
return
end
procedure suffix(s,separator) #: find suffix of file name
local i
/separator := "."
i := *s + 1
every i := find(separator,s)
return [s[1:i],s[(*s >= i) + 1:0] | &null]
end
procedure tail(s,separator) #: find tail of file name
local i
/separator := "/"
i := 0
every i := find(separator,s)
return [s[1:i + (i <= 1 | 0)],"" ~== s[i + 1:0] | &null]
end
procedure tempfile( #: get temporary file
prefix, suffix, path, len
)
local name
name := tempname(prefix, suffix, path, len)
return open(name, "w") | fail
end
procedure tempname( #: get temporary file name
prefix, suffix, path, len
)
local name, file
/prefix := ""
/suffix := ""
/path := "."
prefix := path || "/" || prefix
/len := 8
randomize()
repeat {
?1 # change &random
name := prefix || left(&random, 8, "0") || suffix
if not exists(name) then return name
}
end