sys-base: Fix support for CL-LAUNCH.

[lisp] / optparse-test

#! /usr/local/bin/runlisp

(cl:defpackage #:optparse-test
  (:use #:common-lisp))
(cl:in-package #:optparse-test)

(let ((*compile-verbose* nil)
      (*load-verbose* nil))
  (asdf:oos 'asdf:load-op "mdw" :verbose nil))
(handler-case
    (use-package '#:optparse)
  (error (c) (invoke-debugger c)))

(defvar opt-bool nil)
(defvar opt-int nil)
(defvar opt-list nil)
(defvar opt-int-list nil)
(defvar opt-string nil)
(defvar opt-keyword nil)
(defvar opt-enum nil)
(defvar opt-counter 2)
(defvar opt-object nil)

(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)
  (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*))