X-Git-Url: https://git.distorted.org.uk/~mdw/lisp/blobdiff_plain/861345b43569790e39df152c6b495b14e7dab360..02866e072a8ac99b5e639fe79b4a7c6df5f11fdc:/optparse.lisp

diff --git a/optparse.lisp b/optparse.lisp
index 9599604..a09c188 100644
--- a/optparse.lisp
+++ b/optparse.lisp
@@ -23,6 +23,9 @@
 ;;; along with this program; if not, write to the Free Software Foundation,
 ;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 
+;;;--------------------------------------------------------------------------
+;;; Packages.
+
 (defpackage #:mdw.optparse
   (:use #:common-lisp #:mdw.base #:mdw.sys-base #:mdw.str)
   (:export #:exit #:*program-name* #:*command-line-strings*
@@ -45,6 +48,7 @@
 
 (in-package #:mdw.optparse)
 
+;;;--------------------------------------------------------------------------
 ;;; Standard error-reporting functions.
 
 (defun moan (msg &rest args)
@@ -55,6 +59,7 @@
   (apply #'moan args)
   (exit 1))
 
+;;;--------------------------------------------------------------------------
 ;;; The main option parser.
 
 (defstruct (option (:predicate optionp)
@@ -411,6 +416,7 @@ completed successfully, or nil if errors occurred."
        (error (,cond)
 	 (die "~A" ,cond)))))
 
+;;;--------------------------------------------------------------------------
 ;;; Standard option handlers.
 
 (defmacro defopthandler (name (var &optional (arg (gensym)))
@@ -436,35 +442,36 @@ for any radix between 2 and 36.  Prefixes are only accepted if RADIX is nil.
 Returns two values: the integer parsed (or nil if there wasn't enough for a
 sensible parse), and the index following the characters of the integer."
   (unless end (setf end (length string)))
-  (labels ((simple (a i r goodp sgn)
-	     (loop
-		(when (>= i end)
-		  (return (values (and goodp (* a sgn)) i)))
-		(let ((d (digit-char-p (char string i) r)))
-		  (unless d
-		    (return (values (and goodp (* a sgn)) i)))
-		  (setf a (+ (* a r) d))
-		  (setf goodp t)
-		  (incf i))))
+  (labels ((simple (i r goodp sgn)
+	     (multiple-value-bind
+		 (a i)
+		 (if (and (< i end)
+			  (digit-char-p (char string i) r))
+		     (parse-integer string
+				    :start i :end end
+				    :radix r
+				    :junk-allowed t)
+		     (values nil i))
+	       (values (if a (* sgn a) (and goodp 0)) i)))
 	   (get-radix (i r sgn)
-	     (cond (r (simple 0 i r nil sgn))
+	     (cond (r (simple i r nil sgn))
 		   ((>= i end) (values nil i))
 		   ((and (char= (char string i) #\0)
 			 (>= (- end i) 2))
 		    (case (char string (1+ i))
-		      (#\x (simple 0 (+ i 2) 16 nil sgn))
-		      (#\o (simple 0 (+ i 2) 8 nil sgn))
-		      (#\b (simple 0 (+ i 2) 2 nil sgn))
-		      (t (simple 0 (1+ i) 8 t sgn))))
+		      (#\x (simple (+ i 2) 16 nil sgn))
+		      (#\o (simple (+ i 2) 8 nil sgn))
+		      (#\b (simple (+ i 2) 2 nil sgn))
+		      (t (simple (1+ i) 8 t sgn))))
 		   (t
 		    (multiple-value-bind
-			  (r i)
-			(simple 0 i 10 nil +1)
+			(r i)
+			(simple i 10 nil +1)
 		      (cond ((not r) (values nil i))
 			    ((and (< i end)
 				  (char= (char string i) #\_)
 				  (<= 2 r 36))
-			     (simple 0 (1+ i) r nil sgn))
+			     (simple (1+ i) r nil sgn))
 			    (t
 			     (values (* r sgn) i))))))))
     (cond ((>= start end) (values nil start))
@@ -662,6 +669,7 @@ items.  Acceptable items are interpreted as follows:
 			 (parse-option-form form)))
 		   optlist)))
 
+;;;--------------------------------------------------------------------------
 ;;; Support stuff for help and usage messages
 
 (defun print-text (string