# HG changeset patch # User Steve Losh # Date 1607816469 18000 # Node ID 4139b0e71e08050fec67c0b31dde0621538bf650 # Parent c5f79f4ca83c43aa5aaaee90bb9e57fc4c1766e6 More diff -r c5f79f4ca83c -r 4139b0e71e08 lisp/batchcolor.lisp --- 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)))) diff -r c5f79f4ca83c -r 4139b0e71e08 lisp/genpass.lisp --- 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 diff -r c5f79f4ca83c -r 4139b0e71e08 lisp/lines.lisp --- 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."