diff options
author | Colin Okay <okay@toyful.space> | 2022-03-15 15:45:20 -0500 |
---|---|---|
committer | Colin Okay <okay@toyful.space> | 2022-03-15 15:45:20 -0500 |
commit | fbce85871c6e995ece00e3136cf7dfdeeeff2bb7 (patch) | |
tree | f063c88af571091fabf3a2388c94d43c875fbfcd /app/app.lisp | |
parent | 130ae266f51f63ac423a65b17749a4d38dda1018 (diff) |
bugfix: handle user interrupt in new and edit
Diffstat (limited to 'app/app.lisp')
-rw-r--r-- | app/app.lisp | 194 |
1 files changed, 101 insertions, 93 deletions
diff --git a/app/app.lisp b/app/app.lisp index eef9b89..5139208 100644 --- a/app/app.lisp +++ b/app/app.lisp @@ -261,99 +261,105 @@ than the users." (help-topic ,topic) (uiop:quit)))) (make-context) - (a:if-let (arguments (remainder)) - (destructuring-bind (command . args) arguments - (let ((id-or-name - (when args - (or (parse-integer (first args) :junk-allowed t) - (first args))))) - (cli:with-local-state - (ecase (a:make-keyword (string-upcase command)) - (:help - (princ #\newline) - (help-topic (first args))) - (:search - (cond - ;; if there are args, use them as search terms - (args - (cli:search-for-oneliners - args - (getopt :long-name "limit") - (getopt :long-name "not-flagged") - (getopt :long-name "all-flagged") - (getopt :long-name "newest"))) - ;; no args, but a --newest flag, just return newest - ((getopt :long-name "newest") - (cli::newest-oneliners (getopt :long-name "limit"))) - ;; no args, but a --all-falgged - ((getopt :long-name "all-flagged") - (cli::all-flagged-oneliners (getopt :long-name "limit"))) - ;; otherwise, print help for search - (t - (help-topic "search") - (uiop:quit)))) - - (:run - (help-and-quit-unless "run" id-or-name) - (cli:run-item id-or-name (rest args) - :verbose (getopt :long-name "verbose") - :timeout (getopt :long-name "timeout") - :draftp (getopt :long-name "draft"))) - (:clip - (help-and-quit-unless "clip" id-or-name) - (cli:run-item id-or-name (rest args) - :force-clip t - :draftp (getopt :long-name "draft"))) - (:show - (help-and-quit-unless "show" id-or-name) - (cli:print-item-explanation id-or-name)) - (:new - (cli:add-new-oneliner)) - (:edit - (help-and-quit-unless "edit" id-or-name) - (cli:edit-item id-or-name (getopt :long-name "redraft"))) - (:delete - (help-and-quit-unless "delete" id-or-name) - (cli::delete-item id-or-name)) - (:publish - (help-and-quit-unless "publish" id-or-name) - (cli::publish-draft id-or-name)) - (:trash - (help-and-quit-unless "trash" id-or-name) - (cli::drop-draft id-or-name)) - (:drafts - (cli::print-drafts)) - (:flag - (help-and-quit-unless "flag" id-or-name) - (cli:flag-item id-or-name)) - (:unflag - (help-and-quit-unless "flag" id-or-name) - (cli:unflag-item id-or-name)) - (:lock - (help-and-quit-unless "lock" id-or-name) - (cli:lock-item id-or-name)) - (:unlock - (help-and-quit-unless "lock" id-or-name) - (cli:unlock-item id-or-name)) - (:redeem - (help-and-quit-unless "redeem" (= 3 (length args))) - (apply 'cli:redeem-invite args)) - (:invite - (cli:request-invite-code)) - (:login - (help-and-quit-unless "login" (= 3 (length args))) - (apply 'cli:login args)) - (:logout - (cli:revoke-access)) - (:password - (help-and-quit-unless "password" (= 3 (length args))) - (apply 'cli:change-pw args)) - (:signature - (cli:change-signature)) - (:whois - (help-and-quit-unless "whois" args) - (cli:show-contributor (first args))))))) - (help-topic "help"))) + (handler-case + (a:if-let (arguments (remainder)) + (destructuring-bind (command . args) arguments + (let ((id-or-name + (when args + (or (parse-integer (first args) :junk-allowed t) + (first args))))) + (cli:with-local-state + (ecase (a:make-keyword (string-upcase command)) + (:help + (princ #\newline) + (help-topic (first args))) + (:search + (cond + ;; if there are args, use them as search terms + (args + (cli:search-for-oneliners + args + (getopt :long-name "limit") + (getopt :long-name "not-flagged") + (getopt :long-name "all-flagged") + (getopt :long-name "newest"))) + ;; no args, but a --newest flag, just return newest + ((getopt :long-name "newest") + (cli::newest-oneliners (getopt :long-name "limit"))) + ;; no args, but a --all-falgged + ((getopt :long-name "all-flagged") + (cli::all-flagged-oneliners (getopt :long-name "limit"))) + ;; otherwise, print help for search + (t + (help-topic "search") + (uiop:quit)))) + + (:run + (help-and-quit-unless "run" id-or-name) + (cli:run-item id-or-name (rest args) + :verbose (getopt :long-name "verbose") + :timeout (getopt :long-name "timeout") + :draftp (getopt :long-name "draft"))) + (:clip + (help-and-quit-unless "clip" id-or-name) + (cli:run-item id-or-name (rest args) + :force-clip t + :draftp (getopt :long-name "draft"))) + (:show + (help-and-quit-unless "show" id-or-name) + (cli:print-item-explanation id-or-name)) + (:new + (cli:add-new-oneliner)) + (:edit + (help-and-quit-unless "edit" id-or-name) + (cli:edit-item id-or-name (getopt :long-name "redraft"))) + (:delete + (help-and-quit-unless "delete" id-or-name) + (cli::delete-item id-or-name)) + (:publish + (help-and-quit-unless "publish" id-or-name) + (cli::publish-draft id-or-name)) + (:trash + (help-and-quit-unless "trash" id-or-name) + (cli::drop-draft id-or-name)) + (:drafts + (cli::print-drafts)) + (:flag + (help-and-quit-unless "flag" id-or-name) + (cli:flag-item id-or-name)) + (:unflag + (help-and-quit-unless "flag" id-or-name) + (cli:unflag-item id-or-name)) + (:lock + (help-and-quit-unless "lock" id-or-name) + (cli:lock-item id-or-name)) + (:unlock + (help-and-quit-unless "lock" id-or-name) + (cli:unlock-item id-or-name)) + (:redeem + (help-and-quit-unless "redeem" (= 3 (length args))) + (apply 'cli:redeem-invite args)) + (:invite + (cli:request-invite-code)) + (:login + (help-and-quit-unless "login" (= 3 (length args))) + (apply 'cli:login args)) + (:logout + (cli:revoke-access)) + (:password + (help-and-quit-unless "password" (= 3 (length args))) + (apply 'cli:change-pw args)) + (:signature + (cli:change-signature)) + (:whois + (help-and-quit-unless "whois" args) + (cli:show-contributor (first args))))))) + (help-topic "help")) + (#+sbcl sb-sys:interactive-interrupt + #+ccl ccl:interrupt-signal-condition + () + (format t "Aborted by User Interrupt.~%") + (uiop:quit)))) (uiop:quit)) (defun help-topic (topic) @@ -361,3 +367,5 @@ than the users." (help :item group) (help))) + + |