From 436863c2b8b8014919e23a9e915e830f34807e77 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C4=81nis=20D=C5=BEeri=C5=86=C5=A1?=
 <smuglispweenie@gmail.com>
Date: Wed, 12 Aug 2020 16:02:51 +0300
Subject: [PATCH] Add :directory parameter to ccl:run-program

---
 doc/manual/external-process.ccldoc | 6 +++++-
 level-1/linux-files.lisp           | 7 +++++--
 2 files changed, 10 insertions(+), 3 deletions(-)

diff --git a/doc/manual/external-process.ccldoc b/doc/manual/external-process.ccldoc
index 2ad094ee4..1c9984c2c 100644
--- a/doc/manual/external-process.ccldoc
+++ b/doc/manual/external-process.ccldoc
@@ -40,7 +40,7 @@
         this.")))
   (defsection "External-Program Dictionary"
     (definition (:function run-program)
-     "run-program program args &key (wait t) pty sharing input if-input-does-not-exist output (if-output-exists :error) (error :output) (if-error-exists :error) status-hook external-format env (silently-ignore-catastrophic-failures *silently-ignore-catastrophic-failure-in-run-program*)"
+     "run-program program args &key (wait t) pty sharing input if-input-does-not-exist output (if-output-exists :error) (error :output) (if-error-exists :error) status-hook external-format env directory (silently-ignore-catastrophic-failures *silently-ignore-catastrophic-failure-in-run-program*)"
      "Invokes an external program as an OS subprocess
 	    of lisp."
      (defsection "Arguments and Values"
@@ -109,6 +109,10 @@
 		    value are case sensitive strings. See "
           (ref (definition :function setenv)) ".
 		  ")
+         (item "{param directory}" ccldoc::=> "
+                    A string or pathname denoting directory that will
+                    become the working directory of the external
+                    process.")
          (item "{param silently-ignore-catastrophic-failures}" ccldoc::=> "
 		    If NIL, signal an error if run-program is unable
 		    to start the program. If non-NIL, treat failure to
diff --git a/level-1/linux-files.lisp b/level-1/linux-files.lisp
index 7b5ec16d1..4ef02e414 100644
--- a/level-1/linux-files.lisp
+++ b/level-1/linux-files.lisp
@@ -1413,7 +1413,7 @@ any EXTERNAL-ENTRY-POINTs known to be defined by it to become unresolved."
                          (remove-external-process p)
                          (setq terminated t)))))))))))
       
-  (defun run-external-process (proc in-fd out-fd error-fd argv &optional env)
+  (defun run-external-process (proc in-fd out-fd error-fd argv &optional env dir)
     (let* ((signaled nil))
       (unwind-protect
            (let ((child-pid (#_fork)))
@@ -1423,6 +1423,8 @@ any EXTERNAL-ENTRY-POINTs known to be defined by it to become unresolved."
                     (setq signaled t)
                     (dolist (pair env)
                       (setenv (string (car pair)) (cdr pair)))
+                    (when dir
+                      (%chdir (defaulted-native-namestring dir)))
                     (without-interrupts
                      (exec-with-io-redirection
                       in-fd out-fd error-fd argv)))
@@ -1456,6 +1458,7 @@ itself, by setting the status and exit-code fields.")
                               (error :output) (if-error-exists :error)
                               status-hook (element-type 'character)
                               env
+                              directory
                               (sharing :private)
                               (external-format `(:character-encoding ,*terminal-character-encoding-name*))
                               (silently-ignore-catastrophic-failures
@@ -1526,7 +1529,7 @@ itself, by setting the status and exit-code fields.")
 				   external-format)))
 		    (with-string-vector (argv args encoding)
 		      (run-external-process proc in-fd out-fd error-fd argv
-					    env)))))
+					    env directory)))))
 	     (wait-on-semaphore (external-process-signal proc)))
         (dolist (fd close-in-parent) (fd-close fd))
         (unless (external-process-pid proc)