english
version "1.0"
identify "xyz"

#: Copyright (c) 1995-2005 by Wayne C. Gramlich.
#, All rights reserved.

module file_name

#: The {file_name} type represents hierarchical file names.  A file
#, name basically looks like:
#,
#,	root/name1/name2/.../nameN
#,
#, where `/' is the file separator (for UNIX) and `root' is some sort
#, file root.  For UNIX, the available roots are:
#,
#,	Absolute (e.g. `/' and `/usr/bin/cp')
#,	Relative (e.g. `.' and `dir1/dir2/file')
#,	Login (e.g. `~' and `~/bin/myprog')
#,	User (e.g. `~gramlich' and `~gramlich/bin/myprog')
#,
#, Of course, Windows 95 does not have the concept of a user,
#, so the last two file types are not supported for Windows 95.
#,
#, Each {file_name} object is immutable.

#: {file_name}'s are represented as chains of {file_name} objects
#, that contain pointers to the next directory higher in the chain.

define file_name_type			#: File name type
    enumeration
	cwd				#: File name is current working dir.
	login				#: File name is "~"
	next				#: File name is {name}
	root				#: File name is "/"
	user				#: File name is "~{name}"
    generate equal, print, unsigned_convert

define file_name			#: A file name object
    record
        depth unsigned			#: Depth of file name
	file_system file_system		#: File system file name is part of
	name string			#: Name portion of file name
	parent file_name		#: Parent of file name (or self)
	status status			#: If !== ??, latest status for file
	type file_name_type		#: Type of this file name node
    generate allocate, erase, identical



#: {file_name} procedures:

procedure access_mode_change@file_name
    takes
	file_name file_name
	access_mode unsigned
	errors errors
    returns logical

    #: This procedure will change the acces mode of {file_name} to
    #, {access_mode} where mode has the usual Unix style mode bits.
    #, If any errors occur and {errors} is not equal to ??, an error
    #, message is output to {errors}.  {true} is returned if the mode
    #, change failed and {false} otherwise.


procedure canonicalize@file_name
    takes
	file_name file_name
    returns file_name

    #: This procedure will return a canonicalized version of {file_name}
    #, that starts from root (e.g. "~gramlich/bin/myprog" =>
    #, "/home/gramlich/bin/myprog".)


procedure compare@file_name
    takes
	file_name1 file_name
	file_name2 file_name
    returns integer

    #: This procedure will return -1, 0, or 1 depending upon whether
    #, {file_name1} is less than, equal to, or greater than {file_name2}.


procedure compare_helper@file_name
    takes
	file_name1 file_name
	file_name1_depth unsigned
	file_name2 file_name
	file_name2_depth unsigned
    returns integer

    #: This procedure will return -1, 0, or 1 depending upon whether
    #, {file_name1} is less than, equal to, or greather than {file_name2}.
    #, {file_name1_depth} must be the depth of {file_name1} and
    #, {file_name2_depth} must be the depth of {file_name2}.


procedure contents_read@file_name
    takes
	file_name file_name
	buffer string
	errors errors
    returns logical

    #: This procedure will read the entire contents of {file_name}
    #, in and store the contents into {buffer}.  If any errors occur,
    #, a message is output to {errors} and {true} is returned.


procedure create@file_name
    takes
	file_system file_system
	name string
	parent file_name
	type file_name_type
    returns file_name

    #: This procedure will create a new {file_name} type containing
    #, {file_system}, {name}, {parent}, and {type}.  If {parent} equals
    #, ??@{file_name}, the {parent} field is initialized to point to
    #, the returned {file_name} (i.e. it refers to itself.)  This
    #, procedure is used for internal purposes only and no additional
    #, checking is performed.


procedure directory_create@file_name
    takes
	directory_file_name file_name
	errors errors
    returns logical

    #: This procedure will create a directory named {directory_file_name}.
    #, {true} is returned if {directory_name} is not successfully
    #, created and {false} otherwise otherwise.


procedure directory_create_recursive@file_name
    takes
	directory_file_name file_name
	errors errors
    returns logical

    #: This procedure will create a all of the directories up to and
    #, including the directory nameed {directory_file_name}.  If any
    #, errors occur and {errors} is not equal to ??, an error message
    #, is output to {errors}.  If any errors occur, {true} is returned
    #, and {false} otherwise.


