X-Git-Url: https://git.distorted.org.uk/~mdw/lisp/blobdiff_plain/861345b43569790e39df152c6b495b14e7dab360..813da880d2d77f04ea623f426d543d298528f967:/optparse-test

diff --git a/optparse-test b/optparse-test
index cd38066..de0d6eb 100755
--- a/optparse-test
+++ b/optparse-test
@@ -1,9 +1,9 @@
-#! /usr/local/bin/runlisp
-;;; -*-lisp-*-
+#! /bin/sh
+":"; exec cl-launch -X -s mdw -- "$0" "$@" || exit 1 # -*-lisp-*-
 
-;; (format t "Startup!~%")
-(asdf:operate 'asdf:load-op 'mdw :verbose nil)
-(use-package '#:mdw.optparse)
+(cl:defpackage #:optparse-test
+  (:use #:common-lisp #:optparse))
+(cl:in-package #:optparse-test)
 
 (defvar opt-bool nil)
 (defvar opt-int nil)
@@ -13,66 +13,76 @@
 (defvar opt-keyword nil)
 (defvar opt-enum nil)
 (defvar opt-counter 2)
+(defvar opt-object nil)
 
-(defconstant options
-  (options
-   "Help options"
-   (#\h "help"
-	(lambda (arg)
-	  (declare (ignore arg))
-	  (show-help *program-name* "1.0.0" "usage-blah" options)
-	  (exit 0))
-	("Show this help text."))
-   (   "version"
-       (lambda (arg)
-	 (declare (ignore arg))
-	 (format t "~A, version ~A~%" *program-name* "1.0.0")
-	 (exit 0))
-       ("Show ~A's version number." *program-name*))
-   "Test options"
-   (#\b "boolean" (set opt-bool) (clear opt-bool)
-	("Set (or clear, if negated) the boolean flag."))
-   (#\i "integer" (:arg "INT") (int opt-int :min -10 :max 10)
-	("Set an integer between -10 and +10."))
-   (#\l "list" (:arg "STRING") (list opt-list)
-	("Stash an item in the string list."))
-   (#\I "int-list" (:arg "INT")
-	(list opt-int-list 'int :min -10 :max 10)
-	("Stash an integer between -10 and +10 in the int list."))
-   (#\s "string" (:arg "STRING") (string opt-string)
-	("Set a string."))
-   (#\q "quiet" (dec opt-counter 0)
-	("Be more quiet."))
-   (#\v "verbose" (inc opt-counter 5)
-	("Be more verbose."))
-   (#\Q "very-quiet" (dec opt-counter 0 3)
-	("Be much more quiet."))
-   (#\V "very-verbose" (inc opt-counter 5 3)
-	("Be much more verbose."))
-   (#\k "keywword" (:arg "KEYWORD") (keyword opt-keyword)
-	("Set an arbitrary keyword."))
-   (#\e "enumeration" (:arg "ENUM")
-	(keyword opt-enum :apple :apple-pie :abacus :banana)
-	("Set a keyword from a fixed set."))))
+(define-program
+  :help "This program exists to test the Lisp options parser."
+  :usage "ARGUMENTS..."
+  :version "1.0.0"
+  :options (options
+	    (help-options :short-version nil)
+	    "Test options"
+	    (#\b "boolean" (set opt-bool) (clear opt-bool)
+		 ("Set (or clear, if negated) the boolean flag."))
+	    (#\i "integer" (:arg "INT") (int opt-int :min -10 :max 10)
+		 ("Set an integer between -10 and +10."))
+	    (#\l "list" (:arg "STRING") (list opt-list)
+		 ("Stash an item in the string list."))
+	    (#\I "int-list" (:arg "INT")
+		 (list opt-int-list 'int :min -10 :max (+ 5 5))
+		 ("Stash an integer between -10 and +10 in the int list."))
+	    (#\s "string" (:arg "STRING") (string opt-string)
+		 ("Set a string."))
+	    (#\q "quiet" (dec opt-counter 0)
+		 ("Be more quiet."))
+	    (#\v "verbose" (inc opt-counter 5)
+		 ("Be more verbose."))
+	    (#\Q "very-quiet" (dec opt-counter 0 3)
+		 ("Be much more quiet."))
+	    (#\V "very-verbose" (inc opt-counter 5 3)
+		 ("Be much more verbose."))
+	    ((:short-name #\o)
+	     (:long-name "object")
+	     (:arg "OBJECT")
+	     (read opt-object)
+	     (:doc (concatenate 'string
+				"Read object (time = "
+				(princ-to-string (get-universal-time))
+				")")))
+	    (#\k "keyword" (:arg "KEYWORD") (keyword opt-keyword)
+		 ("Set an arbitrary keyword."))
+	    (#\e "enumeration" (:arg "ENUM")
+		 (keyword opt-enum (list :apple :apple-pie :abacus :banana))
+		 ("Set a keyword from a fixed set."))
+	    (#\x "xray" (:arg "WAVELENGTH")
+		 "Report an option immediately.")
+	    (#\y "yankee" :yankee :no-yankee
+		 "Report an option immediately.")
+	    (#\z "zulu" (:opt-arg "TRIBE")
+		 (lambda (arg)
+		   (when (and (plusp (length arg))
+			      (char-equal (char arg 0) #\z))
+		     (option-parse-return :zzulu arg))
+		   (format t "Ignoring insufficiently zeddy Zulu ~A~%" arg))
+		 "Report an option immediately.")))
 
 (defun test (args)
-  (let ((op (make-option-parser (cdr args) options)))
-    (unless (option-parse-try
-	      (loop
-		 (multiple-value-bind (opt arg) (option-parse-next op)
-		   (unless opt (return))
-		   (format t "Option ~S: `~A'~%" opt arg))))
-      (exit 1))
-    (format t "Non-option arguments: ~S~%" (option-parse-remainder op))
-    (format t "boolean: ~S~%" opt-bool)
-    (format t "integer: ~S~%" opt-int)
-    (format t "list: ~S~%" opt-list)
-    (format t "int-list: ~S~%" opt-int-list)
-    (format t "string : ~S~%" opt-string)
-    (format t "counter: ~S~%" opt-counter)
-    (format t "keyword: ~S~%" opt-keyword)
-    (format t "enum: ~S~%" opt-enum)))
-(test *command-line-strings*)
-
-
-
+  (unless (option-parse-try
+	    (do-options (:parser (make-option-parser :args args))
+	      (:xray (arg)
+		     (format t "Emitting X-ray of wavelength ~A nm~%" arg))
+	      (t (opt arg)
+		 (format t "Option ~S: `~A'~%" opt arg))
+	      (nil (rest)
+		   (format t "Non-option arguments: ~S~%" rest))))
+    (die-usage))
+  (format t "boolean: ~S~%" opt-bool)
+  (format t "integer: ~S~%" opt-int)
+  (format t "list: ~S~%" opt-list)
+  (format t "int-list: ~S~%" opt-int-list)
+  (format t "string : ~S~%" opt-string)
+  (format t "counter: ~S~%" opt-counter)
+  (format t "keyword: ~S~%" opt-keyword)
+  (format t "enum: ~S~%" opt-enum)
+  (format t "object: ~S~%" opt-object))
+(test (cdr *command-line*))