src/optparse.lisp: Rearrange system-specific stuff.
authorMark Wooding <mdw@distorted.org.uk>
Wed, 25 May 2016 15:30:16 +0000 (16:30 +0100)
committerMark Wooding <mdw@distorted.org.uk>
Wed, 25 May 2016 16:20:54 +0000 (17:20 +0100)
  * Remove `cl-launch' from the explicit `:use' list.

  * Prefer using `uiop' to collect arguments if it's present, because it
    does everything properly.

  * Fall back to `cl-launch' driven by steam if it's available.

  * Otherwise use a hacky list of system-specific runes copied from my
    other Lisp library.

  * Reformat the `exit' function so it's easier to slot new
    implementations in, similar to the new `set-command-line-arguments'.

  * Load `sod-frontend' and use `optparse:exit' rather than
    `cl-launch:quit', because the latter has disappeared in later
    versions.

src/Makefile.am
src/optparse.lisp

index 867b149..e13f157 100644 (file)
@@ -154,11 +154,15 @@ sod-test.asd: sod-test.asd.in Makefile
 
 ## Running the Lisp tests.
 check-local: sod sod-test.asd
-       $(V_TEST)$(ASDF_ENV) $(CL_LAUNCH) -l $(LISPSYS) -s sod-test +I \
-               -i '(handler-case (asdf:test-system "sod") ;\
+       $(V_TEST)$(ASDF_ENV) $(CL_LAUNCH) -l $(LISPSYS) \
+               -s sod-frontend +I \
+               -i '(handler-case ;\
+                       (progn ;\
+                         (asdf:load-system "sod-test") ;\
+                         (asdf:test-system "sod")) ;\
                      (error (cond) ;\
                        (format *error-output* "ERR: ~A~%" cond) ;\
-                       (cl-launch:quit 1)))'
+                       (optparse:exit 1)))'
 
 ###--------------------------------------------------------------------------
 ### Manual pages.
index 88f5bd7..74df161 100644 (file)
@@ -24,7 +24,7 @@
 ;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 
 (cl:defpackage #:optparse
-  (:use #:common-lisp #:cl-launch #:sod-utilities))
+  (:use #:common-lisp #:sod-utilities))
 
 (cl:in-package #:optparse)
 
 (defun exit (&optional (code 0) &key abrupt)
   "End program, returning CODE to the caller."
   (declare (type (unsigned-byte 32) code))
-  #+sbcl (sb-ext:exit :code code :abort abrupt)
-  #+cmu (if abrupt
-           (unix::void-syscall ("_exit" c-call:int) code)
-           (ext:quit code))
-  #+clisp (funcall (if abrupt #'ext:quit #'ext:exit) code)
-  #+ecl (ext:quit code)
-
-  #-(or sbcl cmu clisp ecl)
-  (progn
-    (unless (zerop code)
-      (format *error-output*
-             "~&Exiting unsuccessfully with code ~D.~%" code))
-    (abort)))
+  #.(car '(#+sbcl (sb-ext:exit :code code :abort abrupt)
+          #+cmu (if abrupt
+                    (unix::void-syscall ("_exit" c-call:int) code)
+                    (ext:quit code))
+          #+clisp (funcall (if abrupt #'ext:quit #'ext:exit) code)
+          #+ecl (ext:quit code)
+          (unless (zerop code)
+            (format *error-output*
+                    "~&Exiting unsuccessfully with code ~D.~%" code))))
+  (abort))
 
 (export '(*program-name* *command-line*))
 (defvar *program-name* "<unknown>"
    Set `*command-line*' and `*program-name*'."
 
   (setf *command-line*
-       (cons (or (getenv "CL_LAUNCH_FILE")
-                 #+sbcl (car sb-ext:*posix-argv*)
-                 #+cmu (car ext:*command-line-strings*)
-                 #+clisp (aref (ext:argv) 0)
-                 #+ecl (ext:argv 0)
-                 #-(or sbcl cmu clisp ecl) "sod")
-             *arguments*)
-
-       *program-name* (pathname-name (car *command-line*))))
+       (let ((uiop-package (find-package :uiop))
+             (cll-package (find-package :cl-launch)))
+         (cons (or (and uiop-package
+                        (funcall (intern "ARGV0" uiop-package)))
+                   (and cll-package
+                        (some (intern "GETENV" cll-package)
+                              (list "__CL_ARGV0" "CL_LAUNCH_FILE")))
+                   #+sbcl (car sb-ext:*posix-argv*)
+                   #+cmu (car ext:*command-line-strings*)
+                   #+clisp (aref (ext:argv) 0)
+                   #+ecl (ext:argv 0)
+                   "sod")
+               (cond (uiop-package
+                      (funcall (intern "COMMAND-LINE-ARGUMENTS"
+                                       uiop-package)))
+                     (cll-package
+                      (symbol-value (intern "*ARGUMENTS*" cll-package)))
+                     (t #.(or (car '(#+sbcl (cdr sb-ext:*posix-argv*)
+                                     #+cmu (cdr ext:*command-line-strings*)
+                                     #+clisp (coerce (subseq (ext:argv) 8)
+                                              'list)
+                                     #+ecl (loop for i from 1
+                                                 below (ext:argc)
+                                                 collect (ext:argv i))))
+                              (error "Unsupported Lisp."))))))
+
+         *program-name* (pathname-name (car *command-line*))))
 
 ;;;--------------------------------------------------------------------------
 ;;; Fancy conditionals.