chiark / gitweb /
sys-base: Improve cl-launch support.
authorMark Wooding <mdw@distorted.org.uk>
Wed, 26 Nov 2008 21:03:58 +0000 (21:03 +0000)
committerMark Wooding <mdw@distorted.org.uk>
Wed, 26 Nov 2008 21:03:58 +0000 (21:03 +0000)
In particular, collect the command line and script name accurately.

sys-base.lisp

index fadbb873c70b083b1d76a46c15c6601ffecb4647..bb1cd452497ddb966fa6d744dfda324212ce18f2 100644 (file)
@@ -41,16 +41,20 @@ (defvar *program-name*)
 
 (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*))))