diff options
Diffstat (limited to 'app/app.lisp')
| -rw-r--r-- | app/app.lisp | 173 |
1 files changed, 81 insertions, 92 deletions
diff --git a/app/app.lisp b/app/app.lisp index fea4aa3..28f5465 100644 --- a/app/app.lisp +++ b/app/app.lisp @@ -16,7 +16,6 @@ ;; along with this program. If not, see <http://www.gnu.org/licenses/>. - (in-package :oneliners.cli.app) ;;; VERSION @@ -196,95 +195,85 @@ than the users." (defun main () "Entry point for our standalone application." (make-context) - (handler-case - (let ((arguments (remainder))) - (cond - ((getopt :long-name "version") - (format t "Oneliner CLI Version: ~a~%" +ol-version+)) - ((getopt :long-name "help") - (if (and arguments (find-group-with-header (first arguments))) - (help :item (find-group-with-header (first arguments))) - (help)) - (uiop:quit)) - ((getopt :long-name "whois") - (assert (first arguments) () "--whois requires an argument, a user handle.") - (cli::show-contributor (first arguments))) - - ((getopt :long-name "redeem") - (assert (= 3 (length arguments)) () "--redeem requires exatly three arguments.") - (destructuring-bind (token name pass) arguments - (cli::redeem-invite token name pass))) - - ((getopt :long-name "login") - (assert (= 2 (length arguments)) () "--login requires exactly two arguments.") - (destructuring-bind (user pass) arguments - (cli::login user pass))) - - ((getopt :long-name "change-password") - (assert (= 3 (length arguments)) () "--change-password requires exactly three arguments." ) - (destructuring-bind (current new repeated) arguments - (cli::change-pw current new repeated))) - - ((getopt :long-name "change-signature") - (cli::change-signature)) - - ((getopt :long-name "invite") - (cli::request-invite-code)) - - ((getopt :long-name "logout") - (cli::revoke-access)) - - ((getopt :long-name "add") - (cli::add-new-oneliner)) - - ((and (null arguments) (getopt :long-name "all-flagged")) - (cli::all-flagged-oneliners (getopt :long-name "limit"))) - - ((and (null arguments) (getopt :long-name "newest")) - (cli::newest-oneliners (getopt :long-name "limit"))) - - ((getopt :long-name "clear-cache") - (cli::wipe-cache)) - - (arguments - (destructuring-bind (id-or-name . args) (prepare-oneliner-arguments arguments) - (cond - ((getopt :long-name "flag") - (cli::flag-item id-or-name )) - ((getopt :long-name "unflag") - (cli::unflag-item id-or-name)) - ((getopt :long-name "lock") - (cli::lock-item id-or-name )) - ((getopt :long-name "unlock") - (cli::unlock-item id-or-name )) - ((getopt :long-name "edit") - (cli::edit-item id-or-name )) - ((getopt :long-name "show") - (cli::print-item-explanation id-or-name)) - ((getopt :long-name "clip") - (cli::run-item id-or-name args - :force-clip t - :timeout (getopt :long-name "timeout"))) - ((getopt :long-name "run") - (cli::run-item id-or-name args - :timeout (getopt :long-name "timeout"))) - - (t ; arguments but no overriding flags, search wiki - (cli::search-for-oneliners arguments - (getopt :long-name "limit") - (getopt :long-name "not-flagged") - (getopt :long-name "all-flagged") - (getopt :long-name "newest"))))) - (uiop:quit)) - - (t ; no arguments and no options, print help - (help))) - (uiop:quit)) - (error (e) - (format *error-output* "~%ERROR: ~a~%" e) - (uiop:quit)) - (#+sbcl sb-sys:interactive-interrupt - #+ccl ccl:interrupt-signal-condition - () - (format t "Aborted by User Interrupt.~%") + (cli:with-local-state + (let ((arguments (remainder))) + (cond + ((getopt :long-name "version") + (format t "Oneliner CLI Version: ~a~%" +ol-version+)) + ((getopt :long-name "help") + (if (and arguments (find-group-with-header (first arguments))) + (help :item (find-group-with-header (first arguments))) + (help)) + (uiop:quit)) + ((getopt :long-name "whois") + (assert (first arguments) () "--whois requires an argument, a user handle.") + (cli::show-contributor (first arguments))) + + ((getopt :long-name "redeem") + (assert (= 3 (length arguments)) () "--redeem requires exatly three arguments.") + (destructuring-bind (token name pass) arguments + (cli::redeem-invite token name pass))) + + ((getopt :long-name "login") + (assert (= 2 (length arguments)) () "--login requires exactly two arguments.") + (destructuring-bind (user pass) arguments + (cli::login user pass))) + + ((getopt :long-name "change-password") + (assert (= 3 (length arguments)) () "--change-password requires exactly three arguments." ) + (destructuring-bind (current new repeated) arguments + (cli::change-pw current new repeated))) + + ((getopt :long-name "change-signature") + (cli::change-signature)) + + ((getopt :long-name "invite") + (cli::request-invite-code)) + + ((getopt :long-name "logout") + (cli::revoke-access)) + + ((getopt :long-name "add") + (cli::add-new-oneliner)) + + ((and (null arguments) (getopt :long-name "all-flagged")) + (cli::all-flagged-oneliners (getopt :long-name "limit"))) + + ((and (null arguments) (getopt :long-name "newest")) + (cli::newest-oneliners (getopt :long-name "limit"))) + + ((getopt :long-name "clear-cache") + (cli::wipe-cache)) + + (arguments + (destructuring-bind (id-or-name . args) (prepare-oneliner-arguments arguments) + (cond + ((getopt :long-name "flag") + (cli::flag-item id-or-name )) + ((getopt :long-name "unflag") + (cli::unflag-item id-or-name)) + ((getopt :long-name "lock") + (cli::lock-item id-or-name )) + ((getopt :long-name "unlock") + (cli::unlock-item id-or-name )) + ((getopt :long-name "edit") + (cli::edit-item id-or-name )) + ((getopt :long-name "show") + (cli::print-item-explanation id-or-name)) + ((getopt :long-name "clip") + (cli::run-item id-or-name args + :force-clip t + :timeout (getopt :long-name "timeout"))) + ((getopt :long-name "run") + (cli::run-item id-or-name args + :timeout (getopt :long-name "timeout"))) + + (t ; arguments but no overriding flags, search wiki + (cli::search-for-oneliners arguments + (getopt :long-name "limit") + (getopt :long-name "not-flagged") + (getopt :long-name "all-flagged") + (getopt :long-name "newest")))))) + (t ; no arguments and no options, print help + (help))) (uiop:quit)))) |