diff options
| -rw-r--r-- | stream.c | 83 | ||||
| -rw-r--r-- | stream.h | 4 | ||||
| -rw-r--r-- | txr.1 | 79 | ||||
| -rw-r--r-- | txr.c | 8 |
4 files changed, 166 insertions, 8 deletions
@@ -89,6 +89,8 @@ val stdio_stream_s; val socket_error_s; #endif +const wchli_t *path_sep_chars = wli("/"); + val shell, shell_arg; void strm_base_init(struct strm_base *s) @@ -4158,12 +4160,89 @@ val pure_rel_path_p(val path) return t; } +static void detect_path_separators(void) +{ +#ifdef __CYGWIN__ + struct utsname un; + + if (uname(&un) >= 0) { + if (strncmp(un.sysname, "CYGNAL", 6) == 0) + path_sep_chars = wli("\\/"); + return; + } +#endif +} + +val base_name(val path) +{ + const wchar_t *wpath = c_str(path); + const wchar_t *end = wpath + c_num(length_str(path)); + const wchar_t *rsep; + const wchar_t *psc = wref(coerce(const wchar_t *, path_sep_chars)); + + if (end == wpath) + return null_string; + + while (wpath < end && wcschr(psc, end[-1])) + end--; + + if (end == wpath) + return lit("/"); + + for (rsep = end; + wpath < rsep && wcschr(psc, rsep[-1]) == 0; + rsep--) + ; /* *empty */ + + + { + val base = mkustring(num_fast(end - rsep)); + return init_str(base, rsep); + } +} + +val dir_name(val path) +{ + const wchar_t *wpath = c_str(path); + const wchar_t *rsep = wpath + c_num(length_str(path)); + const wchar_t *psc = wref(coerce(const wchar_t *, path_sep_chars)); + + if (rsep == wpath) + return lit("."); + + if (wcschr(psc, rsep[-1])) + rsep--; + + if (rsep == wpath) { + wchar_t root[2] = { psc[0] }; + return string(root); + } + + for (; rsep > wpath && wcschr(psc, rsep[-1]) == 0; rsep--) + ; /* *empty */ + + if (rsep == wpath + 1) { + wchar_t root[2] = { psc[0] }; + return string(root); + } + + if (rsep == wpath) + return lit("."); + + + { + val base = mkustring(num_fast(rsep - wpath - 1)); + return init_str(base, wpath); + } +} + void stream_init(void) { prot1(&ap_regex); prot1(&plp_regex); detect_format_string(); + detect_path_separators(); from_start_k = intern(lit("from-start"), keyword_package); from_current_k = intern(lit("from-current"), keyword_package); @@ -4270,7 +4349,9 @@ 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("dir-name"), user_package), func_n1(dir_name)); + 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)); reg_fun(intern(lit("set-indent-mode"), user_package), func_n2(set_indent_mode)); @@ -129,6 +129,8 @@ extern val pprint_flo_format_s, print_base_s, print_circle_s; extern val socket_error_s; #endif +extern const wchli_t *path_sep_chars; + void strm_base_init(struct strm_base *s); void strm_base_cleanup(struct strm_base *s); void strm_base_mark(struct strm_base *s); @@ -213,5 +215,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 dir_name(val path); void stream_init(void); @@ -41445,6 +41445,85 @@ Examples of strings which are not pure relative paths: $:\eabc .cble +.coNP Functions @ dir-name and @ base-name +.synb +.mets (dir-name << path ) +.mets (base-name << path ) +.syne +.desc +The +.code dir-name +and +.code base-name +functions calculate, respective, the directory part and +base name part of a path name. + +The calculation is performed in a platform-dependent way, using the +characters in the variable +.code path-sep-chars +as path component separators. + +Both functions first remove from any further consideration all superfluous +trailing occurrences of the directory separator characters from +.codn path . +Thus input such as +.str "a////" +is reduced to just +.strn "a" , +and +.str "///" +is reduced to +.strn "/" . + +The resulting trimmed path is the +.I "effective path" . + +If the effective path is an empty string, then +.code dir-name +returns +.str "." +and +.code base-name +returns the empty string. + +If the effective path is not empty, and contains no path separator +characters, then +.code dir-name +returns +.str "." +and +.code base-name +returns the effective path. + +Otherwise, the effective path is divided into two parts: the +.I "raw directory prefix" +and the remainder. + +The raw directory path is the maximally long prefix of the effective +path which ends in a separator character. + +The +.code dir-name +function returns the raw directory prefix, if that prefix consists of +nothing but a single directory separator character. Otherwise it +returns the raw directory prefix, with the trailing path separator +removed. + +The +.code base-name +function returns the remaining part of the effective path, after +the raw directory prefix. + +.coNP Variable @ path-sep-chars +.desc +The +.code path-sep-chars +variable holds a string consisting of the characters which the underlying +operating system recognizes as path name separators. + +Altering the value of this variable has no effect on any \*(TL library +function. + .coNP Functions @ read and @ iread .synb .mets (read >> [ source >> [ error-stream >> [ error-retval <> [ name ]]]]) @@ -273,12 +273,6 @@ static val maybe_sysroot(val exepart) sysroot_path = sub_str(prog_path, 0, neg(length(exepart)))); } -static val dirname(val path) -{ - val rslash = rpos(chr('/'), path, nil, nil); - return if3(rslash, sub_str(path, zero, succ(rslash)), path); -} - static val substitute_basename(val edited_path, val source_path) { val lslash = rpos(chr('/'), edited_path, nil, nil); @@ -311,7 +305,7 @@ static void sysroot_init(void) #if HAVE_WINDOWS_H prog_path = regsub(slash, lit("/"), prog_path); #endif - prog_dir = dirname(prog_path); + prog_dir = dir_name(prog_path); if (!(maybe_sysroot(lit(TXR_REL_PATH)) || maybe_sysroot(lit(TXR_REL_PATH EXE_SUFF)) || |