procedure directory_open@file_name
    takes
	directory_file_name file_name
    returns directory

    #: This procedure will open the directory named {directory_file_name}
    #, and return a {directory} object for scanning the files from the
    #, directory out.  ??@{directory} is returned if {directory_file_name}
    #, can not be opened as a directory.


procedure directory_replace@file_name
    takes
	full_file_name file_name
	old_directory file_name
	new_directory file_name
    returns file_name

    #: This procedure will return the {file_name} object that results
    #, replacing {old_directory} in {full_file_name} with {new_directory}.
    #, ??@{file_name} is returned if {old_directory} is not a proper
    #, prefix to {full_file_name}.


procedure directory_replace_helper@file_name
    takes
	full_file_name file_name
	full_file_name_depth unsigned
	old_directory file_name
	old_directory_depth unsigned
	new_directory file_name
    returns file_name

    #: This procedure will return the {file_name} object that results
    #, replacing {old_directory} in {full_file_name} with {new_directory}.
    #, ??@{file_name} is returned if {old_directory} is not a proper
    #, prefix to {full_file_name}.


procedure equal@file_name
    takes
	file_name1 file_name
	file_name2 file_name
    returns logical

    #: This procedure will return {true} if {file_name1} is equal
    #, to {file_name2} and {false} otherwise.


procedure fetch1@file_name
    takes
	file_name file_name
	depth unsigned
    returns file_name

    #: This procedure will return the component of {file_name} that is
    #, at {depth}.


procedure file_delete@file_name
    takes
	file_name file_name
    returns logical

    #: This procedure will delete the file named {file_name}.  {true} is
    #, if either the file could not be deleted or if the file does not
    #, exist; otherwise, {false} is returned if the file is successfully
    #, deleted.


procedure file_exists@file_name
    takes
	file_name file_name
    returns logical

    #: This procedure will return {true}@{logical} if {file_name}
    #, is a file, directory, symbolic link, etc.; otherwise,
    #, {false}@{logica} is returned.


procedure format@file_name
    takes
	file_name file_name
	out_stream out_stream
	format string
	offset unsigned
    returns_nothing

    #: This procedure will output {file_name} to {out_stream} using
    #, the formatting characters in {format} starting at {offset}
    #, until a terminating '%' is encountered.  See the {format} module
    #, to find out more about formatted output.


procedure greater_than@file_name
    takes
	file_name1 file_name
	file_name2 file_name
    returns logical

    #: This procedure will return {true} if {file_name1} is greater than
    #, {file_name2} and {false} otherwise.


procedure has_parent@file_name
    takes
	file_name file_name
    returns logical

    #: This procedure will return {true} if {file_name} has a parent
    #, {file_name}.  Only `root-like' {file_name} objects (e.g.
    #, `/', `.', `~', and `~user') are `root-like'.


procedure hash@file_name
    takes
	file_name file_name
    returns unsigned

    #: This procedure will return a hash value for {file_name}.


procedure is_absolute@file_name
    takes
	file_name file_name
    returns logical

    #: This procedure will return {true} if {file_name} is a file name
    #, with an absolute path and {false} otherwise.  Examples of files
    #, that have an absolute path are (`/dev', `/', `~', `~gramlich',
    #, `~/public_html', etc.)  A file with a relative path is not
    #, absolute (e.g. `foo', `./bar', etc.)


procedure is_directory@file_name
    takes
	directory_file_name file_name
    returns logical

    #: This procedure will return {true}@{logical} if {directory_file_name}

procedure is_file@file_name
    takes
	file_name file_name
    returns logical

    #: This procedure will return {true}@{logical} if {file_name} is
    #, a regular file and {false}@{logical} otherwise.


procedure is_symbolic_link@file_name
    takes
	symbolic_link file_name
    returns logical

    #: This procedure will return {true@logical} if {symbolic_link} is
    #, a symbolic link and {false@logical} otherwise.


procedure is_relative@file_name
    takes
	file_name file_name
    returns logical

    #: This procedure will return {true} if {file_name} is a file name
    #, with a relative path and {false} otherwise.  This is defined to
    #, be the exact opposite of {is_absolute}@{file_name}().


procedure is_root@file_name
    takes
	file_name file_name
    returns logical

    #: This procedure will return {true} if {file_name} is the root of
    #, a file name and {false} otherwise.


