From 7266ebf56acbd34978d8bb99a2a87a15d0afdea9 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Tue, 28 Jan 2014 21:39:03 -0800
Subject: * stream.c (remove_path, rename_path): New functions.

* stream.h (remove_path, rename_path): Declared.

* utf8.c (w_remove, w_rename): New functions.

* utf8.h (w_remove, w_rename): Declared.

* eval.c (eval_init): Registered remove_path and rename_path
as intrinsics.
---
 ChangeLog | 13 +++++++++++++
 eval.c    |  3 ++-
 stream.c  | 17 +++++++++++++++++
 stream.h  |  2 ++
 utf8.c    | 18 ++++++++++++++++++
 utf8.h    |  2 ++
 6 files changed, 54 insertions(+), 1 deletion(-)

diff --git a/ChangeLog b/ChangeLog
index 6ce6dc30..3a1fac6f 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,16 @@
+2014-01-28  Kaz Kylheku  <kaz@kylheku.com>
+
+	* stream.c (remove_path, rename_path): New functions.
+
+	* stream.h (remove_path, rename_path): Declared.
+
+	* utf8.c (w_remove, w_rename): New functions.
+
+	* utf8.h (w_remove, w_rename): Declared.
+
+	* eval.c (eval_init): Registered remove_path and rename_path
+	as intrinsics.
+
 2014-01-28  Kaz Kylheku  <kaz@kylheku.com>
 
 	* eval.c (meta_meta_p, meta_meta_strip): New static functions.
diff --git a/eval.c b/eval.c
index 2702a3ab..d526954d 100644
--- a/eval.c
+++ b/eval.c
@@ -2571,7 +2571,8 @@ void eval_init(void)
   reg_fun(intern(lit("open-command"), user_package), func_n2(open_command));
   reg_fun(intern(lit("open-pipe"), user_package), func_n2(open_command));
   reg_fun(intern(lit("open-process"), user_package), func_n3o(open_process, 2));
-
+  reg_fun(intern(lit("remove-path"), user_package), func_n1(remove_path));
+  reg_fun(intern(lit("rename-path"), user_package), func_n2(rename_path));
   reg_var(intern(lit("*user-package*"), user_package), &user_package);
   reg_var(intern(lit("*keyword-package*"), user_package), &keyword_package);
   reg_var(intern(lit("*system-package*"), user_package), &system_package);
diff --git a/stream.c b/stream.c
index 64d217a4..3961f918 100644
--- a/stream.c
+++ b/stream.c
@@ -2260,6 +2260,23 @@ val make_catenated_stream(val stream_list)
   return cobj((mem_t *) stream_list, stream_s, &cat_stream_ops.cobj_ops);
 }
 
+val remove_path(val path)
+{
+  if (w_remove(c_str(path)) < 0)
+    uw_throwf(file_error_s, lit("trying to remove ~a: ~a/~s"),
+                path, num(errno), string_utf8(strerror(errno)), nao);
+  return t;
+}
+
+val rename_path(val from, val to)
+{
+  if (w_rename(c_str(from), c_str(to)) < 0)
+    uw_throwf(file_error_s, lit("trying to rename ~a to ~a: ~a/~s"),
+                from, to, num(errno), string_utf8(strerror(errno)), nao);
+  return t;
+}
+
+
 void stream_init(void)
 {
   protect(&std_input, &std_output, &std_debug, &std_error, &std_null, (val *) 0);
diff --git a/stream.h b/stream.h
index 6a76d6b8..2f4eec6c 100644
--- a/stream.h
+++ b/stream.h
@@ -99,5 +99,7 @@ val open_tail(val path, val mode_str, val seek_end_p);
 val open_command(val path, val mode_str);
 val open_process(val path, val mode_str, val args);
 val make_catenated_stream(val stream_list);
+val remove_path(val path);
+val rename_path(val from, val to);
 
 void stream_init(void);
diff --git a/utf8.c b/utf8.c
index 36354277..26e5795d 100644
--- a/utf8.c
+++ b/utf8.c
@@ -383,3 +383,21 @@ FILE *w_freopen(const wchar_t *wname, const wchar_t *wmode, FILE *fold)
   free(mode);
   return f;
 }
+
+int w_remove(const wchar_t *wpath)
+{
+  char *path = utf8_dup_to(wpath);
+  int err = remove(path);
+  free(path);
+  return err;
+}
+
+int w_rename(const wchar_t *wfrom, const wchar_t *wto)
+{
+  char *from = utf8_dup_to(wfrom);
+  char *to = utf8_dup_to(wto);
+  int err = rename(from, to);
+  free(to);
+  free(from);
+  return err;
+}
diff --git a/utf8.h b/utf8.h
index 4dac7837..c4915488 100644
--- a/utf8.h
+++ b/utf8.h
@@ -49,3 +49,5 @@ wint_t utf8_decode(utf8_decoder_t *,int (*get)(mem_t *ctx), mem_t *ctx);
 FILE *w_fopen(const wchar_t *, const wchar_t *);
 FILE *w_popen(const wchar_t *, const wchar_t *);
 FILE *w_freopen(const wchar_t *, const wchar_t *, FILE *);
+int w_remove(const wchar_t *);
+int w_rename(const wchar_t *, const wchar_t *);
-- 
cgit v1.2.3