chiark / gitweb /
src/final.lisp, src/frontend.lisp: Compile methods before dumping.
[sod] / src / optparse.lisp
index 38a3ae4689f58bcb13d34222278dbd268dc9bf44..70bb0122cc335dd5dd22b8f65af2551498e3c3a1 100644 (file)
@@ -24,7 +24,7 @@
 ;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 
 (cl:defpackage #:optparse
 ;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 
 (cl:defpackage #:optparse
-  (:use #:common-lisp #:sod-utilities))
+  (:use #:common-lisp #:cl-launch #:sod-utilities))
 
 (cl:in-package #:optparse)
 
 
 (cl:in-package #:optparse)
 
@@ -62,21 +62,13 @@ (defun set-command-line-arguments ()
    Set `*command-line*' and `*program-name*'."
 
   (setf *command-line*
    Set `*command-line*' and `*program-name*'."
 
   (setf *command-line*
-       (or (when (member :cl-launch *features*)
-             (let* ((cllpkg (find-package :cl-launch))
-                    (name (funcall (intern "GETENV" cllpkg)
-                                   "CL_LAUNCH_FILE"))
-                    (args (symbol-value (intern "*ARGUMENTS*" cllpkg))))
-               (if name
-                   (cons name args)
-                   args)))
-           #+sbcl sb-ext:*posix-argv*
-           #+cmu ext:*command-line-strings*
-           #+clisp (loop with argv = (ext:argv)
-                         for i from 7 below (length argv)
-                         collect (aref argv i))
-           #+ecl (loop from i below (ext:argc) collect (ext:argv i))
-           '("<unknown-script>"))
+       (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*))))
 
 
        *program-name* (pathname-name (car *command-line*))))
 
@@ -684,7 +676,7 @@ (defopthandler inc (var) (&optional max (step 1))
   "Increments VAR by STEP (defaults to 1), but not greater than MAX (default
    nil for no maximum).  No errors are signalled."
   (incf var step)
   "Increments VAR by STEP (defaults to 1), but not greater than MAX (default
    nil for no maximum).  No errors are signalled."
   (incf var step)
-  (when (>= var max)
+  (when (and max (>= var max))
     (setf var max)))
 
 (export 'dec)
     (setf var max)))
 
 (export 'dec)
@@ -692,7 +684,7 @@ (defopthandler dec (var) (&optional min (step 1))
   "Decrements VAR by STEP (defaults to 1), but not less than MIN (default nil
    for no maximum).  No errors are signalled."
   (decf var step)
   "Decrements VAR by STEP (defaults to 1), but not less than MIN (default nil
    for no maximum).  No errors are signalled."
   (decf var step)
-  (when (<= var min)
+  (when (and min (<= var min))
     (setf var min)))
 
 (export 'read)
     (setf var min)))
 
 (export 'read)
@@ -1106,6 +1098,7 @@ (defun sanity-check-option-list (opts)
 ;;;--------------------------------------------------------------------------
 ;;; Full program descriptions.
 
 ;;;--------------------------------------------------------------------------
 ;;; Full program descriptions.
 
+(export '(*help* *version* *usage*))
 (defvar *help* nil "Help text describing the program.")
 (defvar *version* "<unreleased>" "The program's version number.")
 (defvar *usage* nil "A usage summary string")
 (defvar *help* nil "Help text describing the program.")
 (defvar *version* "<unreleased>" "The program's version number.")
 (defvar *usage* nil "A usage summary string")