bugfix: handle user interrupt in new and edit

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)))
 
+
+