From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: nalaginrut@gmail.com(Nala Ginrut) Newsgroups: gmane.lisp.guile.devel Subject: Re: [PATCH] Add "scandir" procedure Date: Sun, 28 Aug 2011 04:18:13 +0800 Message-ID: <4e595105.RVW6uZ7Gm1YuDCMt%nalaginrut@gmail.com> NNTP-Posting-Host: lo.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=us-ascii Content-Transfer-Encoding: 7bit X-Trace: dough.gmane.org 1314476311 8962 80.91.229.12 (27 Aug 2011 20:18:31 GMT) X-Complaints-To: usenet@dough.gmane.org NNTP-Posting-Date: Sat, 27 Aug 2011 20:18:31 +0000 (UTC) To: guile-devel@gnu.org Original-X-From: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Sat Aug 27 22:18:27 2011 Return-path: Envelope-to: guile-devel@m.gmane.org Original-Received: from lists.gnu.org ([140.186.70.17]) by lo.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1QxPKk-0002PE-FZ for guile-devel@m.gmane.org; Sat, 27 Aug 2011 22:18:26 +0200 Original-Received: from localhost ([::1]:42724 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1QxPKj-00034r-6H for guile-devel@m.gmane.org; Sat, 27 Aug 2011 16:18:25 -0400 Original-Received: from eggs.gnu.org ([140.186.70.92]:52688) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1QxPKg-000342-Lf for guile-devel@gnu.org; Sat, 27 Aug 2011 16:18:23 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1QxPKf-0004pp-FO for guile-devel@gnu.org; Sat, 27 Aug 2011 16:18:22 -0400 Original-Received: from mail-pz0-f44.google.com ([209.85.210.44]:57638) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1QxPKf-0004pl-8s for guile-devel@gnu.org; Sat, 27 Aug 2011 16:18:21 -0400 Original-Received: by pzk36 with SMTP id 36so7265493pzk.17 for ; Sat, 27 Aug 2011 13:18:20 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=gamma; h=date:from:to:subject:message-id:user-agent:mime-version :content-type:content-transfer-encoding; bh=DgMATqbgr2GZBzeXeS2NPI/ddbtWPkDrS3V6/gOmUCo=; b=Q6OtPlz5qT3yuFpmeH8sDXhiBoOXWltAQ+kZlmy9cuGsaF1Nej84/qO48B0MxIySnB iQPk+tckVvVHzNTXBksDg2x+65gVjiqqLoELRdbIfz520PV82FsiKC9UfzqxicbO/GT1 bQC0irTgDrucS93bjoRJ2dui1OdULaU11Kroc= Original-Received: by 10.143.93.4 with SMTP id v4mr1332461wfl.389.1314476300531; Sat, 27 Aug 2011 13:18:20 -0700 (PDT) Original-Received: from Renee-desktop ([113.97.239.50]) by mx.google.com with ESMTPS id x6sm8776754pba.5.2011.08.27.13.18.17 (version=SSLv3 cipher=OTHER); Sat, 27 Aug 2011 13:18:19 -0700 (PDT) User-Agent: Heirloom mailx 12.4 7/29/08 X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6 (newer, 2) X-Received-From: 209.85.210.44 X-BeenThere: guile-devel@gnu.org X-Mailman-Version: 2.1.14 Precedence: list List-Id: "Developers list for Guile, the GNU extensibility library" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Original-Sender: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.lisp.guile.devel:12723 Archived-At: >From a79c0db1ef1a932443e41ba6185b0d8c1a5774ed Mon Sep 17 00:00:00 2001 From: Nala Ginrut 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;id_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;id_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