############################################################################
#
#	File:     io.icn
#
#	Subject:  Procedures for input and output
#
#	Author:   Ralph E. Griswold
#
#	Date:     June 5, 2013
#
############################################################################
#
#   This file is in the public domain.
#
############################################################################
#
#  Contributors:  Paul Abrahams, Bob Alexander, Will Evans, David A. Gamey,
#		  Richard L. Goerwitz, Will Menagarini, Charles Shartsis,
#		  Carl Sturtivant, 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.
#
#  	directory(name)	succeeds if name exists as a directory
#			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 directory
#		        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 list of
#		directories in "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"), to which iconx automatically
#		appends the directory containing the standard libcfunc.so file.
#
############################################################################
#
#  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

procedure directory(name)		#: succeed if name is a directory

   if close(open(name || "/.")) then
      return name
   else
      fail

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

   $ifdef _UNIX
      $define PSEP ' :' 
   $else
      $define PSEP ' ' 
   $endif

   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(PSEP) | 0)
      fullname := trim(dir, '/') || "/" || fname
      if close(open(fullname)) then
         return fullname
      tab(many(PSEP))
      }
   fail
end

procedure pathload(fname, entry)	#: load C function from $FPATH
   local path, found

   path := getenv("FPATH") | "."
   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, len, "0") || suffix
      if not exists(name) then return name
      }

end