safely.lisp: SAFE-COPY shouldn't make two copies under CLisp.
[lisp] / optparse-test
index cd38066..de0d6eb 100755 (executable)
@@ -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)
 (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*))