summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--stream.c10
-rw-r--r--sysif.c107
-rw-r--r--txr.1140
-rw-r--r--utf8.c10
-rw-r--r--utf8.h3
5 files changed, 258 insertions, 12 deletions
diff --git a/stream.c b/stream.c
index d9bd7992..bd22a5e5 100644
--- a/stream.c
+++ b/stream.c
@@ -25,6 +25,7 @@
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*/
+#define UTF8_DECL_OPENDIR
#include <stdio.h>
#include <string.h>
#include <stddef.h>
@@ -4052,15 +4053,6 @@ val get_string(val stream_in, val nchars, val close_after_p)
return get_string_from_stream(strstream);
}
-static DIR *w_opendir(const wchar_t *wname)
-{
- char *name = utf8_dup_to(wname);
- DIR *d = opendir(name);
- free(name);
- return d;
-}
-
-
val open_directory(val path)
{
DIR *d = w_opendir(c_str(path));
diff --git a/sysif.c b/sysif.c
index 21bf00b4..12509c85 100644
--- a/sysif.c
+++ b/sysif.c
@@ -25,10 +25,12 @@
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*/
+#define UTF8_DECL_OPENDIR
#include <stddef.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
+#include <dirent.h>
#include <wchar.h>
#include <signal.h>
#include <errno.h>
@@ -108,10 +110,10 @@ val dev_s, ino_s, mode_s, nlink_s, uid_s;
val gid_s, rdev_s, size_s, blksize_s, blocks_s;
val atime_s, mtime_s, ctime_s;
val atime_nsec_s, mtime_nsec_s, ctime_nsec_s;
-val path_s;
+val path_s, dir_s, dirent_s;
#if HAVE_PWUID
-val passwd_s, gecos_s, dir_s, shell_s;
+val passwd_s, gecos_s, shell_s;
#endif
#if HAVE_GRGID
@@ -133,6 +135,8 @@ val dlhandle_s, dlsym_s;
static val at_exit_list;
+static val dirent_st;
+
static val errno_wrap(val newval)
{
val self = lit("errno");
@@ -2219,9 +2223,74 @@ static val isatty_wrap(val spec)
}
#endif
+struct dir {
+ DIR *dir;
+ val path;
+};
+
+static void opendir_free(val obj)
+{
+ struct dir *d = coerce(struct dir *, obj->co.handle);
+ closedir(d->dir);
+ free(d);
+}
+
+static void opendir_mark(val obj)
+{
+ struct dir *d = coerce(struct dir *, obj->co.handle);
+ gc_mark(d->path);
+}
+
+static struct cobj_ops opendir_ops = cobj_ops_init(eq,
+ cobj_print_op,
+ opendir_free,
+ opendir_mark,
+ cobj_eq_hash_op);
+static val opendir_wrap(val path, val prefix_p)
+{
+ DIR *dir = w_opendir(c_str(path));
+
+ if (dir == 0) {
+ uw_throwf(system_error_s, lit("opendir failed for ~a: ~d/~s"),
+ path, num(errno), errno_to_str(errno), nao);
+ } else {
+ struct dir *d = coerce(struct dir *, chk_malloc(sizeof *d));
+ d->dir = dir;
+ d->path = if2(default_null_arg(prefix_p), path);
+ return cobj(coerce(mem_t *, d), dir_s, &opendir_ops);
+ }
+}
+
+static val readdir_wrap(val dirobj, val dirent_in)
+{
+ val self = lit("readdir");
+ struct dir *d = coerce(struct dir *, cobj_handle(self, dirobj, dir_s));
+ struct dirent *dent = readdir(d->dir);
+
+ if (dent == 0) {
+ return nil;
+ } else {
+ args_decl(args, ARGS_MIN);
+ val dirent = default_arg(dirent_in, make_struct(dirent_st, nil, args));
+ slotset(dirent, name_s,
+ if3(d->path,
+ path_cat(d->path, string_utf8(dent->d_name)),
+ string_utf8(dent->d_name)));
+ slotset(dirent, ino_s, num(dent->d_ino));
+#ifdef _DIRENT_HAVE_D_TYPE
+ slotset(dirent, type_s, num(dent->d_type));
+#else
+ if (dirent_in == dirent)
+ slotset(dirent, type_s, nil);
+#endif
+ return dirent;
+ }
+}
+
void sysif_init(void)
{
prot1(&at_exit_list);
+ prot1(&dirent_st);
atexit(at_exit_handler);
@@ -2256,10 +2325,11 @@ void sysif_init(void)
mtime_nsec_s = intern(lit("mtime-nsec"), user_package);
ctime_nsec_s = intern(lit("ctime-nsec"), user_package);
path_s = intern(lit("path"), user_package);
+ dir_s = intern(lit("dir"), user_package);
+ dirent_s = intern(lit("dirent"), user_package);
#if HAVE_PWUID
passwd_s = intern(lit("passwd"), user_package);
gecos_s = intern(lit("gecos"), user_package);
- dir_s = intern(lit("dir"), user_package);
shell_s = intern(lit("shell"), user_package);
#endif
#if HAVE_GRGID
@@ -2783,4 +2853,35 @@ void sysif_init(void)
#if HAVE_ISATTY
reg_fun(intern(lit("isatty"), user_package), func_n1(isatty_wrap));
#endif
+
+ dirent_st = make_struct_type(dirent_s, nil, nil,
+ list(name_s, ino_s, type_s, nao),
+ nil, nil, nil, nil);
+ reg_fun(intern(lit("opendir"), user_package), func_n2o(opendir_wrap, 1));
+ reg_fun(intern(lit("readdir"), user_package), func_n2o(readdir_wrap, 1));
+
+#ifdef DT_BLK
+ reg_varl(intern(lit("dt-blk"), user_package), num_fast(DT_BLK));
+#endif
+#ifdef DT_CHR
+ reg_varl(intern(lit("dt-chr"), user_package), num_fast(DT_CHR));
+#endif
+#ifdef DT_DIR
+ reg_varl(intern(lit("dt-dir"), user_package), num_fast(DT_DIR));
+#endif
+#ifdef DT_FIFO
+ reg_varl(intern(lit("dt-fifo"), user_package), num_fast(DT_FIFO));
+#endif
+#ifdef DT_LNK
+ reg_varl(intern(lit("dt-lnk"), user_package), num_fast(DT_LNK));
+#endif
+#ifdef DT_REG
+ reg_varl(intern(lit("dt-reg"), user_package), num_fast(DT_REG));
+#endif
+#ifdef DT_SOCK
+ reg_varl(intern(lit("dt-sock"), user_package), num_fast(DT_SOCK));
+#endif
+#ifdef DT_UNKNOWN
+ reg_varl(intern(lit("dt-unknown"), user_package), num_fast(DT_UNKNOWN));
+#endif
}
diff --git a/txr.1 b/txr.1
index bb8cf70f..18108c2d 100644
--- a/txr.1
+++ b/txr.1
@@ -18080,6 +18080,8 @@ brackets indicate a plurality of types which are not listed by name:
| |
| +--- cptr
| |
+ | +--- dir
+ | |
| +--- struct-type
| |
| +--- <all structures>
@@ -62462,6 +62464,15 @@ the form of the analogous Lisp function
.codn ftw ,
accompanied by some numeric constants.
+Likewise, on platforms where the POSIX functions
+.code opendir
+and
+.code readdir
+are available, \*(TX provides the functionality in the form of same-named
+Lisp functions, a structure type named
+.code dirent
+and some accompanying numeric constants.
+
.coNP Variables @, ftw-phys @, ftw-mount @, ftw-chdir @ ftw-depth and @ ftw-actionretval
.desc
These variables hold numeric values that may be combined into a single
@@ -62730,6 +62741,135 @@ which surrounds the
.code ftw
call. Such an attempt is detected and diagnosed by an exception.
+.coNP Structure @ dirent
+.synb
+.mets (defstruct dirent nil
+.mets \ \ name ino type)
+.syne
+.desc
+Objects of the
+.code dirent
+structure type are returned by the
+.code readdir
+function.
+
+The
+.code name
+slot is a character string giving the name of the directory entry.
+If the
+.code opendir
+function's
+.meta prefix-p
+argument is specified as true,
+then
+.code readdir
+operations produce
+.code dirent
+structures whose
+.code name
+slot is a path formed by combining the directory path with the directory
+entry name.
+
+The
+.code ino
+slot is an integer giving the inode number of the object named by the
+directory entry.
+
+The
+.code type
+slot indicates the type of the object, which is an integer code. Support for
+this member is platform-dependent. If the directory traversal doesn't provide
+the information, then this slot takes on the
+.code nil
+value. In this situation, if the information requires type information about
+the object, it must use the
+.code stat
+function to obtain it in a different form.
+
+.coNP Variables @, dt-blk @, dt-chr @, dt-dir @, dt-fifo @, dt-lnk @, dt-reg @ dt-sock and @ dt-unknown
+.desc
+These variables give the possible type code values exhibited by the
+.code type
+slot of the
+.code dirent
+structure.
+If this information is not available, then these variables do not exist.
+
+.coNP Function @ opendir
+.synb
+.mets (opendir < dir-path <> [ prefix-p ])
+.syne
+.desc
+The
+.code opendir
+function initiates a traversal of the directory object named by the
+string argument
+.metn dir-path ,
+which must be the name of a directory. If
+.code opendir
+is not able to open the directory traversal, it throws an exception of type
+.codn system-error .
+Otherwise an object of type
+.code dir
+is returned, which is a directory traversal handle suitable as an argument
+for the
+.code readdir
+function.
+
+If the
+.meta prefix-p
+argument is specified and has a true value, then it indicates that
+the subsequent
+.code readdir
+operations should produce the value of the
+.code name
+slot of the
+.code dirent
+structure by combining
+.meta dir-path
+with the directory entry name using the
+.code path-cat
+function.
+
+.coNP Function @ readdir
+.synb
+.mets (readdir < dir-handle <> [ dirent-struct ])
+.syne
+.desc
+The
+.code readdir
+function returns the next available directory entry from the directory
+traversal controlled by
+.metn dir-handle ,
+which must be a
+.code dir
+object returned by
+.codn opendir .
+
+If no more directory entries remain, then
+.code readdir
+returns
+.codn nil .
+
+Otherwise, the next available directory entry is returned as a
+structure object of type
+.codn dirent .
+
+If the
+.meta dirent-struct
+argument is specified, then it must be a
+.code dirent
+structure, or one which has all of the required slots.
+In this case,
+.code readdir
+stores values in that structure and returns it. If
+.meta dirent-struct
+is absent, then
+.code readdir
+allocates a fresh
+.code dirent
+structure.
+
.SS* Unix Sockets
On platforms where the underlying system interface is available, \*(TX provides
diff --git a/utf8.c b/utf8.c
index 2760c718..39d1e1c4 100644
--- a/utf8.c
+++ b/utf8.c
@@ -25,11 +25,13 @@
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*/
+#define UTF8_DECL_OPENDIR
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <wchar.h>
#include <signal.h>
+#include <dirent.h>
#include "config.h"
#include "lib.h"
#include "signal.h"
@@ -415,3 +417,11 @@ int w_rename(const wchar_t *wfrom, const wchar_t *wto)
free(from);
return err;
}
+
+DIR *w_opendir(const wchar_t *wname)
+{
+ char *name = utf8_dup_to(wname);
+ DIR *d = opendir(name);
+ free(name);
+ return d;
+}
diff --git a/utf8.h b/utf8.h
index a8c48757..6d775451 100644
--- a/utf8.h
+++ b/utf8.h
@@ -56,3 +56,6 @@ FILE *w_freopen(const wchar_t *, const wchar_t *, FILE *);
FILE *w_fdopen(int, const wchar_t *);
int w_remove(const wchar_t *);
int w_rename(const wchar_t *, const wchar_t *);
+#ifdef UTF8_DECL_OPENDIR
+DIR *w_opendir(const wchar_t *wname);
+#endif