From: Mark Wooding <mdw@distorted.org.uk>
Date: Wed, 1 Jun 2011 21:31:20 +0000 (+0100)
Subject: optparse.lisp: Light reformatting.
X-Git-Url: https://git.distorted.org.uk/~mdw/lisp/commitdiff_plain/d977f44b3dbc17d099431c53d053005262769c6b

optparse.lisp: Light reformatting.

Also, use PRINT-UNREADABLE-OBJECT in the printer for OPTION, rather than
printing the delimiters by hand.  Nothing especially substantial,
though.
---

diff --git a/optparse.lisp b/optparse.lisp
index 1322e10..09050f6 100644
--- a/optparse.lisp
+++ b/optparse.lisp
@@ -27,7 +27,7 @@
 ;;; Packages.
 
 (defpackage #:optparse
-  (:use #:common-lisp #:mdw.base #:mdw.sys-base #:mdw.str)
+  (:use #:common-lisp #:mdw.base #:mdw.sys-base)
   (:export #:exit #:*program-name* #:*command-line*
 	   #:moan #:die
 	   #:option #:optionp #:make-option
@@ -68,38 +68,29 @@
 
 (defvar *options* nil)
 
-(defstruct (option (:predicate optionp)
-		   (:conc-name opt-)
-		   (:print-function
-		    (lambda (o s k)
-		      (declare (ignore k))
-		      (format s
-			      #.(concatenate 'string
-					     "#<option"
-					     "~@[ -~C,~]"
-					     "~@[ --~A~]"
-					     "~:[~2*~;~:[=~A~;[=~A]~]~]"
-					     "~@[ ~S~]"
-					     ">")
-		              (opt-short-name o)
-			      (opt-long-name o)
-			      (opt-arg-name o)
-			      (opt-arg-optional-p o)
-			      (opt-arg-name o)
-			      (opt-documentation o))))
-		   (:constructor %make-option)
-		   (:constructor make-option
-				 (long-name
-				  short-name
-				  &optional
-				  arg-name
-				  &key
-				  (tag (intern (string-upcase long-name)
-					       :keyword))
-				  negated-tag
-				  arg-optional-p
-				  doc
-				  (documentation doc))))
+(defstruct (option
+	     (:predicate optionp)
+	     (:conc-name opt-)
+	     (:print-function
+	      (lambda (o s k)
+		(declare (ignore k))
+		(print-unreadable-object (o s :type t)
+		  (format s "~@[-~C, ~]~@[--~A~]~
+			     ~*~@[~2:*~:[=~A~;[=~A]~]~]~
+			     ~@[ ~S~]"
+			  (opt-short-name o)
+			  (opt-long-name o)
+			  (opt-arg-optional-p o)
+			  (opt-arg-name o)
+			  (opt-documentation o)))))
+	     (:constructor %make-option)
+	     (:constructor make-option
+		 (long-name short-name
+		  &optional arg-name
+		  &key (tag (intern (string-upcase long-name) :keyword))
+		       negated-tag
+		       arg-optional-p
+		       doc (documentation doc))))
   "Describes a command-line option.  Slots:
 
    LONG-NAME	The option's long name.  If this is null, the `option' is
@@ -138,23 +129,20 @@
   (arg-optional-p nil :type t)
   (documentation nil :type (or null string)))
 
-(defstruct (option-parser (:conc-name op-)
-			  (:constructor make-option-parser
-					(&key
-					 ((:args argstmp)
-					  (cdr *command-line*))
-					 (options *options*)
-					 (non-option :skip)
-					 ((:numericp numeric-p))
-					 negated-numeric-p
-					 long-only-p
-					 &aux
-					 (args (cons nil argstmp))
-					 (next args)
-					 (negated-p (or negated-numeric-p
-							(some
-							 #'opt-negated-tag
-							 options))))))
+(defstruct (option-parser
+	     (:conc-name op-)
+	     (:constructor make-option-parser
+		 (&key ((:args argstmp) (cdr *command-line*))
+		       (options *options*)
+		       (non-option :skip)
+		       ((:numericp numeric-p))
+		       negated-numeric-p
+		       long-only-p
+		  &aux (args (cons nil argstmp))
+		       (next args)
+		       (negated-p (or negated-numeric-p
+				      (some #'opt-negated-tag
+					    options))))))
   "An option parser object.  Slots:
 
    ARGS		The arguments to be parsed.  Usually this will be
@@ -262,7 +250,7 @@
 		    (setf arg (get-arg)))
 		   (t
 		    (option-parse-error "Option `~A' requires an argument"
-		     name)))
+					name)))
 	     (let ((how (if negp (opt-negated-tag o) (opt-tag o))))
 	       (if (functionp how)
 		   (funcall how arg)
@@ -704,10 +692,10 @@
 		     (t
 		      (error "Unexpected thing ~S in option form." f))))
 	     `(make-option ,long-name ,short-name ,arg-name
-	       ,@(and arg-optional-p `(:arg-optional-p t))
-	       ,@(and tag `(:tag ,tag))
-	       ,@(and negated-tag `(:negated-tag ,negated-tag))
-	       ,@(and doc `(:documentation ,doc))))))))
+			   ,@(and arg-optional-p `(:arg-optional-p t))
+			   ,@(and tag `(:tag ,tag))
+			   ,@(and negated-tag `(:negated-tag ,negated-tag))
+			   ,@(and doc `(:documentation ,doc))))))))
 
 (defmacro options (&rest optlist)
   "More convenient way of initializing options.  The OPTLIST is a list of