diff options
| -rw-r--r-- | stdlib/doc-syms.tl | 1 | ||||
| -rw-r--r-- | stream.c | 48 | ||||
| -rw-r--r-- | stream.h | 1 | ||||
| -rw-r--r-- | tests/018/path.tl | 19 | ||||
| -rw-r--r-- | txr.1 | 80 |
5 files changed, 149 insertions, 0 deletions
diff --git a/stdlib/doc-syms.tl b/stdlib/doc-syms.tl index c4a116c4..0d69f2a2 100644 --- a/stdlib/doc-syms.tl +++ b/stdlib/doc-syms.tl @@ -94,6 +94,7 @@ ("acosh" "D-0041") ("add" "N-03244398") ("add*" "N-03244398") + ("add-suffix" "N-00AE9981") ("addrinfo" "N-0110E961") ("ado" "N-011CFC0C") ("af-inet" "N-0228EAE0") @@ -5149,6 +5149,53 @@ val trim_long_suffix(val name) } } +val add_suffix(val name, val suffix) +{ + val self = lit("add-suffix"); + size_t len_n = c_unum(length_str(name), self); + size_t len_s = c_unum(length_str(suffix), self); + const wchar_t *psc = coerce(const wchar_t *, path_sep_chars); + const wchar_t *nam = c_str(name, self); + const wchar_t *suf = c_str(suffix, self); + const wchar_t *sl = wcspbrk(nam, psc); + + if (psc[0] == '\\' || 1) { + const wchar_t *set = L"ABCDEFGHIJKLMNOPQRSTUVWXYZ" + L"abcdefghijklmnopqrstuvwxyz" + L"0123456789"; + const wchar_t *drv = nam + wcsspn(nam, set); + if (drv[0] == ':' && sl == drv + 1) { + if (drv - nam > 1) { + if (wcschr(psc, drv[2])) + sl = wcspbrk(drv + 3, psc); + } else if (drv > nam) { + sl = wcspbrk(drv + 2, psc); + } + } + } + + if (sl == nam) + sl = wcspbrk(nam + 1, psc); + + while (sl) { + const wchar_t *nsl = sl + 1 + wcsspn(sl + 1, psc); + + if (*nsl == 0) { + size_t nchar = len_n + len_s + 1; + size_t offs = sl - nam; + wchar_t *out = chk_wmalloc(nchar); + wmemcpy(out, nam, offs); + wmemcpy(out + offs, suf, len_s); + wcscpy(out + offs + len_s, sl); + return string_own(out); + } + + sl = wcspbrk(nsl, psc); + } + + return scat2(name, suffix); +} + val path_cat(val dir_name, val base_name) { val dl = length_str(dir_name); @@ -5474,6 +5521,7 @@ void stream_init(void) 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("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)); 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)); @@ -259,6 +259,7 @@ val long_suffix(val name, val alt_in); val trim_short_suffix(val name); val trim_long_suffix(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); val iobuf_get(void); void iobuf_put(val buf); diff --git a/tests/018/path.tl b/tests/018/path.tl index 62dbda6c..7761e0fe 100644 --- a/tests/018/path.tl +++ b/tests/018/path.tl @@ -134,6 +134,25 @@ (trim-long-suffix "/a.//") "/a//") (mtest + (add-suffix "" "") "" + (add-suffix "" "a") "a" + (add-suffix "." "a") ".a" + (add-suffix "." ".a") "..a" + (add-suffix "/" ".b") "/.b" + (add-suffix "//" ".b") "/.b/" + (add-suffix "//" "b") "/b/" + (add-suffix "a" "") "a" + (add-suffix "a" ".b") "a.b" + (add-suffix "a/" ".b") "a.b/" + (add-suffix "a//" ".b") "a.b//" + + (add-suffix "c://" "x") "c:/x/" + (add-suffix "0://" "x") "0:/x/" + (add-suffix "host://" "x") "host://x" + (add-suffix "host:///" "x") "host://x/" + (add-suffix "1234:///" "x") "1234://x/") + +(mtest (base-name "") "" (base-name "/") "/" (base-name ".") "." @@ -57636,6 +57636,86 @@ characters, these are preserved in the return value. (trim-long-suffix "a.b.c///") -> "a///" .brev +.coNP Function @ add-suffix +.synb +.mets (add-suffix < path << suffix ) +.syne +.desc +The +.code add-suffix +function combines the string arguments +.meta path +and +.meta suffix +in a way which harmonizes with the +.code long-suffix +and +.code short-suffix +functions. + +If +.meta path +does not end in a path separator character, that category being defined by the +.code path-sep-chars +variable, then +.code add-suffix +returns the trivial string catenation of +.meta path +and +.metn suffix . + +Otherwise, +.code add-suffix +returns a string formed by inserting +.meta suffix +into +.meta path +just prior to the sequence of trailing path separator characters. +The returned string is a catenation of that portion of +.meta path +which excludes the sequence of trailing path separators, +followed by +.metn suffix , +followed by the sequence of trailing path separators. + +A path separator which occurs as a part of syntax that indicates an absolute +pathname is not considered a trailing separator. A path which begins with a +separator is absolute. Other platform-specific path patterns may constitute +an absolute pathname. + +Note: in cases when +.meta suffix +does not begin with a period, or is inserted in such a way +that it is the start of a path component, then the functions +.code long-suffix +and +.code short-suffix +will not recognize +.meta suffix +in the resulting path. + +.TP* Examples: + +.verb + (add-suffix "" "") -> "" + (add-suffix "" "a") -> "a" + (add-suffix "." "a") -> ".a" + (add-suffix "." ".a") -> "..a" + (add-suffix "/" ".b") -> "/.b" + (add-suffix "//" ".b") -> "/.b/" + (add-suffix "//" "b") -> "/b/" + (add-suffix "a" "") -> "a" + (add-suffix "a" ".b") -> "a.b" + (add-suffix "a/" ".b") -> "a.b/" + (add-suffix "a//" ".b") -> "a.b//" + + ;; On MS Windows + (add-suffix "c://" "x") -> "c:/x/" + (add-suffix "host://" "x") -> "host://x" + (add-suffix "host:///" "x") -> "host://x/" + +.brev + .coNP Function @ path-cat .synb .mets (path-cat >> [ dir-path <> { rel-path }*]) |