Invert editor-->buffer so it's buffer-->editor instead, and make

commands take a buffer instead of an editor.

rmacs/TODO

@@ -3,6 +3,3 @@ Make it reloadable
 Incremental display repair
 
 Windows need their own top-of-window-mtype and point location
-
-Invert editor-->buffer so it's buffer-->editor instead, and make
-commands take a buffer instead of an editor.

rmacs/buffer.rkt

@@ -1,6 +1,7 @@
 #lang racket/base
 
 (provide make-buffergroup
+         initialize-buffergroup!
          main-mark-type
          buffer?
          make-buffer
@@ -15,9 +16,11 @@
          buffer-pos
          buffer-title
          buffer-group
+         buffer-editor
          buffer-modeset
          buffer-column
          buffer-apply-modeset!
+         invoke-command
          buffer-add-mode!
          buffer-remove-mode!
          buffer-toggle-mode!
@@ -44,6 +47,7 @@
 (require "search.rkt")
 (require "circular-list.rkt")
 (require "mode.rkt")
+(require "keys.rkt")
 
 (require (only-in racket/string string-join))
 (require (only-in racket/path normalize-path))
@@ -52,6 +56,7 @@
 (define main-mark-type (mark-type "main" 'right))
 
 (struct buffergroup ([members #:mutable] ;; (CircularList Buffer)
+                     [editor #:mutable] ;; (Option Editor), for bidirectional editor/group linkage
                      ) #:prefab)
 
 (struct buffer ([rope #:mutable]
@@ -62,7 +67,13 @@
                 ) #:prefab)
 
 (define (make-buffergroup)
-  (buffergroup circular-empty))
+  (buffergroup circular-empty #f))
+
+(define (initialize-buffergroup! g editor)
+  (when (buffergroup-editor g)
+    (error 'initialize-buffergroup! "Duplicate initialization of buffergroup"))
+  (set-buffergroup-editor! g editor)
+  g)
 
 (define (initial-contents-rope initial-contents)
   (cond
@@ -160,12 +171,26 @@
 
 (define (buffer-size buf) (rope-size (buffer-rope buf)))
 
+(define (buffer-editor b)
+  (define g (buffer-group b))
+  (and g (buffergroup-editor g)))
+
 (define (buffer-column buf)
   (- (buffer-pos buf) (buffer-start-of-line buf)))
 
 (define (buffer-apply-modeset! buf modeset)
   (set-buffer-modeset! buf modeset))
 
+(define (invoke-command selector buf
+                        #:keyseq [keyseq #f]
+                        #:prefix-arg [prefix-arg '#:default])
+  (define cmd (modeset-lookup-command (buffer-modeset buf) selector))
+  (when (not cmd)
+    (error 'invoke-command "Unhandled command ~a (key sequence: ~a)"
+           selector
+           (if keyseq (keyseq->keyspec keyseq) "N/A")))
+  (cmd buf prefix-arg keyseq))
+
 (define (buffer-add-mode! buf mode)
   (set-buffer-modeset! buf (modeset-add-mode (buffer-modeset buf) mode)))
 (define (buffer-remove-mode! buf mode)

rmacs/editor.rkt

@@ -6,7 +6,6 @@
          render-editor!
          editor-active-buffer
          editor-active-modeset
-         editor-invoke-command
          editor-mainloop
          editor-request-shutdown!
          )
@@ -40,6 +39,7 @@
                     w
                     #f
                     default-modeset))
+  (initialize-buffergroup! g e)
   (configure-fresh-buffer! e scratch)
   e)
 
@@ -82,16 +82,6 @@
 (define (root-keyseq-handler editor)
   (modeset-keyseq-handler (editor-active-modeset editor)))
 
-(define (editor-invoke-command selector editor
-                               #:keyseq [keyseq #f]
-                               #:prefix-arg [prefix-arg '#:default])
-  (define cmd (modeset-lookup-command (editor-active-modeset editor) selector))
-  (when (not cmd)
-    (error 'editor-invoke-command "Unhandled command ~a (key sequence: ~a)"
-           selector
-           (keyseq->keyspec keyseq)))
-  (cmd editor prefix-arg keyseq))
-
 (define (open-debugger editor exc)
   (local-require (only-in web-server/private/util exn->string))
   (define error-report (exn->string exc))
@@ -121,7 +111,8 @@
           (wait-for-input handler)
           (match (handler editor input)
             [(unbound-key-sequence)
-             (if (editor-invoke-command 'unbound-key-sequence editor #:keyseq total-keyseq)
+             (if (invoke-command 'unbound-key-sequence (editor-active-buffer editor)
+                                 #:keyseq total-keyseq)
                  (loop '() '() (root-keyseq-handler editor))
                  (error 'editor-mainloop "Unbound key sequence: ~a"
                         (keyseq->keyspec total-keyseq)))]
@@ -133,7 +124,9 @@
                  (if (equal? keyseq remaining-input)
                      '()
                      (cons (car keyseq) (remove-tail (cdr keyseq))))))
-             (editor-invoke-command selector editor #:keyseq accepted-input #:prefix-arg prefix-arg)
+             (invoke-command selector (editor-active-buffer editor)
+                             #:keyseq accepted-input
+                             #:prefix-arg prefix-arg)
              (loop '() remaining-input (root-keyseq-handler editor))])))))
 
 (define (editor-request-shutdown! editor)
@@ -141,6 +134,6 @@
 
 ;;---------------------------------------------------------------------------
 
-(define-command kernel-mode (save-buffers-kill-terminal e)
+(define-command kernel-mode (save-buffers-kill-terminal buf)
   #:bind-key "C-x C-c"
-  (editor-request-shutdown! e))
+  (editor-request-shutdown! (buffer-editor buf)))

rmacs/mode.rkt

@@ -222,7 +222,7 @@
   (lambda (stx)
     (syntax-parse stx
       [(_ mode-exp
-          (selector editor
+          (selector buffer
                     (~or (~optional (~seq #:next-method next-method)
                                     #:defaults ([next-method #'nm])
                                     #:name "#:next-method")
@@ -245,7 +245,7 @@
           body ...)
        #`(let ((mode mode-exp))
            (mode-define-command! mode 'selector
-                                 (lambda (editor next-method self-selector prefix-arg keyseq)
+                                 (lambda (buffer next-method self-selector prefix-arg keyseq)
                                    (let ((prefix-arg (match prefix-arg
                                                        ['#:default prefix-default]
                                                        ['#:prefix prefix-prefix]

rmacs/mode/fundamental.rkt

@@ -13,21 +13,21 @@
 
 (define fundamental-mode (make-mode "fundamental"))
 
-(define-command fundamental-mode (self-insert-command e #:keyseq keyseq)
+(define-command fundamental-mode (self-insert-command buf #:keyseq keyseq)
   (match keyseq
     [(list (key (? char? ch) modifiers)) #:when (set-empty? (set-remove modifiers 'shift))
-     (buffer-insert! (editor-active-buffer e) (string->rope (string ch)))]
+     (buffer-insert! buf (string->rope (string ch)))]
     [_ #f]))
 
-(define-command fundamental-mode (unbound-key-sequence e #:keyseq keyseq)
+(define-command fundamental-mode (unbound-key-sequence buf #:keyseq keyseq)
-  (editor-invoke-command 'self-insert-command e #:keyseq keyseq))
+  (invoke-command 'self-insert-command buf #:keyseq keyseq))
 
 (define-key fundamental-mode (list "C-q" '#:default) self-insert-command)
 
-(define-command fundamental-mode (newline e)
+(define-command fundamental-mode (newline buf)
   #:bind-key "C-m"
   #:bind-key "C-j"
-  (buffer-insert! (editor-active-buffer e) (string->rope "\n")))
+  (buffer-insert! buf (string->rope "\n")))
 
 (define (move-forward-n-lines buf count)
   (for ((i count))
@@ -44,90 +44,80 @@
   (buffer-move-to-start-of-line! buf)
   (buffer-move-by! buf (min col (- eol-pos (buffer-pos buf)))))
 
-(define-command fundamental-mode (forward-char e #:prefix-arg [count 1])
+(define-command fundamental-mode (forward-char buf #:prefix-arg [count 1])
   #:bind-key "C-f"
   #:bind-key "<right>"
-  (buffer-move-by! (editor-active-buffer e) count))
+  (buffer-move-by! buf count))
 
-(define-command fundamental-mode (backward-char e #:prefix-arg [count 1])
+(define-command fundamental-mode (backward-char buf #:prefix-arg [count 1])
   #:bind-key "C-b"
   #:bind-key "<left>"
-  (buffer-move-by! (editor-active-buffer e) (- count)))
+  (buffer-move-by! buf (- count)))
 
-(define-command fundamental-mode (next-line e #:prefix-arg [count 1])
+(define-command fundamental-mode (next-line buf #:prefix-arg [count 1])
   #:bind-key "C-n"
   #:bind-key "<down>"
-  (define buf (editor-active-buffer e))
   (define col (buffer-column buf))
   (move-forward-n-lines buf count)
   (move-to-column buf col))
 
-(define-command fundamental-mode (prev-line e #:prefix-arg [count 1])
+(define-command fundamental-mode (prev-line buf #:prefix-arg [count 1])
   #:bind-key "C-p"
   #:bind-key "<up>"
-  (define buf (editor-active-buffer e))
   (define col (buffer-column buf))
   (move-backward-n-lines buf count)
   (move-to-column buf col))
 
-(define-command fundamental-mode (move-end-of-line e #:prefix-arg [count 1])
+(define-command fundamental-mode (move-end-of-line buf #:prefix-arg [count 1])
   #:bind-key "C-e"
   #:bind-key "<end>"
-  (define buf (editor-active-buffer e))
   (when (positive? count) (move-forward-n-lines buf (- count 1)))
   (buffer-move-to-end-of-line! buf))
 
-(define-command fundamental-mode (move-beginning-of-line e #:prefix-arg [count 1])
+(define-command fundamental-mode (move-beginning-of-line buf #:prefix-arg [count 1])
   #:bind-key "C-a"
   #:bind-key "<home>"
-  (define buf (editor-active-buffer e))
   (when (positive? count) (move-forward-n-lines buf (- count 1)))
   (buffer-move-to-start-of-line! buf))
 
-(define-command fundamental-mode (delete-backward-char e #:prefix-arg [count 1])
+(define-command fundamental-mode (delete-backward-char buf #:prefix-arg [count 1])
   #:bind-key "<backspace>"
   #:bind-key "C-h" ;; differs from GNU emacs
-  (define buf (editor-active-buffer e))
   (buffer-region-update! buf
                          (lambda (_deleted) (empty-rope))
                          #:mark (- (buffer-pos buf) count)))
 
-(define-command fundamental-mode (delete-forward-char e #:prefix-arg [count 1])
+(define-command fundamental-mode (delete-forward-char buf #:prefix-arg [count 1])
   #:bind-key "<delete>"
   #:bind-key "C-d"
-  (define buf (editor-active-buffer e))
   (buffer-region-update! buf
                          (lambda (_deleted) (empty-rope))
                          #:mark (+ (buffer-pos buf) count)))
 
-(define-command fundamental-mode (beginning-of-buffer e #:prefix-arg [tenths 0])
+(define-command fundamental-mode (beginning-of-buffer buf #:prefix-arg [tenths 0])
   #:bind-key "M-<"
   #:bind-key "C-<home>"
   #:bind-key "<begin>"
-  (define buf (editor-active-buffer e))
   (if (eq? tenths '#:prefix) (set! tenths 0) (buffer-mark! buf))
   (buffer-move-to! buf (* (buffer-size buf) (max 0 (min 10 tenths)) 1/10)))
 
-(define-command fundamental-mode (end-of-buffer e #:prefix-arg [tenths 0])
+(define-command fundamental-mode (end-of-buffer buf #:prefix-arg [tenths 0])
   #:bind-key "M->"
   #:bind-key "C-<end>"
-  (define buf (editor-active-buffer e))
   (if (eq? tenths '#:prefix) (set! tenths 0) (buffer-mark! buf))
   (buffer-move-to! buf (* (buffer-size buf) (- 10 (max 0 (min 10 tenths))) 1/10)))
 
-(define-command fundamental-mode (exchange-point-and-mark e)
+(define-command fundamental-mode (exchange-point-and-mark buf)
   #:bind-key "C-x C-x"
-  (define buf (editor-active-buffer e))
   (define m (buffer-mark-pos buf))
   (when m
     (define p (buffer-pos buf))
     (buffer-mark! buf p)
     (buffer-move-to! buf m)))
 
-(define-command fundamental-mode (set-mark-command e #:prefix-arg arg)
+(define-command fundamental-mode (set-mark-command buf #:prefix-arg arg)
   #:bind-key "C-@"
   #:bind-key "C-space"
-  (define buf (editor-active-buffer e))
   (if (eq? arg '#:prefix)
       (let ((m (buffer-mark-pos buf)))
         (and m (buffer-move-to! buf m)))