new function: path-cat

* stream.c (path_cat): New function.
(stream_init): Registered path_cat.

* stream.h (path_cat): Declared.

* txr.1: Documented.

3 files changed, 125 insertions, 0 deletions

diff --git a/stream.c b/stream.c
index 13b3e787..9f92dd97 100644
--- a/stream.c
+++ b/stream.c
@@ -4381,6 +4381,45 @@ val dir_name(val path)
   }
 }
 
+val path_cat(val dir_name, val base_name)
+{
+  val dl = length(dir_name);
+  val bl = length(base_name);
+  val ps = static_str(path_sep_chars);
+
+  if (dl == zero)
+    return base_name;
+
+  if (bl == zero)
+    return dir_name;
+
+  if (find(chr_str(dir_name, pred(dl)), ps, nil, nil)) {
+    val bl0 = chr_str(base_name, zero);
+
+    if (bl == one && bl0 == chr('.'))
+      return dir_name;
+
+    if (dl == two && chr_str(dir_name, zero) == chr('.'))
+      return base_name;
+
+    if (!find(bl0, ps, nil, nil))
+      return scat(nil, dir_name, base_name, nao);
+
+    return scat(nil, dir_name, sub(base_name, one, t), nao);
+  }
+
+  if (find(chr_str(base_name, zero), ps, nil, nil))
+    return scat(nil, dir_name, base_name, nao);
+
+  if (bl == one && chr_str(base_name, zero) == chr('.'))
+    return dir_name;
+
+  if (dl == one && chr_str(dir_name, zero) == chr('.'))
+    return base_name;
+
+  return scat(lit("/"), dir_name, base_name, nao);
+}
+
 void stream_init(void)
 {
   prot1(&ap_regex);
@@ -4498,6 +4537,7 @@ void stream_init(void)
   reg_fun(intern(lit("pure-rel-path-p"), user_package), func_n1(pure_rel_path_p));
   reg_fun(intern(lit("base-name"), user_package), func_n1(base_name));
   reg_fun(intern(lit("dir-name"), user_package), func_n1(dir_name));
+  reg_fun(intern(lit("path-cat"), user_package), func_n2(path_cat));
   reg_varl(intern(lit("path-sep-chars"), user_package), static_str(path_sep_chars));
   reg_fun(intern(lit("get-indent-mode"), user_package), func_n1(get_indent_mode));
   reg_fun(intern(lit("test-set-indent-mode"), user_package), func_n3(test_set_indent_mode));
diff --git a/stream.h b/stream.h
index 4484d554..27b3ab22 100644
--- a/stream.h
+++ b/stream.h
@@ -222,5 +222,6 @@ val abs_path_p(val path);
 val pure_rel_path_p(val path);
 val base_name(val path);
 val dir_name(val path);
+val path_cat(val dir_name, val base_name);
 
 void stream_init(void);
diff --git a/txr.1 b/txr.1
index fdf52365..ee903db4 100644
--- a/txr.1
+++ b/txr.1
@@ -42357,6 +42357,90 @@ The
 function returns the remaining part of the effective path, after
 the raw directory prefix.
 
+.coNP Function @ path-cat
+.synb
+.mets (path-cat < dir-path << rel-path )
+.syne
+.desc
+The
+.code path-cat
+function joins the directory path name given by the character
+string argument
+.meta dir-path
+with the relative path name given by
+.metn rel-path ,
+returning the joined path.
+
+The function is related to the functions
+.code dir-name
+and
+.code base-name
+in the following way: if
+.meta p
+is some path denoting an object in the file system, then
+.code "(path-cat (dir-name p) (base-name p))"
+produces a path
+.meta p*
+which denotes the same object. The paths
+.meta p
+and
+.meta p*
+might not be equivalent strings.
+
+The
+.code path-cat
+function ensures that paths are joined without superfluous
+path separator characters, regardless of whether
+.meta dir-path
+ends in a separator.
+
+If a separator must be added, the character
+.code /
+(forward slash) is always used, even on platforms where
+.code \e
+(backslash) is also a pathname separator, and even if either argument includes
+backslashes.
+
+The
+.code path-cat
+function eliminates trivial occurrences of the
+.code .
+(dot) path component. It preserves trailing separators in the following
+way: if
+.meta rel-path
+ends in a path separator character, then the returned string shall
+end in that character; and if
+.meta rel-path
+vanishes entirely because it is equivalent to the dot, then the returned
+string is
+.meta dir-name
+itself.
+
+.TP* Examples:
+
+.cblk
+  (path-cat "" "")    -->  ""
+  (path-cat "" ".")   -->  ""
+  (path-cat "." "")   -->  ""
+  (path-cat "." ".")  -->  ""
+
+  (path-cat "abc" ".")  -->  "abc"
+  (path-cat "." "abc")  -->  "abc"
+
+  (path-cat "./" ".")   -->  "./"
+  (path-cat "."  "./")  -->  "./"
+
+  (path-cat "abc/" ".")  -->  "abc/"
+  (path-cat "./" "abc")  -->  "abc"
+
+  (path-cat "/" ".")    --> "/"
+
+  (path-cat "/" "abc")  --> "/abc"
+
+  (path-cat "ab/cd" "ef")  --> "ab/cd/ef"
+.cble
+
+
 .coNP Variable @ path-sep-chars
 .desc
 The