1 files changed, 143 insertions, 0 deletions
diff --git a/ipl/procs/gdl.icn b/ipl/procs/gdl.icn
new file mode 100644
index 0000000..57aa0e8
--- /dev/null
+++ b/ipl/procs/gdl.icn
@@ -0,0 +1,143 @@
+############################################################################
+#
+#	File:     gdl.icn
+#
+#	Subject:  Procedures to get directory lists
+#
+#	Author:   Richard L. Goerwitz
+#
+#	Date:	  May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Version:  1.3
+#
+############################################################################
+#
+#  Gdl returns a list containing everything in a directory (whose name
+#  must be passed as an argument to gdl).  Nothing fancy.  I use this file
+#  as a template, modifying the procedures according to the needs of the
+#  program in which they are used.
+#
+############################################################################
+#
+#  Requires:  UNIX or MS-DOS
+#
+############################################################################
+
+
+procedure gdl(dir)
+
+    local getdir
+    getdir := set_getdir_by_os()
+    return getdir(dir)
+
+end
+
+
+
+procedure set_getdir_by_os()
+
+    # Decide how to get a directory, based on whether we are running
+    # under Unix or MS-DOS.
+
+    if find("UNIX", &features)
+    then return unix_get_dir
+    else if find("MS-DOS", &features)
+    then return msdos_get_dir
+    else stop("Your operating system is not (yet) supported.")
+
+end
+
+
+
+procedure msdos_get_dir(dir)
+
+    # Returns a sorted list of all filenames (full paths included) in
+    # directory "dir."  The list is sorted.  Fails on invalid or empty
+    # directory.  Aborts if temp file cannot be opened.
+    #
+    # Temp files can be directed to one or another directory either by
+    # manually setting the variable temp_dir below, or by setting the
+    # value of the environment variable TEMPDIR to an appropriate
+    # directory name.
+
+    local in_dir, filename_list, line, temp_name, filename
+    static temp_dir
+    initial {
+        temp_dir := 
+            (trim(map(getenv("TEMPDIR"), "/", "\\"), '\\') || "\\") |
+                ".\\"
+    }
+
+    # Get name of tempfile to be used.
+    temp_name := get_dos_tempname(temp_dir) |
+	stop("No more available tempfile names!")
+
+    # Make sure we have an unambiguous directory name, with backslashes
+    # instead of Unix-like forward slashes.
+    dir := trim(map(dir, "/", "\\"), '\\')
+
+    # Put dir listing into a temp file.
+    system("dir "||dir||" > "||temp_name)
+
+    # Put tempfile entries into a list, removing blank- and
+    # space-initial lines.  Exclude directories (i.e. return file
+    # names only).
+    in_dir := open(temp_name,"r") |
+	stop("Can't open temp file in directory ",temp_dir,".")
+    filename_list := list()
+    every filename := ("" ~== !in_dir) do {
+        match(" ",filename) | find(" <DIR>", filename) & next
+	# Exclude our own tempfiles (may not always be appropriate).
+	filename ?:= trim(trim(tab(10)) || "." || tab(13), '. ')
+	put(filename_list, map(dir || filename))
+    }
+
+    # Clean up.
+    close(in_dir) & remove(temp_name)
+
+    # Check to be sure we actually managed to read some files.
+    if *filename_list = 0 then fail
+    else return sort(filename_list)
+
+end
+
+
+
+procedure get_dos_tempname(dir)
+    local temp_name, temp_file
+
+    # Don't clobber existing files.  Get a unique temp file name for
+    # use as a temporary storage site.
+
+    every temp_name := dir || "icondir." || right(string(1 to 999),3,"0") do {
+	temp_file := open(temp_name,"r") | break
+        close(temp_file)
+    }
+    return \temp_name
+
+end
+
+
+
+procedure unix_get_dir(dir)
+    local filename_list, in_dir, filename
+
+    dir := trim(dir, '/') || "/"
+    filename_list := list()
+    in_dir := open("/bin/ls -F "||dir, "pr")
+    every filename := ("" ~== !in_dir) do {
+	match("/",filename,*filename) & next
+	put(filename_list, trim(dir || filename, '*'))
+    }
+    close(in_dir)
+
+    if *filename_list = 0 then fail
+    else return filename_list
+
+end