New functions: long-suffix, short-suffix.

* stream.c (short_suffix, long_suffix): New functions.
(stream_init): short-suffix and long-suffix intrinsics
registered.

* stream.c (short_suffix, long_suffix): Declared.

* tests/018/path.tl: New file.

* txr.1: Documented.

* share/txr/stdlib/doc-syms.tl: Updated.

5 files changed, 116 insertions, 0 deletions

diff --git a/share/txr/stdlib/doc-syms.tl b/share/txr/stdlib/doc-syms.tl
index 36e1e197..006cf9d1 100644
--- a/share/txr/stdlib/doc-syms.tl
+++ b/share/txr/stdlib/doc-syms.tl
@@ -1134,6 +1134,7 @@
       ("logtrunc" "D-0075")
       ("logxor" "N-02D5AF97")
       ("long" "N-018C7C8C")
+      ("long-suffix" "N-00A3183A")
       ("longlong" "N-02299408")
       ("lop" "N-017F3A22")
       ("lset" "N-008216EC")
@@ -1645,6 +1646,7 @@
       ("sha256-stream" "N-006C94B6")
       ("shift" "N-01AC8471")
       ("short" "N-018C7C8C")
+      ("short-suffix" "N-00A3183A")
       ("shuffle" "N-01F12561")
       ("shut-rd" "N-028953A4")
       ("shut-rdwr" "N-028953A4")
diff --git a/stream.c b/stream.c
index c5991bd3..00b4f8d8 100644
--- a/stream.c
+++ b/stream.c
@@ -5014,6 +5014,20 @@ val dir_name(val path)
   }
 }
 
+val short_suffix(val name, val alt_in)
+{
+  const wchar_t *str = c_str(name);
+  const wchar_t *dot = wcsrchr(str, '.');
+  return if3(dot, string(dot + 1), default_null_arg(alt_in));
+}
+
+val long_suffix(val name, val alt_in)
+{
+  const wchar_t *str = c_str(name);
+  const wchar_t *dot = wcschr(str, '.');
+  return if3(dot, string(dot + 1), default_null_arg(alt_in));
+}
+
 val path_cat(val dir_name, val base_name)
 {
   val dl = length(dir_name);
@@ -5309,6 +5323,8 @@ 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_n2o(base_name, 1));
   reg_fun(intern(lit("dir-name"), user_package), func_n1(dir_name));
+  reg_fun(intern(lit("short-suffix"), user_package), func_n2o(short_suffix, 1));
+  reg_fun(intern(lit("long-suffix"), user_package), func_n2o(long_suffix, 1));
   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));
diff --git a/stream.h b/stream.h
index 4c2f6a0e..30971c8c 100644
--- a/stream.h
+++ b/stream.h
@@ -248,6 +248,8 @@ val abs_path_p(val path);
 val pure_rel_path_p(val path);
 val base_name(val path, val suff);
 val dir_name(val path);
+val short_suffix(val name, val alt_in);
+val long_suffix(val name, val alt_in);
 val path_cat(val dir_name, val base_name);
 val make_byte_input_stream(val obj);
 val iobuf_get(void);
diff --git a/tests/018/path.tl b/tests/018/path.tl
new file mode 100644
index 00000000..be95d6c1
--- /dev/null
+++ b/tests/018/path.tl
@@ -0,0 +1,34 @@
+(load "../common")
+
+(mtest
+  (short-suffix 42) :error
+  (short-suffix #\a) :error
+  (short-suffix "") nil
+  (short-suffix "" 0) 0
+  (short-suffix "a") nil
+  (short-suffix "a" 0) 0
+  (short-suffix ".") ""
+  (short-suffix "a.") ""
+  (short-suffix "a.b.") ""
+  (short-suffix ".c") "c"
+  (short-suffix "a.c") "c"
+  (short-suffix "a.b.c") "c"
+  (short-suffix "foo.txt.gz") "gz"
+  (short-suffix ".gz") "gz")
+
+(mtest
+  (long-suffix 42) :error
+  (long-suffix #\a) :error
+  (long-suffix "") nil
+  (long-suffix "" 0) 0
+  (long-suffix "a") nil
+  (long-suffix "a" 0) 0
+  (long-suffix ".") ""
+  (long-suffix "a.") ""
+  (long-suffix "a.b.") "b."
+  (long-suffix ".c") "c"
+  (long-suffix "a.c") "c"
+  (long-suffix "a.b.c") "b.c"
+  (long-suffix "foo.txt.gz") "txt.gz"
+  (long-suffix ".gz") "gz"
+  (long-suffix ".txt.gz") "txt.gz")
diff --git a/txr.1 b/txr.1
index 720762c9..f358e423 100644
--- a/txr.1
+++ b/txr.1
@@ -57051,6 +57051,68 @@ then a trimmed version of the base name is returned instead, with that suffix
 removed. This adjustment isn't performed if it would result in an empty
 string being returned.
 
+.coNP Functions @ long-suffix and @ short-suffix
+.synb
+.mets (long-suffix < path <> [ alt ])
+.mets (short-suffix < path <> [ alt ])
+.syne
+.desc
+The
+.code long-suffix
+and
+.code short-suffix
+functions calculate the
+.I "long suffix"
+and
+.I "short suffix"
+of
+.metn path ,
+which must be a string.
+
+If
+.meta path
+does not contain any occurrences of the character
+.code .
+(period) then it does not have a suffix. In this situation, both
+functions return the
+.meta alt
+argument, which defaults to
+.code nil
+if it is omitted.
+
+Otherwise the long and short suffix is the substring of
+.meta path
+consisting of all the characters which follow the delimiting period.
+The delimiting period for the long suffix is the leftmost period;
+the delimiting period for the short suffix is the rightmost period.
+
+If the delimiting period is the rightmost character of
+.metn path ,
+then the suffix delimited by that period is the empty string.
+
+If
+.meta path
+contains only one period, then its long and short suffix coincide.
+
+.TP* Examples:
+
+.verb
+  (short-suffix "") -> nil
+  (short-suffix ".") -> ""
+  (short-suffix "abc") -> nil
+  (short-suffix "abc" "") -> ""
+  (short-suffix "abc.") -> ""
+  (short-suffix "abc.tar") -> "tar"
+  (short-suffix "abc.tar.gz") -> "gz"
+
+  (long-suffix "") -> nil
+  (long-suffix ".") -> ""
+  (long-suffix "abc") -> nil
+  (long-suffix "abc.") -> ""
+  (long-suffix "abc.tar") -> "txt"
+  (long-suffix "abc.tar.gz") -> "tar.gz"
+.brev
+
 .coNP Function @ path-cat
 .synb
 .mets (path-cat < dir-path << rel-path )