4139b0e71e08

More
[view raw] [browse files]
author Steve Losh <steve@stevelosh.com>
date Sat, 12 Dec 2020 18:41:09 -0500
parents c5f79f4ca83c
children 3024550ba049
branches/tags (none)
files lisp/batchcolor.lisp lisp/genpass.lisp lisp/lines.lisp

Changes

--- 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."