chiark - git - mdw - lisp/blob - optparse-test

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