From 7a9786b4154f939e60bb2923b8b90a81f38e20ad Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Tue, 29 Jun 2021 06:52:38 -0700
Subject: New function: path-search.

* lisplib.c (path_test_set_entries): Autoload on path-search.

* stdlib/path-test.tl (path-search): New function.

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

* txr.1: Documented.

* stdlib/doc-lookup.tl: Updated.
---
 lisplib.c              |  2 +-
 stdlib/doc-syms.tl     |  1 +
 stdlib/path-test.tl    | 13 +++++++++
 tests/018/path-test.tl | 15 +++++++++++
 txr.1                  | 73 ++++++++++++++++++++++++++++++++++++++++++++++++++
 5 files changed, 103 insertions(+), 1 deletion(-)
 create mode 100644 tests/018/path-test.tl

diff --git a/lisplib.c b/lisplib.c
index a97f741f..ccd5ed38 100644
--- a/lisplib.c
+++ b/lisplib.c
@@ -189,7 +189,7 @@ static val path_test_set_entries(val dlt, val fun)
     lit("path-newer"), lit("path-older"),
     lit("path-same-object"), lit("path-private-to-me-p"),
     lit("path-strictly-private-to-me-p"),
-    lit("path-dir-empty"),
+    lit("path-dir-empty"), lit("path-search"),
     nil
   };
 
diff --git a/stdlib/doc-syms.tl b/stdlib/doc-syms.tl
index cce921a1..90d8bd07 100644
--- a/stdlib/doc-syms.tl
+++ b/stdlib/doc-syms.tl
@@ -1372,6 +1372,7 @@
       ("path-read-writable-to-me-p" "N-028A5109")
       ("path-readable-to-me-p" "N-02933008")
       ("path-same-object" "N-0103E27B")
+      ("path-search" "N-01AB7247")
       ("path-sep-chars" "N-03985DE5")
       ("path-setgid-p" "N-02FBA677")
       ("path-setuid-p" "N-02FBA677")
diff --git a/stdlib/path-test.tl b/stdlib/path-test.tl
index fb132f7f..b3483962 100644
--- a/stdlib/path-test.tl
+++ b/stdlib/path-test.tl
@@ -185,3 +185,16 @@
           (casequal ent
             (("." ".."))
             (t (return nil))))))))
+
+(defun path-search (name : (path (getenv "PATH")))
+  (if (empty name)
+    nil
+    (let ((pcomp (if (listp path)
+                   path
+                   (spl (if (starts-with "CYGNAL" (uname).sysname) #\; #\:)
+                        path))))
+      (each ((pc pcomp))
+        (if (nequal pc "")
+          (let ((st (ignerr (stat (path-cat pc name)))))
+            (if (and st (path-executable-to-me-p st) (path-file-p st))
+              (return st.path))))))))
diff --git a/tests/018/path-test.tl b/tests/018/path-test.tl
new file mode 100644
index 00000000..2b4e1717
--- /dev/null
+++ b/tests/018/path-test.tl
@@ -0,0 +1,15 @@
+(load "../common")
+
+(mtest
+  (path-search "sh") "/bin/sh"
+  (path-search "AlMoStCeRtAiNlLyNoNeXisTenT") nil
+  (path-search "") nil
+  (path-search "sh" nil) nil
+  (path-search "sh" '("AlMoStCeRtAiNlLyNoNeXisTenT")) nil
+  (path-search "sh" '("AlMoStCeRtAiNlLyNoNeXisTenT" "/bin")) "/bin/sh"
+  (path-search "sh" '("/bin")) "/bin/sh"
+  (path-search "sh" "AlMoStCeRtAiNlLyNoNeXisTenT") nil
+  (path-search "sh" "AlMoStCeRtAiNlLyNoNeXisTenT:/bin") "/bin/sh"
+  (path-search "sh" "/bin") "/bin/sh"
+  (path-search "sh" "/bin/") "/bin/sh"
+  (path-search "sh" ":/bin/") "/bin/sh")
diff --git a/txr.1 b/txr.1
index 5dfea63b..ce6c7d64 100644
--- a/txr.1
+++ b/txr.1
@@ -67107,6 +67107,79 @@ and
 resolve to the same filesystem object: the same inode number on the same
 device.
 
+.coNP Function @ path-search
+.synb
+.mets (path-search < program-name <> [ search-path ])
+.syne
+.desc
+The
+.code path-search
+searches for an executable program whose name is given by the
+.meta program-name
+string argument. If the program is found, then the full path to that
+program is returned, otherwise
+.code nil
+is returned.
+
+If the
+.meta search-path
+is omitted, then
+.code path-search
+uses the search path given in the
+.code PATH
+environment variable. This path is decomposed into components according
+to the separator character, which may be
+.code :
+(colon)
+or
+.code ;
+(semicolon) depending on the system. Then, for each component of the path,
+.code path-search
+affixes the
+.meta program-name
+to that component, as if using the
+.code path-cat
+function, and tests whether the resulting path is an existing file object
+according to
+.codn path-file-p ,
+which is executable according to
+.codn path-executable-to-me-p .
+
+The
+.code search-path
+argument may be specified as a string, which is taken instead of the value
+of the
+.code PATH
+environment variable, and decomposed into components in the same way.
+The argument may also be specified as a list of strings, which are taken
+to be components of a search path, and used as-is.
+
+If
+.meta program-name
+is the empty string or the search path is empty, the function returns
+.codn nil .
+
+Components of the search path which are empty strings are ignored.
+
+If
+.meta program-name
+is a string which includes path separator characters, or if
+.meta program-name
+is one of the special names
+.str .
+or
+.strn .. ,
+the behavior may produce a different result from the host platform's native
+path search strategy.
+
+The behavior of
+.code path-search
+may also deviate from the host platform's native path search strategy
+due to issues of permissions. If an executable file is found in the path,
+but is not executable to the caller due to permissions, it is treated
+as nonexistent, which means that the search can find a same-named file
+later in the search path.
+
 .SS* Unix Credentials
 
 .coNP Functions @, getuid @, geteuid @ getgid and @ getegid
-- 
cgit v1.2.3