mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 03:30:27 +02:00
Code Activity

* filesys.c (dirname, basename): New procedures.

Browse source
This commit is contained in:
Mikael Djurfeldt 1998-06-18 21:53:16 +00:00
parent 3346a90fa7
commit a163dda9ef
1 changed files with 76 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

76
libguile/filesys.c
View file

@ -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