procedure join@file_name
    takes
	front_file_name file_name
	back_file_name file_name
    returns file_name

    #: This procedure will create and return a new file_name that is
    #, the result of joining {back_file_name} onto the end of
    #, {front_file_name}.  Both {front_file_name} and {back_file_name}
    #, have to be members of the same {file_system} object.


procedure less_than@file_name
    takes
	file_name1 file_name
	file_name2 file_name
    returns logical

    #: This procedure will return {true} if {file_name1} is less than
    #, {file_name2} and {false} otherwise.


procedure name_append@file_name
    takes
	parent_file_name file_name
	name string
    returns file_name

    #: This procedure will return a new {file_name} object that
    #, consists of appending {name} to {parent_file_name}.


procedure name_extract@file_name
    takes
	file_name file_name
	offset unsigned
	length unsigned
    returns file_name

    #: This procedure will return a new {file_name} object that
    #, corresponds to the {length} characters starting at {offset}
    #, in {file_name}'s name.  It is a fatal error to call this
    #, procedure if {file_name} does not have a parent.


procedure name_replace@file_name
    takes
	file_name file_name
	name string
    returns file_name

    #: This procedure will return a new {file_name} object that
    #, corresponds to replacing {file_name}'s name with {name}.
    #, It is a fatal error to call this procedure if {file_name} does
    #, not have a parent.


procedure normalize@file_name
    takes
	file_name file_name
    returns file_name

    #: This procedure will remove all occurances of "/foo/.." and "/."
    #, from {file_name} and return it.  On an operating system that
    #, supports symbolic links, removing "/foo./.." where foo is a
    #, symbolic link, this operation does not preserve operating system
    #, semantics.  None-the-less, this operation can be useful.


procedure open_append@file_name
    takes
	file_name file_name
    returns out_stream

    #: This procedure will open {file_name} for writing in append mode.
    #, If it is not possible to open }file_name} for writing,
    #, ??@{out_stream} is returned.


procedure open_create@file_name
    takes
	file_name file_name
    returns out_stream

    #: This procedure will open {file_name} for writing.  If {file_name}
    #, already exists, it will be truncated to zero length.  If it is
    #, not possible to open }file_name} for writing, ??@{out_stream}
    #, is returned.


procedure open_read@file_name
    takes
	file_name file_name
    returns in_stream

    #: This procedure will open {file_name} for reading.  If it is
    #, not possible to open }file_name} for reading, ??@{in_stream}
    #, is returned.


procedure open_read_path@file_name
    takes
	file_name file_name
	path vector[file_name]
    returns in_stream

    #: This procedure will open {file_name} for reading by searching
    #, each directory in {path}.  If no file can be found, ??@{in_stream}
    #, is returned.


procedure parse@file_name
    takes
	file_name_string string
	file_system file_system
    returns file_name

    #: This procedure will return a {file_name} object that contains
    #, {file_name_string}.  ??@{file_name} is returned  if any errors
    #, occur (should be an exception.)


procedure parse_helper@file_name
    takes
	file_name_string string
	file_system file_system
	size unsigned
    returns file_name

    #: This procedure will return a {file_name} that corresponds to the
    #, file name in {file_name_string} that is {size} characters long.
    #, ??@{file_name} is returned if any errors occur; actually, errors
    #, should throw an exception.  This routine is for internal use only.


#: Prefix procedures:

procedure prefix_prepend@file_name
    takes
	base_file_name file_name
	prefix string
    returns file_name

    #: This procedure will return the file name that results from prepending
    #, {prefix} to {base_file_name}.  Be sure that prefix has any appropriate
    #, period (`.') at the end (e.g. "x.".)


procedure prefix_get@file_name
    takes
	file_name file_name
    returns string

    #: This procedure will return the prefix from the end of {file_name}.
    #, If there is no prefix, "" is returned.


procedure prefix_match@file_name
    takes
	file_name file_name
	prefix string
    returns logical

    #: This procedure will return {true} if {file_name} has a prefix
    #, that exactly matches {prefix} and {false} otherwise.


procedure prefix_replace@file_name
    takes
	file_name file_name
	old_prefix string
	new_prefix string
    returns file_name

    #: This procedure will replace {old_prefix} at the front of {file_name}
    #, with {new_prefix} and return the resulting {file_name} object.
    #, It is a fatal error to call this procedure if {file_name} is
    #, not started by {old_prefix}.


