diff options
| -rw-r--r-- | ChangeLog | 17 | ||||
| -rwxr-xr-x | configure | 24 | ||||
| -rw-r--r-- | eval.c | 2 | ||||
| -rw-r--r-- | stream.c | 62 | ||||
| -rw-r--r-- | stream.h | 1 | ||||
| -rw-r--r-- | txr.1 | 26 |
6 files changed, 132 insertions, 0 deletions
@@ -1,5 +1,22 @@ 2012-09-11 Kaz Kylheku <kaz@kylheku.com> + * configure: Added test for <sys/stat.h> + + * eval.c: New intrinsic functions "stat" and "prop". + + * stream.c: Include <sys/stat.h> if we have it. + (w_stat, statf): New functions. + (val dev_k, ino_k, mode_k, nlink_k, uid_k, + val gid_k, rdev_k, size_k, blksize_k, blocks_k; + val atime_k, mtime_k, ctime_k): New sybol variables. + (stream_init): Intern new keywords symbols. + + * stream.h (statf): Declared. + + * txr.1: prop documented. Stub for stat created. + +2012-09-11 Kaz Kylheku <kaz@kylheku.com> + * eval.c (eval_init): new instrinsic function /= registered. * lib.c (numneqv): New function. @@ -1142,6 +1142,30 @@ else fi # +# sys/stat.h +# + +printf "Checking whether we have <sys/stat.h> ... " + +cat > conftest.c <<! +#include <sys/stat.h> + +int main(void) +{ + struct stat s; + return 0; +} +! +rm -f conftest +if ! $make conftest > conftest.err 2>&1 || ! [ -x conftest ] ; then + printf "no\n" +else + printf "yes\n" + printf "#define HAVE_SYS_STAT 1\n" >> config.h +fi + + +# # environ # @@ -2291,6 +2291,7 @@ void eval_init(void) reg_fun(intern(lit("put-char"), user_package), func_n2o(put_char, 1)); reg_fun(intern(lit("put-byte"), user_package), func_n2o(put_byte, 1)); reg_fun(intern(lit("flush-stream"), user_package), func_n1(flush_stream)); + reg_fun(intern(lit("stat"), user_package), func_n1(statf)); reg_fun(intern(lit("open-directory"), user_package), func_n1(open_directory)); reg_fun(intern(lit("open-file"), user_package), func_n2(open_file)); reg_fun(intern(lit("open-command"), user_package), func_n2(open_command)); @@ -2381,6 +2382,7 @@ void eval_init(void) reg_fun(intern(lit("alist-nremove"), user_package), func_n1v(alist_nremove)); reg_fun(intern(lit("copy-cons"), user_package), func_n1(copy_cons)); reg_fun(intern(lit("copy-alist"), user_package), func_n1(copy_alist)); + reg_fun(intern(lit("prop"), user_package), func_n2(getplist)); reg_fun(intern(lit("merge"), user_package), func_n4o(merge, 2)); reg_fun(intern(lit("sort"), user_package), func_n3o(sort, 2)); reg_fun(intern(lit("find"), user_package), func_n4o(find, 2)); @@ -40,6 +40,9 @@ #if HAVE_SYS_WAIT #include <sys/wait.h> #endif +#if HAVE_SYS_STAT +#include <sys/stat.h> +#endif #include "lib.h" #include "gc.h" #include "unwind.h" @@ -49,6 +52,10 @@ val std_input, std_output, std_debug, std_error; val output_produced; +val dev_k, ino_k, mode_k, nlink_k, uid_k; +val gid_k, rdev_k, size_k, blksize_k, blocks_k; +val atime_k, mtime_k, ctime_k; + struct strm_ops { struct cobj_ops cobj_ops; val (*put_string)(val, val); @@ -1475,6 +1482,46 @@ val flush_stream(val stream) } } +#if HAVE_SYS_STAT +static int w_stat(const wchar_t *wpath, struct stat *buf) +{ + char *path = utf8_dup_to(wpath); + int res = stat(path, buf); + free(path); + return res; +} +#endif + +val statf(val path) +{ +#if HAVE_SYS_STAT + struct stat st; + int res = w_stat(c_str(path), &st); + + if (res == -1) + uw_throwf(file_error_s, lit("unable to stat ~a: ~a/~s"), + path, num(errno), string_utf8(strerror(errno)), nao); + + return list(dev_k, num(st.st_dev), + dev_k, num(st.st_dev), + ino_k, num(st.st_ino), + mode_k, num(st.st_mode), + nlink_k, num(st.st_nlink), + uid_k, num(st.st_uid), + gid_k, num(st.st_gid), + rdev_k, num(st.st_rdev), + size_k, num(st.st_size), + blksize_k, num(st.st_blksize), + blocks_k, num(st.st_blocks), + atime_k, num(st.st_atime), + mtime_k, num(st.st_mtime), + ctime_k, num(st.st_ctime), + nao); +#else + uw_throwf(file_error_s, lit("stat is not implemented"), nao); +#endif +} + static DIR *w_opendir(const wchar_t *wname) { char *name = utf8_dup_to(wname); @@ -1483,6 +1530,7 @@ static DIR *w_opendir(const wchar_t *wname) return d; } + val open_directory(val path) { DIR *d = w_opendir(c_str(path)); @@ -1673,4 +1721,18 @@ void stream_init(void) std_debug = make_stdio_stream(stdout, string(L"debug"), nil, t); std_error = make_stdio_stream(stderr, string(L"stderr"), nil, t); detect_format_string(); + + dev_k = intern(lit("dev"), keyword_package); + ino_k = intern(lit("ino"), keyword_package); + mode_k = intern(lit("mode"), keyword_package); + nlink_k = intern(lit("nlink"), keyword_package); + uid_k = intern(lit("uid"), keyword_package); + gid_k = intern(lit("gid"), keyword_package); + rdev_k = intern(lit("rdev"), keyword_package); + size_k = intern(lit("size"), keyword_package); + blksize_k = intern(lit("blksize"), keyword_package); + blocks_k = intern(lit("blocks"), keyword_package); + atime_k = intern(lit("atime"), keyword_package); + mtime_k = intern(lit("mtime"), keyword_package); + ctime_k = intern(lit("ctime"), keyword_package); } @@ -50,6 +50,7 @@ val put_line(val string, val stream); val put_char(val ch, val stream); val put_byte(val byte, val stream); val flush_stream(val stream); +val statf(val path); val open_directory(val path); val open_file(val path, val mode_str); val open_command(val path, val mode_str); @@ -6947,6 +6947,30 @@ cell of the input alist. That is to say, each element of the output list is produced as if by the copy-cons function applied to the corresponding element of the input list. +.SH PROPERTY LISTS + +.SS Function prop + +.TP +Syntax: + + (prop <plist> <key>) + +.TP +Description: + +A property list a flat list of even length consisting of interleaved +pairs of property names (usually symbols) and their values (arbitrary +objects). An example property list is (:a 1 :b "two") which contains +two properties, :a having value 1, and :b having value "two". + +The prop function searches property list <plist> for key <key>. If +the key is found, then the value next to it is returned. Otherwise +nil is returned. + +It is ambiguous whether nil is returned due to the property not being +found, or due to the property being present with a nil value. + .SH LIST SORTING .SS Function merge @@ -9437,6 +9461,8 @@ meaningful, it does nothing. .SH FILESYSTEM ACCESS +.SS Function stat + .SS Function open-directory .SS Functions open-file |