X-Git-Url: https://git.distorted.org.uk/~mdw/lisp/blobdiff_plain/340560aa6113fde0aa8a3bb94bcdbb32860f5eea..1a50efd8a9e976bf16a29ce381ea38c6b9a39ea1:/sys-base.lisp diff --git a/sys-base.lisp b/sys-base.lisp index fadbb87..370e80e 100644 --- a/sys-base.lisp +++ b/sys-base.lisp @@ -25,34 +25,37 @@ (defpackage #:runlisp (:use #:common-lisp) - (:export #:*raw-command-line* #:*command-line* #:exit) + (:export #:*command-line* #:exit) #+clisp (:import-from #:ext #:exit)) (defpackage #:mdw.sys-base (:use #:common-lisp #:runlisp) (:export #:exit #:hard-exit #:*program-name* #:*command-line* - set-command-line-arguments) - (:import-from #:runlisp #:*raw-command-line* #:*command-line* #:exit)) + #:set-command-line-arguments) + (:import-from #:runlisp #:*command-line* #:exit)) (in-package #:mdw.sys-base) -(defvar *raw-command-line*) (defvar *command-line*) (defvar *program-name*) (defun set-command-line-arguments () - (setf *raw-command-line* - (or #+cl-launch cl-launch:*arguments* + (setf *command-line* + (or (when (member :cl-launch *features*) + (let* ((cll-package (find-package :cl-launch)) + (name (funcall (intern "GETENV" cll-package) + "CL_LAUNCH_FILE")) + (args (symbol-value (intern "*ARGUMENTS*" + cll-package)))) + (if name + (cons name args) + args))) #+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) + #+clisp (loop with argv = (ext:argv) + for i from 7 below (length argv) + collect (aref argv i)) '("" "--" ""))) - (setf *command-line* - (or #+cl-launch (cons (or (cl-launch:getenv "CL_LAUNCH_FILE") - "") - cl-launch:*arguments*) - (cdr (member "--" *raw-command-line* :test #'string=)) - *raw-command-line*)) (setf *program-name* (pathname-name (car *command-line*)))) (set-command-line-arguments)