From: Mark Wooding <mdw@distorted.org.uk>
Date: Wed, 26 Nov 2008 21:03:58 +0000 (+0000)
Subject: sys-base: Improve cl-launch support.
X-Git-Url: https://git.distorted.org.uk/~mdw/lisp/commitdiff_plain/1cbc65e7d3d318b21fa3793676ad203a799e2206

sys-base: Improve cl-launch support.

In particular, collect the command line and script name accurately.
---

diff --git a/sys-base.lisp b/sys-base.lisp
index fadbb87..bb1cd45 100644
--- a/sys-base.lisp
+++ b/sys-base.lisp
@@ -41,16 +41,20 @@
 
 (defun set-command-line-arguments ()
   (setf *raw-command-line*
-	(or #+cl-launch cl-launch:*arguments*
+	(or (when (member :cl-launched *features*)
+	      (cons (or (funcall (intern "GETENV" (find-package :cl-launch))
+				 "CL_LAUNCH_FILE")
+			"<unknown-script>")
+		    (symbol-value (intern "*ARGUMENTS*"
+					  (find-package :cl-launch)))))
 	    #+cmu ext:*command-line-strings*
 	    #+sbcl sb-ext:*posix-argv*
 	    #+ecl (loop from i below (ext:argc) collect (ext:argv i))
 	    #+clisp (coerce (ext:argv) 'list)
 	    '("<unknown-lisp>" "--" "<unknown-script>")))
   (setf *command-line*
-	(or #+cl-launch (cons (or (cl-launch:getenv "CL_LAUNCH_FILE")
-				  "<unknown-script>")
-			      cl-launch:*arguments*)
+	(or (when (member :cl-launched *features*)
+	      *raw-command-line*)
 	    (cdr (member "--" *raw-command-line* :test #'string=))
 	    *raw-command-line*))
   (setf *program-name* (pathname-name (car *command-line*))))