General tidying and prettifying.

[lisp] / optparse.lisp

diff --git a/optparse.lisp b/optparse.lisp
index 9599604..a09c188 100644 (file)
--- 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