procedure prefix_remove@file_name
    takes
	file_name file_name
	prefix string
    returns file_name

    #: This procedure will return the file name that results from removing
    #, {prefix} from {file_name}.  It is a fatal error to call this
    #, procedure if {file_name} does not end in {prefix}.


procedure print@file_name
    takes
	file_name file_name
	out_stream out_stream
    returns_nothing

    #: This procedure will print {file_name} to {out_stream}.

    #, in {size_get}@{file_name}.


procedure print_helper@file_name
    takes
	file_name file_name
	out_stream out_stream
    returns logical

    #: This procedure will print {file_name} to {out_stream}.

    #, in {size_get}@{file_name}.


procedure read_open@file_name
    takes
	file_name file_name
	errors errors
    returns in_stream

    #: This procedure will open {file_name} for reading and return the
    #, associated open {in_stream} object.  If {file_name} can not be
    #, opened, an error message is output to {errors} and ??@{in_stream}
    #, is returned.


procedure rename@file_name
    takes
	old_file_name file_name
	new_file_name file_name
	errors errors
    returns logical

    #: This procedure will rename {old_file_name} to {new_file_name}.
    #, If any error occurs, {true} is returned and {false} otherwise.
    #, If {error_stream} is not identical to ??@{out_stream}, an
    #, error message is output to {errors} when an error occurs.


procedure status_update@file_name
    takes
	file_name file_name
    returns logical

    #: This procedure will update the {status} object associated
    #, with {file_name}.  If there is no {status_mode} object, one
    #, will be created.  {true} is returned if no corresponding file
    #, exists; otherwise, {false} is returned.


procedure string_append@file_name
    takes
	file_name file_name
	buffer string
    returns_nothing

    #: This procedure will append {file_name} to {buffer} (which must
    #, be writable.)


procedure string_append_helper@file_name
    takes
	file_name file_name
	buffer string
    returns logical

    #: This procedure will append {file_name} to {buffer}.


procedure string_convert@file_name
    takes
	file_name file_name
    returns string

    #: This procedure will convert {file_name} to a {string} and return it.


#: Suffix procedures:

procedure suffix_append@file_name
    takes
	base_file_name file_name
	suffix string
    returns file_name

    #: This procedure will return the file name that results from appending
    #, {suffix} to {base_file_name}.  Be sure that suffix has any appropriate
    #, period (`.') at the beginning (e.g. ".txt").


procedure suffix_get@file_name
    takes
	file_name file_name
    returns string

    #: This procedure will return the suffix from the end of {file_name}.
    #, If there is no suffix, "" is returned.


procedure suffix_match@file_name
    takes
	file_name file_name
	suffix string
    returns logical

    #: This procedure will return {true} if {file_name} has a suffix
    #, that exactly matches {suffix} and {false} otherwise.


procedure suffix_replace@file_name
    takes
	file_name file_name
	old_suffix string
	new_suffix string
    returns file_name

    #: This procedure will replace {old_suffix} at the end of {file_name}
    #, with {new_suffix} and return the resulting {file_name} object.
    #, It is a fatal error to call this procedure if {file_name} is
    #, not terminated by {old_suffix}.


procedure suffix_remove@file_name
    takes
	file_name file_name
	suffix string
    returns file_name

    #: This procedure will return the file name that results from removing
    #, {suffix} from {file_name}.  It is a fatal error to call this
    #, procedure if {file_name} does not end in {suffix}.


procedure tail@file_name
    takes
	full_file_name file_name
	prefix_file_name file_name
    returns file_name

    #: This procedure will match the first part of {prefix_file_name}
    #, to {full_file_name} and return the remaining portion of the
    #, file name.


procedure user_create@file_name
    takes
	file_system file_system
	user_name string
    returns file_name

    #: This procedure will create and return file_name from {file_system}
    #, that points to {user_name}'s home directory (i.e. "~{user_name}".)


procedure write_open@file_name
    takes
	file_name file_name
	errors errors
    returns out_stream

    #: This procedure will open {file_name} for writing and return the
    #, associated open {in_stream} object.  If {file_name} can not be
    #, opened, an error message is output to {errors} and ??@{in_stream}
    #, is returned.


#: {string} procedures:

procedure file_name_convert@string
    takes
	file_name_string string
    returns file_name

    #: This procedure will convert {file_name_string} into a {file_name}
    #, object and return it.