* filesys.c (dirname, basename): New procedures.
authorMikael Djurfeldt <djurfeldt@nada.kth.se>
Thu, 18 Jun 1998 21:53:16 +0000 (21:53 +0000)
committerMikael Djurfeldt <djurfeldt@nada.kth.se>
Thu, 18 Jun 1998 21:53:16 +0000 (21:53 +0000)
libguile/filesys.c

index 9121b12..6bff653 100644 (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));
+}
 
 \f
 /* {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