New function: rel-path.

* lisplib.c (copy_file_set_entries): Add rel-path as autoload
trigger for copy-file module.

* share/txr/stdlib/copy-file.tl (rel-path): New function.

* tests/018/rel-path.tl: New file.

* txr.1: Documented.

* share/txr/stdlib/doc-syms.tl: Updated.

5 files changed, 150 insertions, 1 deletions

diff --git a/lisplib.c b/lisplib.c
index 422fcaaa..5d85ec48 100644
--- a/lisplib.c
+++ b/lisplib.c
@@ -819,7 +819,7 @@ static val copy_file_set_entries(val dlt, val fun)
   val name[] = {
     lit("copy-path-opts"), lit("copy-file"), lit("copy-files"),
     lit("copy-path-rec"), lit("remove-path-rec"),
-    lit("chown-rec"), lit("chmod-rec"), lit("touch"),
+    lit("chown-rec"), lit("chmod-rec"), lit("touch"), lit("rel-path"),
     nil
   };
   set_dlt_entries(dlt, name, fun);
diff --git a/share/txr/stdlib/copy-file.tl b/share/txr/stdlib/copy-file.tl
index aaff63f2..67c3493a 100644
--- a/share/txr/stdlib/copy-file.tl
+++ b/share/txr/stdlib/copy-file.tl
@@ -212,3 +212,35 @@
       (let ((rst (stat ref-path)))
         (utimes s 0 nil rst.mtime rst.mtime-nsec))
       (utimes s 0 nil 0 t))))
