From ff7c7432e48776dbfc970d19bb81c6fe6075c117 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Thu, 12 Jun 2014 07:08:41 -0700
Subject: * match.c (v_load): use the abs_path_p function instead of checking
 for leading slash.

* stream.c (abs_path_p): New function.
(stream_init): Register abs_path_p as abs-path-p.

* stream.h (abs_path_p): Declared.

* txr.1: Documented abs-path-p.

* dep.mk: Updated.
---
 ChangeLog | 14 ++++++++++++++
 dep.mk    |  2 +-
 match.c   |  2 +-
 stream.c  | 21 +++++++++++++++++++++
 stream.h  |  1 +
 txr.1     | 36 ++++++++++++++++++++++++++++++++++++
 6 files changed, 74 insertions(+), 2 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 6d29d32d..96b919d5 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,17 @@
+2014-06-12  Kaz Kylheku  <kaz@kylheku.com>
+
+	* match.c (v_load): use the abs_path_p function instead of
+	checking for leading slash.
+
+	* stream.c (abs_path_p): New function.
+	(stream_init): Register abs_path_p as abs-path-p.
+
+	* stream.h (abs_path_p): Declared.
+
+	* txr.1: Documented abs-path-p.
+
+	* dep.mk: Updated.
+
 2014-06-11  Kaz Kylheku  <kaz@kylheku.com>
 
 	Version 90
diff --git a/dep.mk b/dep.mk
index d66f45f7..a403369b 100644
--- a/dep.mk
+++ b/dep.mk
@@ -6,7 +6,7 @@
 ./regex.o: config.h $(top_srcdir)/./lib.h $(top_srcdir)/./parser.h $(top_srcdir)/./signal.h $(top_srcdir)/./unwind.h $(top_srcdir)/./regex.h $(top_srcdir)/./txr.h
 ./gc.o: config.h $(top_srcdir)/./lib.h $(top_srcdir)/./stream.h $(top_srcdir)/./hash.h $(top_srcdir)/./txr.h $(top_srcdir)/./gc.h $(top_srcdir)/./signal.h
 ./unwind.o: config.h $(top_srcdir)/./lib.h $(top_srcdir)/./gc.h $(top_srcdir)/./stream.h $(top_srcdir)/./txr.h $(top_srcdir)/./signal.h $(top_srcdir)/./eval.h $(top_srcdir)/./parser.h $(top_srcdir)/./unwind.h
-./stream.o: config.h $(top_srcdir)/./lib.h $(top_srcdir)/./gc.h $(top_srcdir)/./signal.h $(top_srcdir)/./unwind.h $(top_srcdir)/./stream.h $(top_srcdir)/./utf8.h $(top_srcdir)/./eval.h
+./stream.o: config.h $(top_srcdir)/./lib.h $(top_srcdir)/./gc.h $(top_srcdir)/./signal.h $(top_srcdir)/./unwind.h $(top_srcdir)/./stream.h $(top_srcdir)/./utf8.h $(top_srcdir)/./eval.h $(top_srcdir)/./regex.h
 ./arith.o: config.h $(top_srcdir)/./lib.h $(top_srcdir)/./signal.h $(top_srcdir)/./unwind.h $(top_srcdir)/./gc.h $(top_srcdir)/./arith.h
 ./hash.o: config.h $(top_srcdir)/./lib.h $(top_srcdir)/./gc.h $(top_srcdir)/./signal.h $(top_srcdir)/./unwind.h $(top_srcdir)/./stream.h $(top_srcdir)/./hash.h
 ./utf8.o: config.h $(top_srcdir)/./lib.h $(top_srcdir)/./signal.h $(top_srcdir)/./unwind.h $(top_srcdir)/./utf8.h
diff --git a/match.c b/match.c
index c2f72cf6..4d21b583 100644
--- a/match.c
+++ b/match.c
@@ -3647,7 +3647,7 @@ static val v_load(match_files_ctx *c)
     sem_error(specline, lit("load: null string path given"), nao);
 
   {
-    val path = if3(chr_str(target, zero) == chr('/'),
+    val path = if3(abs_path_p(target),
                    target,
                    cat_str(nappend2(sub_list(split_str(parent, lit("/")),
                                          zero, negone),
diff --git a/stream.c b/stream.c
index b12d06e0..0236b181 100644
--- a/stream.c
+++ b/stream.c
@@ -61,6 +61,7 @@
 #include "stream.h"
 #include "utf8.h"
 #include "eval.h"
+#include "regex.h"
 
 val stdin_s, stdout_s, stddebug_s, stderr_s, stdnull_s;
 
@@ -2690,6 +2691,25 @@ static val open_files_star(val file_list, val substitute_stream)
 
 #endif
 
+val abs_path_p(val path)
+{
+  static val reg;
+  val ch;
+
+  if (length(path) == zero)
+    return nil;
+  if ((ch = chr_str(path, zero)) == chr('/') || ch == chr('\\'))
+    return t;
+
+  if (!reg)
+    reg = regex_compile(lit("[A-Za-z0-9]+:[/\\\\]"), nil);
+
+  if (match_regex(path, reg, zero))
+    return t;
+
+  return nil;
+}
+
 void stream_init(void)
 {
   protect(&std_input, &std_output, &std_debug, &std_error, &std_null, (val *) 0);
@@ -2842,4 +2862,5 @@ void stream_init(void)
   reg_fun(intern(lit("rename-path"), user_package), func_n2(rename_path));
   reg_fun(intern(lit("open-files"), user_package), func_n2o(open_files, 1));
   reg_fun(intern(lit("open-files*"), user_package), func_n2o(open_files_star, 1));
+  reg_fun(intern(lit("abs-path-p"), user_package), func_n1(abs_path_p));
 }
diff --git a/stream.h b/stream.h
index 30b06a85..16829c58 100644
--- a/stream.h
+++ b/stream.h
@@ -113,5 +113,6 @@ val mknod_wrap(val path, val mode, val dev);
 val symlink_wrap(val target, val to);
 val link_wrap(val target, val to);
 val readlink_wrap(val path);
+val abs_path_p(val path);
 
 void stream_init(void);
diff --git a/txr.1 b/txr.1
index 4be52d5f..12611670 100644
--- a/txr.1
+++ b/txr.1
@@ -12452,6 +12452,42 @@ there are no files, then read from standard input:
    @line
    @(end)
 
+.SS Function abs-path-p
+
+.TP
+Syntax:
+
+  (abs-path-p <path>)
+
+.TP
+Description:
+
+The abs-path-function whether the argument <path> is an absolute path.
+If this is true, it returns t, otherwise nil.
+
+An absolute path is a string which either begins with a slash or backslash
+character, or which begins with an alphanumeric word, followed by a colon,
+followed by a slash or backslash.
+
+Examples of absolute paths:
+
+  /etc
+
+  c:/tmp
+
+  ftp://user@server
+
+  disk0:/home
+
+  Z:\eUsers
+
+Examples of strings which are not absolute paths.
+
+  (the empty string)
+  .
+  abc
+  foo:bar/x
+  $:\eabc
 
 .SS Function read
 
-- 
cgit v1.2.3