ryuslash/clark
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Allow CLark to be used from the lisp REPL

Browse source
This commit is contained in:
Tom Willemse 2013-10-06 13:34:24 +02:00
parent b4769c70c4
commit b7d4fe7c21
1 changed files with 11 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

17
lisp/clark.lisp
View file

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