--- a/lisp/batchcolor.lisp Sat Dec 12 17:44:09 2020 -0500
+++ b/lisp/batchcolor.lisp Sat Dec 12 18:41:09 2020 -0500
@@ -97,52 +97,15 @@
;;;; User Interface -----------------------------------------------------------
-(defmacro defparameters (parameters values-form)
- `(progn
- ,@(loop :for parameter :in parameters
- :collect `(defparameter ,parameter nil))
- (setf (values ,@parameters) ,values-form)
- ',parameters))
-
-(defun make-boolean-options
- (name &key
- (name-no (intern (concatenate 'string (string 'no-) (string name))))
- long
- (long-no (when long (format nil "no-~A" long)))
- short
- (short-no (when short (char-upcase short)))
- (result-key name)
- help
- help-no
- manual
- manual-no
- initial-value)
- (values (adopt:make-option name
- :result-key result-key
- :long long
- :short short
- :help help
- :manual manual
- :initial-value initial-value
- :reduce (constantly t))
- (adopt:make-option name-no
- :result-key result-key
- :long long-no
- :short short-no
- :help help-no
- :manual manual-no
- :reduce (constantly nil))))
-
-
-(defparameters (*option-randomize* *option-no-randomize*)
- (make-boolean-options 'randomize
+(adopt:defparameters (*option-randomize* *option-no-randomize*)
+ (adopt:make-boolean-options 'randomize
:help "Randomize the choice of color each run."
:help-no "Do not randomize the choice of color each run (the default)."
:long "randomize"
:short #\r))
-(defparameters (*option-debug* *option-no-debug*)
- (make-boolean-options 'debug
+(adopt:defparameters (*option-debug* *option-no-debug*)
+ (adopt:make-boolean-options 'debug
:long "debug"
:short #\d
:help "Enable the Lisp debugger."
@@ -203,13 +166,14 @@
(error (c) (adopt:print-error-and-exit c)))))
(defmacro exit-on-error-unless (expr &body body)
- `(if ,expr
- (progn ,@body)
- (exit-on-error ,@body)))
+ (let ((thunk (gensym "THUNK")))
+ `(flet ((,thunk () ,@body))
+ (if ,expr
+ (,thunk)
+ (exit-on-error (,thunk))))))
(defmacro exit-on-ctrl-c (&body body)
- `(handler-case
- (with-user-abort:with-user-abort (progn ,@body))
+ `(handler-case (with-user-abort:with-user-abort (progn ,@body))
(with-user-abort:user-abort () (adopt:exit 130))))
--- a/lisp/genpass.lisp Sat Dec 12 17:44:09 2020 -0500
+++ b/lisp/genpass.lisp Sat Dec 12 18:41:09 2020 -0500
@@ -161,36 +161,20 @@
:short #\W
:reduce (constantly 0)))
-(defparameter *option-smart*
- (adopt:make-option 'smart
+(adopt:defparameters (*option-smart* *option-no-smart*)
+ (adopt:make-boolean-options 'smart
:help "Smart mode (the default). Generate as with --words, but add a number on the end to satisfy the red tape on many sites."
+ :help-no "Turn off smart mode."
:long "smart"
:short #\s
- :initial-value t
- :reduce (constantly t)))
-
-(defparameter *option-no-smart*
- (adopt:make-option 'no-smart
- :result-key 'smart
- :help "Turn off smart mode."
- :long "no-smart"
- :short #\S
- :reduce (constantly nil)))
+ :initial-value t))
-(defparameter *option-smush*
- (adopt:make-option 'smush
+(adopt:defparameters (*option-smush* *option-no-smush*)
+ (adopt:make-boolean-options 'smush
:help "Don't include spaces in passphrases."
+ :help-no "Include spaces in passphrases (the default)."
:long "smush"
- :short #\m
- :reduce (constantly t)))
-
-(defparameter *option-no-smush*
- (adopt:make-option 'no-smush :result-key 'smush
- :help "Include spaces in passphrases (the default)."
- :long "no-smush"
- :short #\M
- :reduce (constantly nil)))
-
+ :short #\m))
(defparameter *group-password-options*
(adopt:make-group 'password-options
--- a/lisp/lines.lisp Sat Dec 12 17:44:09 2020 -0500
+++ b/lisp/lines.lisp Sat Dec 12 18:41:09 2020 -0500
@@ -189,45 +189,8 @@
;;;; User Interface -----------------------------------------------------------
-(defmacro defparameters (parameters values-form)
- `(progn
- ,@(loop :for parameter :in parameters
- :collect `(defparameter ,parameter nil))
- (setf (values ,@parameters) ,values-form)
- ',parameters))
-
-(defun make-boolean-options
- (name &key
- (name-no (intern (concatenate 'string (string 'no-) (string name))))
- long
- (long-no (when long (format nil "no-~A" long)))
- short
- (short-no (when short (char-upcase short)))
- (result-key name)
- help
- help-no
- manual
- manual-no
- initial-value)
- (values (adopt:make-option name
- :result-key result-key
- :long long
- :short short
- :help help
- :manual manual
- :initial-value initial-value
- :reduce (constantly t))
- (adopt:make-option name-no
- :result-key result-key
- :long long-no
- :short short-no
- :help help-no
- :manual manual-no
- :reduce (constantly nil))))
-
-
-(defparameters (*option-debug* *option-no-debug*)
- (make-boolean-options 'debug
+(adopt:defparameters (*option-debug* *option-no-debug*)
+ (adopt:make-boolean-options 'debug
:long "debug"
:short #\d
:help "Enable the Lisp debugger."
@@ -274,8 +237,8 @@
:key #'parse-integer
:reduce #'adopt:last))
-(defparameters (*option-include-numbers* *option-no-include-numbers*)
- (make-boolean-options 'include-numbers
+(adopt:defparameters (*option-include-numbers* *option-no-include-numbers*)
+ (adopt:make-boolean-options 'include-numbers
:long "number"
:short #\n
:help "Add line numbers to the output."