diff options
author | Mikael Djurfeldt <djurfeldt@nada.kth.se> | 1998-06-18 21:53:16 +0000 |
---|---|---|
committer | Mikael Djurfeldt <djurfeldt@nada.kth.se> | 1998-06-18 21:53:16 +0000 |
commit | a163dda9ef4c43b43ead4c1b182f687a0bf82f19 (patch) | |
tree | 8df67c646bc546b00464f9fc64a64aa47608ec74 /libguile/filesys.c | |
parent | 3346a90fa74d399fd500e07b6b28fbdc7812722d (diff) | |
download | guile-a163dda9ef4c43b43ead4c1b182f687a0bf82f19.tar.gz |
* filesys.c (dirname, basename): New procedures.
Diffstat (limited to 'libguile/filesys.c')
-rw-r--r-- | libguile/filesys.c | 76 |
1 files changed, 76 insertions, 0 deletions
diff --git a/libguile/filesys.c b/libguile/filesys.c index 9121b12bb..6bff65346 100644 --- a/libguile/filesys.c +++ b/libguile/filesys.c @@ -461,6 +461,80 @@ scm_stat (object) return scm_stat2scm (&stat_temp); } +SCM scm_dot_string; + +SCM_PROC (s_dirname, "dirname", 1, 0, 0, scm_dirname); + +SCM +scm_dirname (SCM filename) +{ + char *s; + int i, len; + SCM_ASSERT (SCM_NIMP (filename) && SCM_ROSTRINGP (filename), + filename, + SCM_ARG1, + s_dirname); + s = SCM_ROCHARS (filename); + len = SCM_LENGTH (filename); + i = len - 1; + while (i >= 0 && s[i] == '/') --i; + while (i >= 0 && s[i] != '/') --i; + while (i >= 0 && s[i] == '/') --i; + if (i < 0) + { + if (len > 0 && s[0] == '/') + return scm_make_shared_substring (filename, SCM_INUM0, SCM_MAKINUM (1)); + else + return scm_dot_string; + } + else + return scm_make_shared_substring (filename, SCM_INUM0, SCM_MAKINUM (i + 1)); +} + +SCM_PROC (s_basename, "basename", 1, 1, 0, scm_basename); + +SCM +scm_basename (SCM filename, SCM suffix) +{ + char *f, *s = 0; + int i, j, len, end; + SCM_ASSERT (SCM_NIMP (filename) && SCM_ROSTRINGP (filename), + filename, + SCM_ARG1, + s_basename); + SCM_ASSERT (SCM_UNBNDP (suffix) + || (SCM_NIMP (suffix) && SCM_ROSTRINGP (suffix)), + suffix, + SCM_ARG2, + s_basename); + f = SCM_ROCHARS (filename); + if (SCM_UNBNDP (suffix)) + j = -1; + else + { + s = SCM_ROCHARS (suffix); + j = SCM_LENGTH (suffix) - 1; + } + len = SCM_LENGTH (filename); + i = len - 1; + while (i >= 0 && f[i] == '/') --i; + end = i; + while (i >= 0 && j >= 0 && f[i] == s[j]) --i, --j; + if (j == -1) + end = i; + while (i >= 0 && f[i] != '/') --i; + if (i == end) + { + if (len > 0 && f[0] == '/') + return scm_make_shared_substring (filename, SCM_INUM0, SCM_MAKINUM (1)); + else + return scm_dot_string; + } + else + return scm_make_shared_substring (filename, + SCM_MAKINUM (i + 1), + SCM_MAKINUM (end + 1)); +} /* {Modifying Directories} @@ -1340,6 +1414,8 @@ scm_init_filesys () scm_tc16_dir = scm_newsmob (&dir_smob); + scm_dot_string = scm_permanent_object (scm_makfrom0str (".")); + #ifdef O_RDONLY scm_sysintern ("O_RDONLY", scm_long2num (O_RDONLY)); #endif |