diff --git a/lisp/clark.lisp b/lisp/clark.lisp index f5b21f6..2156a3b 100644 --- a/lisp/clark.lisp +++ b/lisp/clark.lisp @@ -35,8 +35,8 @@ (defvar *script* nil "Whether or not to output in a machine-readable format.") -(defvar *exit-status* 0 - "The exit status to use on quit.") +(define-condition exiting () + ((exit-code :initform 0 :initarg :code :reader exit-code))) (defmacro call-command (name &rest args) (let ((command-name (make-command-name (symbol-name name)))) @@ -49,8 +49,7 @@ `(progn (defun ,command-name (,@args) ,sdoc - ,@body - (sb-ext:exit :code *exit-status*)) + ,@body) (setf *help-messages* (nconc *help-messages* '((,sname ,sdoc ,ldoc))) *max-command-name-length* @@ -67,8 +66,10 @@ the help command." "Bind `*exit-status*' to CODE, `*standard-output*' to `*error-output*' and execute BODY." `(let ((*standard-output* *error-output*) - (*exit-status* ,code)) - ,@body)) + (exit-status ,code)) + ,@body + (when (> exit-status 0) + (signal 'exiting :code exit-status)))) (defparameter version "0.1.1" "Clark's version.") @@ -197,5 +198,7 @@ Connect to the database, parse command-line arguments, execute and then disconnect." (load-rc) (load-db) - (parse-args (cdr args)) - (disconnect *db*)) + (handler-case + (unwind-protect (parse-args (cdr args)) + (disconnect *db*)) + (exiting (c) (sb-ext:exit :code (exit-code c)))))