Re: [PATCH] Add "scandir" procedure

[Nala Ginrut]

>From a79c0db1ef1a932443e41ba6185b0d8c1a5774ed Mon Sep 17 00:00:00 2001
From: Nala Ginrut <address@hidden>
Date: Sun, 28 Aug 2011 03:19:15 +0800
Subject: [PATCH] Add scandir procedure

---
 libguile/_scm.h    |    3 ++
 libguile/filesys.c |   98 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 101 insertions(+), 0 deletions(-)

diff --git a/libguile/_scm.h b/libguile/_scm.h
index 48fb2cc..cd3f82c 100644
--- a/libguile/_scm.h
+++ b/libguile/_scm.h
@@ -166,6 +166,9 @@
 #define off_t_or_off64_t                CHOOSE_LARGEFILE(off_t,off64_t)
 #define open_or_open64                  CHOOSE_LARGEFILE(open,open64)
 #define readdir_or_readdir64            CHOOSE_LARGEFILE(readdir,readdir64)
+#define scandir_or_scandir64           CHOOSE_LARGEFILE(scandir,scandir64)
+#define alphasort_or_alphasort64       CHOOSE_LARGEFILE(alphasort,alphasort64)
+#define versionsort_or_versionsort64   
CHOOSE_LARGEFILE(versionsort,versionsort64)
 #if SCM_HAVE_READDIR64_R == 1
 # define readdir_r_or_readdir64_r       CHOOSE_LARGEFILE(readdir_r,readdir64_r)
 #else
diff --git a/libguile/filesys.c b/libguile/filesys.c
index f600328..d4bf2f4 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -1670,6 +1670,104 @@ SCM_DEFINE (scm_opendir, "opendir", 1, 0, 0,
 }
 #undef FUNC_NAME
 
+SCM_DEFINE (scm_scandir, "scandir", 1, 2, 0,
+           (SCM dir, SCM filter, SCM sort),
+           "Return a list which contains all files and directories' name of 
the "
+           "@var{dir}. The @var{sort} is the sort method of the result.\n"
+           "The second arg @var{filter} is a proc with 2 args and return #t "
+           "for keeping this result, and vice versa.\n"
+           "If @var{sort} is unspecified, @code{alplasort} would be default.\n"
+           "The optional @var{sort} must be symbol and could be:"
+           "@defvar{asort} ==> for alphasort\n"
+           "@defvar{vsort} ==> for versionsort")
+#define FUNC_NAME s_scm_scandir
+{
+  struct dirent_or_dirent64 **rdent;
+  int sort_type = 0;
+  int has_filter = 0;
+  int n = 0 ,i = 0;
+  SCM flag;
+  SCM ret = SCM_EOL;
+  SCM *prev;
+  SCM str;
+
+  SCM_VALIDATE_STRING (1, dir);
+
+  if (!SCM_UNBNDP (filter))
+    {
+      SCM_ASSERT (scm_is_true (scm_procedure_p (filter)),
+                 filter ,SCM_ARG2 ,FUNC_NAME);
+      has_filter = 1;
+    }
+  
+  if (!SCM_UNBNDP (sort))
+    {
+      SCM_ASSERT (scm_symbol_p(sort) ,sort ,SCM_ARG3 ,FUNC_NAME);
+      
+      if (scm_is_true (scm_eq_p (sort, scm_from_latin1_symbol ("asort"))))
+       sort_type = 0;  
+      else if (scm_is_true (scm_eq_p (sort, scm_from_latin1_symbol ("vsort"))))
+       sort_type = 1;
+      else
+       scm_error (scm_from_latin1_symbol ("invalid-sort-type"),
+                  "scandir", "Scandir got an invalid sort type: ~S",
+                  scm_list_1 (sort), scm_list_1 (sort));
+    }
+
+  scm_dynwind_begin (0);
+  errno = 0;
+
+  switch (sort_type)
+    {  
+    case 0: 
+      SCM_SYSCALL(n = scandir_or_scandir64 (scm_to_locale_string (dir), 
+                                           &rdent, NULL, 
alphasort_or_alphasort64));
+      break;
+    case 1:
+      SCM_SYSCALL(n = scandir_or_scandir64 (scm_to_locale_string (dir), 
+                                           &rdent, NULL, 
versionsort_or_versionsort64))        ;
+      break;
+    default:
+      SCM_SYSERROR;
+    }
+
+  if (has_filter)
+    {
+      for (prev = &ret;i<n;i++)
+       {
+         str = rdent[i]? scm_from_locale_stringn (rdent[i]->d_name ,NAMLEN 
(rdent[i])) : SCM_EOF_VAL;
+         flag = scm_call_1 (filter ,str);
+         free (rdent[i]);
+
+         if (scm_is_true (flag))
+           {
+             *prev = scm_cons (str ,SCM_EOL);
+             prev = SCM_CDRLOC (*prev);
+           }
+         
+       }
+    }
+  else
+    {
+      for (prev = &ret;i<n;i++)
+       {
+         str = rdent[i]? scm_from_locale_stringn (rdent[i]->d_name ,NAMLEN 
(rdent[i])) : SCM_EOF_VAL;
+         *prev = scm_cons (str ,SCM_EOL);
+         prev = SCM_CDRLOC (*prev);
+         free (rdent[i]);
+       }
+    }
+
+  if (errno != 0)
+    SCM_SYSERROR;
+
+  scm_dynwind_end ();
+
+  free (rdent);
+  
+  return ret;
+}
+#undef FUNC_NAME
 
 /* FIXME: The glibc manual has a portability note that readdir_r may not
    null-terminate its return string.  The circumstances outlined for this
-- 
1.7.0.4