From a5e69db365a98857ac2594590614a981d5f9ae74 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Fri, 9 Aug 2019 06:28:58 -0700
Subject: base-name: optionally remove suffix.
The base-name function now takes a second argument which is
optional, specifying a suffix to be removed. The behavior is
similar to that of the second argument of the POSIX basename
command.
* stream.c (base_name): Second argument added. If present, the
returned value is adjusted by trimming the suffix, unless that
would cause an empty string to be returned.
(stream_init): Update registration of base-name intrinsic.
* stream.h (base_name): Declaration updated.
* txr.1: New base-name parameter documented.
---
stream.c | 10 +++++++---
stream.h | 2 +-
txr.1 | 13 ++++++++++++-
3 files changed, 20 insertions(+), 5 deletions(-)
diff --git a/stream.c b/stream.c
index 4cad323d..5e0073ed 100644
--- a/stream.c
+++ b/stream.c
@@ -4486,7 +4486,7 @@ static void detect_path_separators(void)
#endif
}
-val base_name(val path)
+val base_name(val path, val suff)
{
const wchar_t *wpath = c_str(path);
const wchar_t *end = wpath + c_num(length_str(path));
@@ -4510,7 +4510,11 @@ val base_name(val path)
{
val base = mkustring(num_fast(end - rsep));
- return init_str(base, rsep);
+ init_str(base, rsep);
+ return if3(!null_or_missing_p(suff) && ends_with(suff, base, nil, nil) &&
+ neql(length(suff), length(base)),
+ sub(base, zero, neg(length(suff))),
+ base);
}
}
@@ -4771,7 +4775,7 @@ void stream_init(void)
reg_fun(intern(lit("open-files*"), user_package), func_n2o(open_files_star, 1));
reg_fun(intern(lit("abs-path-p"), user_package), func_n1(abs_path_p));
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("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("path-cat"), user_package), func_n2(path_cat));
reg_varl(intern(lit("path-sep-chars"), user_package), static_str(path_sep_chars));
diff --git a/stream.h b/stream.h
index bc83122c..9bae897c 100644
--- a/stream.h
+++ b/stream.h
@@ -236,7 +236,7 @@ val remove_path(val path, val throw_on_error);
val rename_path(val from, val to);
val abs_path_p(val path);
val pure_rel_path_p(val path);
-val base_name(val path);
+val base_name(val path, val suff);
val dir_name(val path);
val path_cat(val dir_name, val base_name);
val make_byte_input_stream(val obj);
diff --git a/txr.1 b/txr.1
index ae2f3563..c46a07a5 100644
--- a/txr.1
+++ b/txr.1
@@ -48234,7 +48234,7 @@ Examples of strings which are not pure relative paths:
.coNP Functions @ dir-name and @ base-name
.synb
.mets (dir-name << path )
-.mets (base-name << path )
+.mets (base-name < path <> [ suffix ])
.syne
.desc
The
@@ -48300,6 +48300,17 @@ The
function returns the remaining part of the effective path, after
the raw directory prefix.
+If the
+.meta suffix
+argument is given to
+.codn base-name ,
+then the returned base name is adjusted as follows. If the base
+name ends in
+.meta suffix
+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 Function @ path-cat
.synb
.mets (path-cat < dir-path << rel-path )
--
cgit v1.2.3