Exit with status 1 on error

Add macros `with-error-status' and `with-error-and-help' that help to
easily report errors to the user. The latter also calls the `help'
command.

All commands, when done, exit with `*exit-status*' being the status
code used. The `with-error-status' macro let-binds this variable so
that the command function exits with the given status code.

1 files changed, 30 insertions, 11 deletions

diff --git a/lisp/clark.lisp b/lisp/clark.lisp
index 64f5fa4..165a9d8 100644
--- a/lisp/clark.lisp
+++ b/lisp/clark.lisp
@@ -35,24 +35,41 @@
 (defvar *script* nil
   "Whether or not to output in a machine-readable format.")
 
+(defvar *exit-status* 0
+  "The exit status to use on quit.")
+
 (defmacro call-command (name &rest args)
   (let ((command-name (make-command-name (symbol-name name))))
     `(,command-name ,@args)))
 
-(defmacro defcommand (name (&rest args) sdoc ldoc
-                      &body body)
+(defmacro defcommand (name (&rest args) sdoc ldoc &body body)
   "Define a new command usable on the command-line."
   (let* ((sname (string-downcase (symbol-name name)))
          (command-name (make-command-name (symbol-name name))))
     `(progn
        (defun ,command-name (,@args)
          ,sdoc
-         ,@body)
+         ,@body
+         (sb-ext:exit :code *exit-status*))
        (setf *help-messages*
              (nconc *help-messages* '((,sname ,sdoc ,ldoc)))
              *max-command-name-length*
              (max *max-command-name-length* (length ,sname))))))
 
+(defmacro with-error-and-help (code cmd fmt &rest args)
+  "Call `with-error-status' with CODE, format FMT with ARGS and call
+the help command."
+  `(with-error-status ,code
+     (format t ,fmt ,@args)
+     (call-command help ,cmd)))
+
+(defmacro with-error-status (code &body body)
+  "Bind `*exit-status*' to CODE, `*standard-output*' to
+`*error-output*' and execute BODY."
+  `(let ((*standard-output* *error-output*)
+         (*exit-status* ,code))
+     ,@body))
+
 (defconstant *version* "0.1.0"
   "Clark's version.")
 
@@ -191,7 +208,9 @@ The executable name should already have been removed."
   (loop while (and args (char= (char (car args) 0) #\-))
      do (case (intern (string-upcase (string-left-trim "-" (car args)))
                       :org.ryuslash.clark)
-          (script (setf *script* t args (cdr args)))))
+          (script (setf *script* t args (cdr args)))
+          (t (with-error-and-help
+                 1 "help" "Unknown option: ~a~%" (car args)))))
   (if args
       (let ((cmd-name (make-command-name (car args))))
         (if (fboundp cmd-name)
@@ -199,13 +218,11 @@ The executable name should already have been removed."
               (sb-int:simple-program-error (err)
                 (if (string-equal (format nil "~A" err)
                                   "invalid number of arguments" :end1 27)
-                    (let ((*standard-output* *error-output*))
-                      (format t "Wrong number of arguments given.~%")
-                      (call-command help (car args)))
+                    (with-error-and-help
+                        1 (car args) "Wrong number of arguments given.~%")
                     (signal err))))
-            (let ((*standard-output* *error-output*))
-              (format t "Unknown command: ~A~%" (car args))
-              (call-command help "help"))))
+            (with-error-and-help
+                1 "help" "Unknown command: ~A~%" (car args))))
       (map nil #'print-bookmark (get-bookmarks))))
 
 (defun print-bookmark (bm)
@@ -271,7 +288,9 @@ otherwise."
                           command *help-messages*
                           :test #'(lambda (x y) (equal x (car y))))))))
         (cond
-          ((null ldoc) (format t "Unkown command: ~A~%" command))
+          ((null ldoc)
+           (with-error-and-help
+               1 "help" "Unknown command: ~a~%" command))
           ((and (symbolp ldoc) (fboundp ldoc)) (funcall ldoc))
           (t (format t "~A~%" ldoc))))
       (call-command help "help")))