diff options
| -rw-r--r-- | stdlib/doc-syms.tl | 1 | ||||
| -rw-r--r-- | stream.c | 19 | ||||
| -rw-r--r-- | stream.h | 1 | ||||
| -rw-r--r-- | tests/018/path.tl | 38 | ||||
| -rw-r--r-- | txr.1 | 52 |
5 files changed, 111 insertions, 0 deletions
diff --git a/stdlib/doc-syms.tl b/stdlib/doc-syms.tl index 7301068a..ea778779 100644 --- a/stdlib/doc-syms.tl +++ b/stdlib/doc-syms.tl @@ -2045,6 +2045,7 @@ ("trie-value-at" "N-012A1BAD") ("trim-left" "N-00CF29CC") ("trim-long-suffix" "N-03CAC692") + ("trim-path-seps" "N-0362D31C") ("trim-right" "N-00CF29CC") ("trim-short-suffix" "N-03CAC692") ("trim-str" "N-00E6E63B") @@ -5236,6 +5236,24 @@ val trim_long_suffix(val name) } } +val trim_path_seps(val name) +{ + val self = lit("trim-path-seps"); + const wchar_t *str = c_str(name, self); + const wchar_t *psc = L"/\\"; + const wchar_t *fsl = 0; + cnum len = c_num(length_str(name), self); + + if (portable_abs_path_p(name)) + fsl = wcspbrk(str, psc); + + while (len-- > 0) + if (!wcschr(psc, str[len]) || str + len == fsl) + break; + + return string_own(chk_substrdup(str, 0, len + 1)); +} + val add_suffix(val name, val suffix) { val self = lit("add-suffix"); @@ -5604,6 +5622,7 @@ void stream_init(void) reg_fun(intern(lit("long-suffix"), user_package), func_n2o(long_suffix, 1)); reg_fun(intern(lit("trim-short-suffix"), user_package), func_n1(trim_short_suffix)); reg_fun(intern(lit("trim-long-suffix"), user_package), func_n1(trim_long_suffix)); + reg_fun(intern(lit("trim-path-seps"), user_package), func_n1(trim_path_seps)); reg_fun(intern(lit("path-cat"), user_package), func_n0v(path_vcat)); reg_fun(intern(lit("add-suffix"), user_package), func_n2(add_suffix)); reg_varl(intern(lit("path-sep-chars"), user_package), static_str(path_sep_chars)); @@ -263,6 +263,7 @@ val short_suffix(val name, val alt_in); val long_suffix(val name, val alt_in); val trim_short_suffix(val name); val trim_long_suffix(val name); +val trim_path_seps(val name); val path_cat(val dir_name, val base_name); val add_suffix(val name, val suffix); val make_byte_input_stream(val obj); diff --git a/tests/018/path.tl b/tests/018/path.tl index 49aebe11..dd22339f 100644 --- a/tests/018/path.tl +++ b/tests/018/path.tl @@ -280,3 +280,41 @@ (pure-rel-path-p "abc/.") t (pure-rel-path-p "abc\\def") t (pure-rel-path-p "abc\\.") t) + +(mtest + (trim-path-seps "") "" + (trim-path-seps "/") "/" + (trim-path-seps "//") "/" + (trim-path-seps "///") "/" + (trim-path-seps "a///") "a" + (trim-path-seps "/a///") "/a") + +(mtest + (trim-path-seps "c:/") "c:/" + (trim-path-seps "c://") "c:/" + (trim-path-seps "c:///") "c:/" + (trim-path-seps "c:a///") "c:a" + (trim-path-seps "/c:/a///") "/c:/a" + (trim-path-seps "/c://///") "/c:") + +(mtest + (trim-path-seps "\\") "\\" + (trim-path-seps "\\\\") "\\" + (trim-path-seps "\\\\\\") "\\" + (trim-path-seps "a\\\\\\") "a" + (trim-path-seps "\\a\\\\\\") "\\a") + +(mtest + (trim-path-seps "c:\\") "c:\\" + (trim-path-seps "c:\\\\") "c:\\" + (trim-path-seps "c:\\\\\\") "c:\\" + (trim-path-seps "c:a\\\\\\") "c:a" + (trim-path-seps "\\c:\\a\\\\\\") "\\c:\\a" + (trim-path-seps "\\c:\\\\\\\\\\") "\\c:") + +(mtest + (trim-path-seps "/c:\\") "/c:" + (trim-path-seps "c:/\\/\\/") "c:/" + (trim-path-seps "c:a\\\\\\") "c:a" + (trim-path-seps "\\c:\\a/\\\\\\") "\\c:\\a" + (trim-path-seps "/c:\\\\\\\\\\") "/c:") @@ -61248,6 +61248,58 @@ The above semantics imply that the following equivalence holds: (path-cat "a" "b" "" "c" "/") --> "a/b/c/" .brev +.coNP Function @ trim-path-seps +.synb +.mets (trim-path-seps << path ) +.syne +.desc +The +.code trim-path-seps +function removes a consecutive run of one or more trailing separators from the +end of the input string +.metn path . + +The function treats the +.mets path +in a system-independent way: both the backslash and forward slash +are considered a trailing separator. + +The function preserves any necessary trailing separators, such as that of +the absolute path +.str / +or the trailing slashes in volume absolute paths such as +.strn c:/ . + +.TP* Examples: + +.verb + (trim-path-seps "") -> "" + (trim-path-seps "/") -> "/" + (trim-path-seps "//") -> "/" + (trim-path-seps "a///") -> "a" + (trim-path-seps "/a///") -> "/a") + + (trim-path-seps "\e\e") -> "\e\e" + (trim-path-seps "\e\e\e\e") -> "\e\e" + (trim-path-seps "\e\ea\e\e\e\e\e\e") -> "\e\ea") + + (trim-path-seps "c:/") -> "c:/" + (trim-path-seps "c://") -> "c:/" + (trim-path-seps "c:///") -> "c:/" + (trim-path-seps "c:a///") -> "c:a" + + ;; not a volume prefix: + (trim-path-seps "/c:/a///") -> "/c:/a" + (trim-path-seps "/c://///") -> "/c:") + + (trim-path-seps "c:\e\e") -> "c:\e\e" + (trim-path-seps "c:\e\e\e\e") -> "c:\e\e" + (trim-path-seps "c:a\e\e\e\e\e\e") -> "c:a" + + ;; mixtures + (trim-path-seps "c:/\e\e/\e\e/") -> "c:/" +.brev + .coNP Function @ rel-path .synb .mets (rel-path < from-path << to-path ) |