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

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