From 620a3aa8354070d29e4fd32756eff25cb5ef378f Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Sun, 10 Oct 2021 11:46:30 -0700
Subject: New path-equal function.

* lisplib.c (copy_file_set_entries): Add path-equal to autoload symbols.

* stdlib/copy-file.tl (path-equal): New function.

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

* txr.1: Documented.
---
 stdlib/copy-file.tl | 14 ++++++++++++++
 1 file changed, 14 insertions(+)

(limited to 'stdlib')

diff --git a/stdlib/copy-file.tl b/stdlib/copy-file.tl
index fcb7f40c..c8cbe59f 100644
--- a/stdlib/copy-file.tl
+++ b/stdlib/copy-file.tl
@@ -246,3 +246,17 @@
                (down [tcomp ncommon..:]))
            (cat-str (append (repeat '("..") nup) down)
                     [path-sep-chars 0]))))))
+
+(defun path-equal (left right)
+  (cond
+    ((and (stringp left) (equal left right)))
+    ((neq (abs-path-p left) (abs-path-p right)) nil)
+    ((and (macro-time (find #\\ path-sep-chars))
+          (if-match `@{fdrv #/[A-Za-z0-9]+:/}@nil` left
+            (if-match `@{tdrv #/[A-Za-z0-9]+:/}@nil` right
+              (nequal fdrv tdrv))))
+     nil)
+    (t (let* ((fcomp (path-simplify (spl path-sep-chars left)))
+              (tcomp (path-simplify (spl path-sep-chars right)))
+              (ncommon (mismatch fcomp tcomp)))
+         (null ncommon)))))
-- 
cgit v1.2.3