+
+(defun rel-path (from to)
+  (unless (eq (abs-path-p from) (abs-path-p to))
+    (error "~s: mixture of absolute and relative paths ~s ~s given"
+           'rel-path from to))
+
+  (macrolet ((if-windows (then : else)
+               (if (find #\\ path-sep-chars) then else)))
+    (if-windows
+      (when-match `@{fdrv #/[A-Za-z0-9]+:/}@nil` from
+        (when-match `@{tdrv #/[A-Za-z0-9]+:/}@nil` to
+          (unless (equal fdrv tdrv)
+            (error "~s: paths on different drives ~s ~s given"
+                   'rel-path from to)))))
+
+    (flet ((canon (comp)
+             (let (out)
+               (each ((c comp))
+                 (cond
+                   ((and out (equal ".." c)) (pop out))
+                   ((equal "." c))
+                   (t (push c out))))
+               (nreverse out))))
+      (let* ((fcomp (canon (spl path-sep-chars from)))
+             (tcomp (canon (spl path-sep-chars to)))
+             (ncommon (mismatch fcomp tcomp)))
+        (if (null ncommon)
+          "."
+          (let ((nup (- (len fcomp) ncommon))
+                (down [tcomp ncommon..:]))
+            (cat-str (append (repeat '("..") nup) down)
+                     [path-sep-chars 0])))))))
diff --git a/share/txr/stdlib/doc-syms.tl b/share/txr/stdlib/doc-syms.tl
index cf061a69..de12a878 100644
--- a/share/txr/stdlib/doc-syms.tl
+++ b/share/txr/stdlib/doc-syms.tl
@@ -1611,6 +1611,7 @@
      ("struct-type" "N-02C33D76")
      ("op" "N-0068EA9D")
      ("int-cptr" "N-01768FB9")
+     ("rel-path" "N-016892B4")
      ("window-mappend" "N-015AFD48")
      ("with-delete-expander" "N-02A6E020")
      ("f-getfl" "N-025E55E7")
diff --git a/tests/018/rel-path.tl b/tests/018/rel-path.tl
new file mode 100644
index 00000000..1afff796
--- /dev/null
+++ b/tests/018/rel-path.tl
@@ -0,0 +1,17 @@
+(load "../common")
+
+(mtest
+  (rel-path "/abc" "abc") :error
+  (rel-path "abc" "/abc") :error
+  (rel-path "." ".") "."
+  (rel-path "./abc" "abc") "."
+  (rel-path "abc" "./abc") "."
+  (rel-path "./abc" "./abc") "."
+  (rel-path "abc" "abc") "."
+  (rel-path "." "abc") "abc"
+  (rel-path "abc/def" "abc/ghi") "../ghi"
+  (rel-path "xyz/../abc/def" "abc/ghi") "../ghi"
+  (rel-path "abc" "d/e/f/g/h") "../d/e/f/g/h"
+  (rel-path "abc" "d/e/../g/h") "../d/g/h"
+  (rel-path "d/e/../g/h" ".") "../../.."
+  (rel-path "d/e/../g/h" "a/b") "../../../a/b")
diff --git a/txr.1 b/txr.1
index 8bd9e791..c87b5374 100644
--- a/txr.1
+++ b/txr.1
@@ -55479,6 +55479,105 @@ itself.
   (path-cat "ab/cd" "ef")  --> "ab/cd/ef"
 .brev
 
+.coNP Function @ rel-path
+.synb
+.mets (rel-path < from-path << to-path )
+.syne
+.desc
+The
+.code rel-path
+function calculates the relative path between two file system locations
+indicated by string arguments
+.meta from-path
+and
+.metn to-path .
+The
+.meta from-path
+is assumed to be a directory. The return value is a relative path
+which could be used to access an object named by
+.meta to-path
+if
+.meta from-path
+were the current working directory.
+
+The calculation performed by
+.code rel-path
+is a pure calculation; it has no interaction with the host operating system.
+No component of either input path has to exist. Symbolic links are not
+resolved. This can lead to incorrect results, as noted below.
+
+Either both the inputs must be absolute paths, or must both be relative,
+otherwise an error exception is thrown.
+
+On the MS Windows platform, if one input specifies a drive letter prefix, the
+other input must specify the same prefix, or else an error exception is thrown;
+there is no relative path between locations on different drives.
+The behavior is unspecified if the arguments are two UNC paths indicating
+different hosts.
+
+The
+.code rel-path
+function first splits both paths into components according to the
+platform-specific pathname separators indicated by the
+.code path-sep-chars
+variable.
+
+Next, it eliminates all empty components,
+.code .
+(dot) components and
+.code ..
+(dotdot)
+components from both separated paths. All dot components are removed,
+and any component which is neither dot nor dotdot is removed if it is
+followed by dotdot.
+
+Then, a common prefix is determined between the two component sequences,
+and a relative component sequence is calculated from them as follows:
+if the component sequence corresponding to
+.meta from-path
+is longer than the common prefix, then a sequence is generated consisting
+of a sufficient number of repetitions of
+.code ..
+(dotdot)
+components to express the relative navigation from
+.meta from-path
+up to the director indicated by the common prefix. Next,
+if the component sequence corresponding to
+.meta to-path
+has any components in excess of the common prefix, those components are
+appended to this possibly empty sequence of dotdot components, in
+order to expres navigation from the common prefix down to the
+.meta to-path
+object.
+
+Finally, if the resulting sequence is nonempty, it is joined together using the leftmost
+path separator character indicated in
+.code path-sep-chars
+and returned. If it is empty, then the string
+.str .
+is returned.
+
+Note: because the function doesn't access the file system and in particular
+does not resolve symbolic links or other indirection devices, the result
+may be incorrect. For example, suppose that the current working directory
+contains a symbolic link called
+.code up
+which expands to
+.code ..
+(dotdot). The expression
+.code "(rel-path \(dqup/a\(dq \(dq../a\(dq)"
+is oblivious to this, and calculates
+.strn ../../../a .
+The correct result in light of
+.code up
+being an alias for
+.code ..
+calls for a return value of
+.strn . .
+
+In situtions where this possibility exists, it is recommended to use
+.code realpath
+function to canonicalize the input paths.
 
 .coNP Variable @ path-sep-chars
 .desc