src/options/enum.lisp

   1 ;;; enum.lisp --- Enumeration Options
   2
   3 ;; Copyright (C) 2010, 2011, 2012 Didier Verna.
   4
   5 ;; Author:     Didier Verna <didier@lrde.epita.fr>
   6 ;; Maintainer: Didier Verna <didier@lrde.epita.fr>
   7
   8 ;; This file is part of Clon.
   9
  10 ;; Permission to use, copy, modify, and distribute this software for any
  11 ;; purpose with or without fee is hereby granted, provided that the above
  12 ;; copyright notice and this permission notice appear in all copies.
  13
  14 ;; THIS SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
  15 ;; WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
  16 ;; MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
  17 ;; ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
  18 ;; WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
  19 ;; ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
  20 ;; OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  21
  22
  23 ;;; Commentary:
  24
  25 ;; Contents management by FCM version 0.1.
  26
  27
  28 ;;; Code:
  29
  30 (in-package :com.dvlsoft.clon)
  31 (in-readtable :com.dvlsoft.clon)
  32
  33
  34 ;; ==========================================================================
  35 ;; The Enum Option Class
  36 ;; ==========================================================================
  37
  38 (defoption enum (enum-base)
  39   ((argument-name ;; inherited from the VALUED-OPTION class
  40     :initform "TYPE"))
  41   (:documentation "The ENUM class.
  42 This class implements options whose values belong to a set of keywords."))
  43
  44
  45 ;; ------------------------------
  46 ;; Value Stringification protocol
  47 ;; ------------------------------
  48
  49 (defmethod stringify ((enum enum) value)
  50   "Transform ENUM's VALUE into an argument."
  51   #+ecl (declare (ignore enum))
  52   (string-downcase (symbol-name value)))
  53
  54
  55 ;; --------------------
  56 ;; Value Check protocol
  57 ;; --------------------
  58
  59 (defmethod check ((enum enum) value)
  60   "Check that VALUE is valid for ENUM."
  61   (unless (member value (enum enum))
  62     (error 'invalid-value
  63            :option enum
  64            :value value
  65            :comment (format nil "Valid values are: ~A."
  66                       (list-to-string (enum enum)
  67                                       :key #'prin1-to-string))))
  68   value)
  69
  70
  71 ;; ----------------------------
  72 ;; Argument Conversion protocol
  73 ;; ----------------------------
  74
  75 (defmethod convert ((enum enum) argument)
  76   "Convert ARGUMENT to an ENUM value."
  77   (or (closest-match argument (enum enum) :ignore-case t :key #'symbol-name)
  78       (error 'invalid-argument
  79              :option enum
  80              :argument argument
  81              :comment (format nil "Valid arguments are: ~A."
  82                         (list-to-string (enum enum)
  83                                         :key (lambda (value)
  84                                                (stringify enum value)))))))
  85
  86
  87
  88 ;; ==========================================================================
  89 ;; Enum Instance Creation
  90 ;; ==========================================================================
  91
  92 (defun make-enum (&rest keys
  93                   &key short-name long-name description
  94                        argument-name argument-type
  95                        enum env-var fallback-value default-value
  96                        hidden)
  97   "Make a new enum option.
  98 - SHORT-NAME is the option's short name (without the dash).
  99   It defaults to nil.
 100 - LONG-NAME is the option's long name (without the double-dash).
 101   It defaults to nil.
 102 - DESCRIPTION is the option's description appearing in help strings.
 103   It defaults to nil.
 104 - ARGUMENT-NAME is the option's argument name appearing in help strings.
 105 - ARGUMENT-TYPE is one of :required, :mandatory or :optional (:required and
 106   :mandatory are synonyms).
 107   It defaults to :optional.
 108 - ENUM is the set of possible values.
 109 - ENV-VAR is the option's associated environment variable.
 110   It defaults to nil.
 111 - FALLBACK-VALUE is the option's fallback value (for missing optional
 112   arguments), if any.
 113 - DEFAULT-VALUE is the option's default value, if any.
 114 - When HIDDEN, the option doesn't appear in help strings."
 115   (declare (ignore short-name long-name description
 116                    argument-name argument-type
 117                    enum env-var fallback-value default-value
 118                    hidden))
 119   (apply #'make-instance 'enum keys))
 120
 121 #i(make-internal-enum 2)
 122 (defun make-internal-enum (long-name description
 123                            &rest keys
 124                            &key argument-name argument-type
 125                                 enum env-var fallback-value default-value
 126                                 hidden)
 127   "Make a new internal (Clon-specific) enum option.
 128 - LONG-NAME is the option's long-name, sans the 'clon-' prefix.
 129   (Internal options don't have short names.)
 130 - DESCRIPTION is the options's description.
 131 - ARGUMENT-NAME is the option's argument name appearing in help strings.
 132 - ARGUMENT-TYPE is one of :required, :mandatory or :optional (:required and
 133   :mandatory are synonyms).
 134   It defaults to :optional.
 135 - ENUM is the set of possible values.
 136 - ENV-VAR is the option's associated environment variable, sans the 'CLON_'
 137   prefix. It defaults to nil.
 138 - FALLBACK-VALUE is the option's fallback value (for missing optional
 139   arguments), if any.
 140 - DEFAULT-VALUE is the option's default value, if any.
 141 - When HIDDEN, the option doesn't appear in help strings."
 142   (declare (ignore argument-name argument-type
 143                    enum env-var fallback-value default-value
 144                    hidden))
 145   (apply #'make-instance 'enum
 146          :long-name long-name
 147          :description description
 148          :internal t
 149          keys))
 150
 151
 152 ;;; enum.lisp ends here