abort and keyboard-quit

rmacs/editor.rkt

@@ -25,7 +25,9 @@
          editor-request-shutdown!
          editor-force-redisplay!
          clear-message
-         message)
+         message
+         (struct-out exn:abort)
+         abort)
 
 (require racket/match)
 
@@ -39,6 +41,8 @@
 (require "circular-list.rkt")
 (require "file.rkt")
 
+(struct exn:abort exn (detail) #:transparent)
+
 (struct editor (buffers ;; BufferGroup
                 [tty #:mutable] ;; Tty
                 [windows #:mutable] ;; (CircularList (List Window SizeSpec)), abstract window layout
@@ -204,9 +208,12 @@
 (define (invoke/history cmd)
   (define editor (command-editor cmd))
   (clear-message editor)
-  (define result (invoke cmd))
+  (with-handlers* ([exn:abort? (lambda (e)
-  (set-editor-last-command! editor cmd)
+                                 (message editor "~a" (exn-message e))
-  result)
+                                 (void))])
+    (define result (invoke cmd))
+    (set-editor-last-command! editor cmd)
+    result))
 
 (define (editor-last-command? editor . possible-selectors)
   (and (editor-last-command editor)
@@ -303,6 +310,11 @@
   (invalidate-layout! editor)
   (render-editor! editor))
 
+(define (abort #:detail [detail #f] fmt . args)
+  (raise (exn:abort (apply format fmt args)
+                    (current-continuation-marks)
+                    detail)))
+
 ;;---------------------------------------------------------------------------
 
 (define-command kernel-mode (save-buffers-kill-terminal buf #:editor ed)
@@ -313,6 +325,10 @@
   #:bind-key "C-l"
   (editor-force-redisplay! ed))
 
+(define-command kernel-mode (keyboard-quit buf)
+  #:bind-key "C-g"
+  (abort "Quit"))
+
 (define-command kernel-mode (dump-buffer-to-stderr buf #:window win)
   #:bind-key "C-M-x"
   (local-require racket/pretty)