## dir-tree.pkg
## Author: Matthias Blume (blume@cs.princeton.edu)
# Compiled by:
# src/lib/std/standard.lib# Compare to:
# src/lib/src/dir.pkg# src/lib/src/symlink-tree.pkg# Just like dir from
# src/lib/src/dir.pkg# except that we process all entries in
# an entire directory tree, instead of
# in just one directory.
stipulate
package lms = list_mergesort; # list_mergesort is from src/lib/src/list-mergesort.pkg package psx = posixlib; # posixlib is from src/lib/std/src/psx/posixlib.pkgherein
package dir_tree
: Dir_Tree # Dir_Tree is from src/lib/src/dir-tree.api {
fun is_directory filename
=
psx::stat::is_directory
(psx::stat filename)
except
_ = FALSE;
fun is_file filename
=
psx::stat::is_file
(psx::stat filename)
except
_ = FALSE;
fun is_symlink filename
=
psx::stat::is_symlink
(psx::lstat filename)
except
_ = FALSE;
fun is_dot_initial name
=
string::get_byte_as_char (name, 0) == '.';
fun canonicalize directory_name
=
{ # Drop any leading "./":
#
directory_name
=
regex::replace_first "^\\./" "" directory_name;
# Change "." to "":
#
directory_name
=
directory_name == "." ?? ""
:: directory_name;
# Make relative paths absolute by
# prepending current working directory:
#
directory_name
=
if (string::length_in_bytes directory_name == 0)
winix__premicrothread::file::current_directory ();
else
if (string::get_byte_as_char (directory_name, 0) != '/')
#
cwd = winix__premicrothread::file::current_directory ();
cwd + "/" + directory_name;
else
directory_name;
fi;
fi;
# Delete any foo/.. subsequences:
#
directory_name'
=
regex::replace_first "[^/]+/\\.\\./" "" directory_name;
if (directory_name == directory_name')
directory_name;
else
canonicalize directory_name';
fi;
};
# For all directory entries in given directory tree do
# results = filter_fn( path, dir, file, results );
# (where path == dir + "/" + file)
# and then return the resulting list.
#
fun filter_directory_subtree_contents
{
directory_name: String,
filter_fn: { path: String, directory_name: String, name: String, results: List(X) } -> List(X),
results: List(X)
}
=
filter_tree { directory_name, results }
where
fun filter_tree { directory_name, results }
=
{
results = safely::do
{
open_it => {. psx::open_directory_stream directory_name; },
close_it => psx::close_directory_stream,
cleanup => \\ _ = ()
}
{. loop results
where
fun loop results
=
case (psx::read_directory_entry #directory_stream)
#
NULL => results;
#
THE name
=>
{
path = directory_name + "/" + name;
#
results = filter_fn { path, directory_name, name, results };
#
results = if (name == ".") results;
elif (name == "..") results;
elif (not (is_directory path)) results;
elif (is_symlink path) results;
else
filter_tree { directory_name => path, results };
fi;
loop results;
};
esac;
end;
};
results;
};
end;
# Return alphabetically sorted list of paths
# for all entries in directory subtree whose
# names do not start with a dot:
#
# [ "/home/jcb/foo", ... ]
#
fun entries (directory_name: String)
=
{ fun ignore_dot_initial_entries { path, directory_name, name, results }
=
if (string::length_in_bytes name > 0
and string::get_byte_as_char (name, 0) == '.')
#
results;
else
path ! results;
fi;
results = filter_directory_subtree_contents
{
directory_name => canonicalize directory_name,
filter_fn => ignore_dot_initial_entries,
results => []
};
lms::sort_list string::(>) results;
};
# Return alphabetically sorted list of paths
# for all entries in directory subtree whose
# names are not "." or "..":
#
# [ "/home/jcb/.bashrc", "/home/jcb/.emacs", "/home/jcb/foo", ... ]
#
fun entries' (directory_name: String)
=
{ fun ignore_dot_and_dotdot { path, directory_name, name, results }
=
if (name == "."
or name == "..")
#
results;
else
path ! results;
fi;
results = filter_directory_subtree_contents
{
directory_name => canonicalize directory_name,
filter_fn => ignore_dot_and_dotdot,
results => []
};
lms::sort_list string::(>) results;
};
# Return alphabetically sorted list of paths
# for all entries in directory subtree:
#
# [ "/home/jcb/.", "/home/jcb/..", "/home/jcb/.bashrc", "/home/jcb/.emacs", "/home/jcb/foo", ... ]
#
fun entries'' (directory_name: String)
=
{ fun accept_everything { path, directory_name, name, results }
=
path ! results;
results = filter_directory_subtree_contents
{
directory_name => canonicalize directory_name,
filter_fn => accept_everything,
results => []
};
lms::sort_list string::(>) results;
};
# Return alphabetically sorted list of paths
# for all nondot files in directory subtree:
#
# [ "/home/jcb/foo", "/home/jcb/src/test.c", "/home/jcb/zot" ]
#
fun files (directory_name: String)
=
{ fun accept_only_nondot_files { path, directory_name, name, results }
=
if (is_dot_initial name) results;
elif (is_file path) path ! results;
else results;
fi;
results = filter_directory_subtree_contents
{
directory_name => canonicalize directory_name,
filter_fn => accept_only_nondot_files,
results => []
};
lms::sort_list string::(>) results;
};
# Return alphabetically sorted list of paths
# for all plain files in directory subtree:
#
# [ "/home/jcb/.bashrc", "/home/jcb/.emacs", "/home/jcb/foo", "/home/jcb/src/test.c", "/home/jcb/zot" ]
#
fun files' (directory_name: String)
=
{ fun accept_only_plain_files { path, directory_name, name, results }
=
if (is_file path) path ! results;
else results;
fi;
results = filter_directory_subtree_contents
{
directory_name => canonicalize directory_name,
filter_fn => accept_only_plain_files,
results => []
};
lms::sort_list string::(>) results;
};
# Return alphabetically sorted list of paths
# for all nondot directories in directory subtree:
#
# [ "/home/jcb/foo", "/home/jcb/src/test.c", "/home/jcb/zot" ]
#
fun directories (directory_name: String)
=
{ fun accept_only_nondot_dirs { path, directory_name, name, results }
=
if (is_dot_initial name) results;
elif (is_directory path) path ! results;
else results;
fi;
results = filter_directory_subtree_contents
{
directory_name => canonicalize directory_name,
filter_fn => accept_only_nondot_dirs,
results => []
};
lms::sort_list string::(>) results;
};
# Return alphabetically sorted list of paths
# for all directories in directory subtree,
# excepting . and .. :
#
# [ "/home/jcb/.bashrc", "/home/jcb/.emacs", "/home/jcb/foo", "/home/jcb/src/test.c", "/home/jcb/zot" ]
#
fun directories' (directory_name: String)
=
{ fun accept_only_dirs { path, directory_name, name, results }
=
if (name == ".") results;
elif (name == "..") results;
elif (is_directory path) path ! results;
else results;
fi;
results = filter_directory_subtree_contents
{
directory_name => canonicalize directory_name,
filter_fn => accept_only_dirs,
results => []
};
lms::sort_list string::(>) results;
};
};
end;
## Copyright (c) 1999, 2000 by Lucent Bell Laboratories
## Subsequent changes by Jeff Prothero Copyright (c) 2010-2015,
## released per terms of SMLNJ-COPYRIGHT.