aboutsummaryrefslogtreecommitdiff
path: root/app
diff options
context:
space:
mode:
authorColin Okay <okay@toyful.space>2022-03-15 15:45:20 -0500
committerColin Okay <okay@toyful.space>2022-03-15 15:45:20 -0500
commitfbce85871c6e995ece00e3136cf7dfdeeeff2bb7 (patch)
treef063c88af571091fabf3a2388c94d43c875fbfcd /app
parent130ae266f51f63ac423a65b17749a4d38dda1018 (diff)
bugfix: handle user interrupt in new and edit
Diffstat (limited to 'app')
-rw-r--r--app/app.lisp194
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)))
+
+