mdw@git.distorted.org.uk Git - lisp/blob - optparse-test

   1 #! /usr/local/bin/runlisp
   2
   3 (let ((*compile-verbose* nil)
   4       (*load-verbose* nil))
   5   (asdf:oos 'asdf:load-op "mdw" :verbose nil))
   6 (handler-case
   7     (use-package '#:optparse)
   8   (error (c) (invoke-debugger c)))
   9
  10 (defvar opt-bool nil)
  11 (defvar opt-int nil)
  12 (defvar opt-list nil)
  13 (defvar opt-int-list nil)
  14 (defvar opt-string nil)
  15 (defvar opt-keyword nil)
  16 (defvar opt-enum nil)
  17 (defvar opt-counter 2)
  18 (defvar opt-object nil)
  19
  20 (define-program
  21   :help "This program exists to test the Lisp options parser."
  22   :usage "ARGUMENTS..."
  23   :version "1.0.0"
  24   :options (options
  25             (help-options :short-version nil)
  26             "Test options"
  27             (#\b "boolean" (set opt-bool) (clear opt-bool)
  28                  ("Set (or clear, if negated) the boolean flag."))
  29             (#\i "integer" (:arg "INT") (int opt-int :min -10 :max 10)
  30                  ("Set an integer between -10 and +10."))
  31             (#\l "list" (:arg "STRING") (list opt-list)
  32                  ("Stash an item in the string list."))
  33             (#\I "int-list" (:arg "INT")
  34                  (list opt-int-list 'int :min -10 :max (+ 5 5))
  35                  ("Stash an integer between -10 and +10 in the int list."))
  36             (#\s "string" (:arg "STRING") (string opt-string)
  37                  ("Set a string."))
  38             (#\q "quiet" (dec opt-counter 0)
  39                  ("Be more quiet."))
  40             (#\v "verbose" (inc opt-counter 5)
  41                  ("Be more verbose."))
  42             (#\Q "very-quiet" (dec opt-counter 0 3)
  43                  ("Be much more quiet."))
  44             (#\V "very-verbose" (inc opt-counter 5 3)
  45                  ("Be much more verbose."))
  46             ((:short-name #\o)
  47              (:long-name "object")
  48              (:arg "OBJECT")
  49              (read opt-object)
  50              (:doc (concatenate 'string
  51                                 "Read object (time = "
  52                                 (princ-to-string (get-universal-time))
  53                                 ")")))
  54             (#\k "keyword" (:arg "KEYWORD") (keyword opt-keyword)
  55                  ("Set an arbitrary keyword."))
  56             (#\e "enumeration" (:arg "ENUM")
  57                  (keyword opt-enum (list :apple :apple-pie :abacus :banana))
  58                  ("Set a keyword from a fixed set."))
  59             (#\x "xray" (:arg "WAVELENGTH")
  60                  "Report an option immediately.")
  61             (#\y "yankee" :yankee :no-yankee
  62                  "Report an option immediately.")
  63             (#\z "zulu" (:opt-arg "TRIBE")
  64                  (lambda (arg)
  65                    (when (and (plusp (length arg))
  66                               (char-equal (char arg 0) #\z))
  67                      (option-parse-return :zzulu arg))
  68                    (format t "Ignoring insufficiently zeddy Zulu ~A~%" arg))
  69                  "Report an option immediately.")))
  70
  71 (defun test (args)
  72   (unless (option-parse-try
  73             (do-options (:parser (make-option-parser :args args))
  74               (:xray (arg)
  75                      (format t "Emitting X-ray of wavelength ~A nm~%" arg))
  76               (t (opt arg)
  77                  (format t "Option ~S: `~A'~%" opt arg))
  78               (nil (rest)
  79                    (format t "Non-option arguments: ~S~%" rest))))
  80     (die-usage))
  81   (format t "boolean: ~S~%" opt-bool)
  82   (format t "integer: ~S~%" opt-int)
  83   (format t "list: ~S~%" opt-list)
  84   (format t "int-list: ~S~%" opt-int-list)
  85   (format t "string : ~S~%" opt-string)
  86   (format t "counter: ~S~%" opt-counter)
  87   (format t "keyword: ~S~%" opt-keyword)
  88   (format t "enum: ~S~%" opt-enum)
  89   (format t "object: ~S~%" opt-object))
  90 (test (cdr *command-line-strings*))
  91
  92
  93