Bundle up all mutable command context into a single record, to let the

command handler have everything it needs even in the face of change

rmacs/TODO

@@ -4,9 +4,6 @@ Windows need their own top-of-window-mtype and point location
 
 Preserve column on up/down better. This includes dealing with tab expansion
 
-Bundle up all mutable command context into a single record, to let the
-command handler have everything it needs even in the face of change
-
 Need line wrap of some kind.
 
 Catch and handle SIGWINCH.

rmacs/api.rkt

@@ -0,0 +1,14 @@
+#lang racket/base
+;; API for writing modes/commands/etc.
+
+(require "mode.rkt")
+(require "editor.rkt")
+(require "buffer.rkt")
+(require "keys.rkt")
+(require "rope.rkt")
+
+(provide (all-from-out "mode.rkt"
+                       "editor.rkt"
+                       "buffer.rkt"
+                       "keys.rkt"
+                       "rope.rkt"))

rmacs/buffer.rkt

@@ -21,7 +21,6 @@
          buffer-modeset
          buffer-column
          buffer-apply-modeset!
-         invoke-command
          buffer-add-mode!
          buffer-remove-mode!
          buffer-toggle-mode!
@@ -42,7 +41,25 @@
          buffer-replace-contents!
          call-with-excursion
          buffer-search
-         buffer-findf)
+         buffer-findf
+
+         command?
+         command-selector
+         command-buffer
+         command-window
+         command-editor
+         (rename-out [make-command command])
+         invoke
+
+         define-key
+         define-command)
+
+(require racket/match)
+(require (for-syntax syntax/parse))
+(require (for-syntax racket/base))
+(require (only-in racket/string string-join))
+(require (only-in racket/path normalize-path))
+(require (only-in racket/file file->string))
 
 (require "rope.rkt")
 (require "search.rkt")
@@ -50,10 +67,6 @@
 (require "mode.rkt")
 (require "keys.rkt")
 
-(require (only-in racket/string string-join))
-(require (only-in racket/path normalize-path))
-(require (only-in racket/file file->string))
-
 (define main-mark-type (mark-type "main" 'right))
 
 (struct buffergroup ([members #:mutable] ;; (CircularList Buffer)
@@ -67,6 +80,14 @@
                 [modeset #:mutable] ;; ModeSet
                 ) #:prefab)
 
+(struct command (selector ;; Symbol
+                 buffer ;; Buffer
+                 window ;; (Option Window)
+                 editor ;; Editor
+                 keyseq ;; (Option Keyseq)
+                 prefix-arg ;; Any
+                 ) #:prefab)
+
 (define (make-buffergroup)
   (buffergroup circular-empty #f))
 
@@ -182,16 +203,6 @@
 (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)
@@ -332,3 +343,80 @@
   (define new-rope (apply f (buffer-rope buf) args))
   (set-buffer-rope! buf new-rope)
   buf)
+
+;;---------------------------------------------------------------------------
+
+(define (make-command selector buffer-or-command
+                      #:window [window #f]
+                      #:editor [editor #f]
+                      #:keyseq [keyseq #f]
+                      #:prefix-arg [prefix-arg '#:default])
+  (define buffer (cond
+                  [(buffer? buffer-or-command) buffer-or-command]
+                  [(command? buffer-or-command) (command-buffer buffer-or-command)]))
+  (command selector buffer window (or editor (buffer-editor buffer)) keyseq prefix-arg))
+
+(define (invoke cmd)
+  (match-define (command selector buf _ _ keyseq _) cmd)
+  (define handler (modeset-lookup-command (buffer-modeset buf) selector))
+  (when (not handler)
+    (error 'invoke "Unhandled command ~a (key sequence: ~a)"
+           selector
+           (if keyseq (keyseq->keyspec keyseq) "N/A")))
+  (handler cmd))
+
+(define-syntax-rule (define-key mode-exp keyspec-exp command-symbol)
+  (void (mode-keymap-bind! mode-exp keyspec-exp 'command-symbol)))
+
+(define-syntax define-command
+  (lambda (stx)
+    (syntax-parse stx
+      [(_ mode-exp
+          (selector buffer
+                    (~or (~optional (~seq #:next-method next-method)
+                                    #:defaults ([next-method #'nm])
+                                    #:name "#:next-method")
+                         (~optional (~seq #:command cmd)
+                                    #:defaults ([cmd #'cmd])
+                                    #:name "#:command")
+                         (~optional (~seq #:selector self-selector)
+                                    #:defaults ([self-selector #'self])
+                                    #:name "#:selector")
+                         (~optional (~seq #:window window)
+                                    #:defaults ([window #'win])
+                                    #:name "#:window")
+                         (~optional (~seq #:editor editor)
+                                    #:defaults ([editor #'ed])
+                                    #:name "#:editor")
+                         (~optional (~seq #:keyseq keyseq)
+                                    #:defaults ([keyseq #'keyseq])
+                                    #:name "#:keyseq")
+                         (~optional (~seq #:prefix-arg
+                                          (~or (~seq [prefix-arg prefix-default prefix-prefix])
+                                               (~seq [prefix-arg prefix-default])
+                                               prefix-arg))
+                                    #:defaults ([prefix-arg #'pa]
+                                                [prefix-default #''#:default]
+                                                [prefix-prefix #''#:prefix])
+                                    #:name "#:prefix-arg"))
+                    ...)
+          (~seq #:bind-key bind-keyspec-exps) ...
+          body ...)
+       #`(let ((mode mode-exp))
+           (mode-define-command! mode
+                                 'selector
+                                 (lambda (cmd next-method)
+                                   (match-define (command self-selector
+                                                          buffer
+                                                          window
+                                                          editor
+                                                          keyseq
+                                                          prefix-arg) cmd)
+                                   (let ((prefix-arg (match prefix-arg
+                                                       ['#:default prefix-default]
+                                                       ['#:prefix prefix-prefix]
+                                                       [_ prefix-arg])))
+                                     body ...)))
+           #,@(for/list ((bind-keyspec-exp (syntax->list #'(bind-keyspec-exps ...))))
+                #`(mode-keymap-bind! mode #,bind-keyspec-exp 'selector))
+           (void))])))

rmacs/editor.rkt

@@ -4,6 +4,7 @@
          make-editor
          visit-file!
          render-editor!
+         editor-command
          editor-active-buffer
          editor-active-modeset
          editor-mainloop
@@ -80,6 +81,11 @@
   (define b (editor-active-buffer editor))
   (and b (buffer-modeset b)))
 
+(define (editor-command selector editor
+                        #:keyseq [keyseq #f]
+                        #:prefix-arg [prefix-arg '#:default])
+  (window-command selector (editor-active-window editor) #:keyseq keyseq #:prefix-arg prefix-arg))
+
 (define (root-keyseq-handler editor)
   (modeset-keyseq-handler (editor-active-modeset editor)))
 
@@ -126,8 +132,7 @@
        [else
         (match (handler editor input)
           [(unbound-key-sequence)
-           (if (invoke-command 'unbound-key-sequence (editor-active-buffer editor)
+           (if (invoke (editor-command 'unbound-key-sequence editor #:keyseq total-keyseq))
-                               #:keyseq total-keyseq)
                (loop '() '() (root-keyseq-handler editor) (request-repaint))
                (error 'editor-mainloop "Unbound key sequence: ~a"
                       (keyseq->keyspec total-keyseq)))]
@@ -139,9 +144,7 @@
                (if (equal? keyseq remaining-input)
                    '()
                    (cons (car keyseq) (remove-tail (cdr keyseq))))))
-           (invoke-command selector (editor-active-buffer editor)
+           (invoke (editor-command selector editor #:keyseq accepted-input #:prefix-arg prefix-arg))
-                           #:keyseq accepted-input
-                           #:prefix-arg prefix-arg)
            (loop '() remaining-input (root-keyseq-handler editor) (request-repaint))])]))))
 
 (define (editor-request-shutdown! editor)

rmacs/keys.rkt

@@ -10,7 +10,12 @@
          keymap-update
          keymap-bind
          keymap-unbind
-         keymap-lookup)
+         keymap-lookup
+
+         ;; From ansi/lcd-terminal
+         (struct-out key)
+         (struct-out unknown-escape-sequence)
+         add-modifier)
 
 (require racket/set)
 (require racket/match)
@@ -113,7 +118,7 @@
      (format-modifiers updated-modifiers str)]))
 
 (define (keyseq->keyspec keyseq)
-  (string-join (map key->keyspec keyseq) " "))
+  (and keyseq (string-join (map key->keyspec keyseq) " ")))
 
 ;;---------------------------------------------------------------------------
 ;; Keymaps

rmacs/main.rkt

@@ -1,5 +1,7 @@
 #lang racket/base
 
+(provide rmacs)
+
 (require racket/match)
 
 (require "editor.rkt")
@@ -7,17 +9,19 @@
 (require "mode.rkt")
 (require "mode/fundamental.rkt")
 
-(define (main)
+(define (rmacs #:initial-files [initial-files '()])
   (define e (make-editor #:default-modeset (modeset-add-mode kernel-modeset
                                                              fundamental-mode)))
-  (visit-file! e (build-path (collection-file-path "main.rkt" "rmacs")
+  (for ((file initial-files)) (visit-file! e file))
-                             'up 'up "doc" "xterm_controls.txt"))
   (editor-mainloop e))
 
 (module+ main
   (require racket/trace)
   (current-trace-notify (lambda (s) (log-info "TRACE: ~a" s)))
-  (void (main))
+  (void
+   (rmacs #:initial-files (list
+                           (build-path (collection-file-path "main.rkt" "rmacs")
+                                       'up 'up "doc" "xterm_controls.txt"))))
   ;; (require profile)
   ;; (require ansi)
   ;; (void (profile-thunk (lambda () (begin0 (main)

rmacs/mode.rkt

@@ -25,16 +25,11 @@
          modeset-lookup-command
 
          kernel-mode
-         kernel-modeset
+         kernel-modeset)
-
-         define-key
-         define-command)
 
 (require racket/set)
 (require racket/match)
 (require (only-in racket/list filter-map))
-(require (for-syntax syntax/parse))
-(require (for-syntax racket/base))
 
 (require "keys.rkt")
 (require "topsort.rkt")
@@ -195,14 +190,11 @@
       [(cons table rest)
        (define handler (hash-ref table selector #f))
        (if handler
-           (lambda (e prefix-arg ks)
+           (lambda (cmd)
-             (handler e
+             (handler cmd
-                      (lambda ([prefix-arg prefix-arg] [ks ks])
+                      (lambda ([cmd cmd])
                         (define next-method (search rest))
-                        (when next-method (next-method e prefix-arg ks)))
+                        (when next-method (next-method cmd)))))
-                      selector
-                      prefix-arg
-                      ks))
            (search rest))])))
 
 (define kernel-mode
@@ -212,45 +204,3 @@
 
 (define kernel-modeset
   (modeset-add-mode (make-modeset) kernel-mode))
-
-;;---------------------------------------------------------------------------
-
-(define-syntax-rule (define-key mode-exp keyspec-exp command-symbol)
-  (mode-keymap-bind! mode-exp keyspec-exp 'command-symbol))
-
-(define-syntax define-command
-  (lambda (stx)
-    (syntax-parse stx
-      [(_ mode-exp
-          (selector buffer
-                    (~or (~optional (~seq #:next-method next-method)
-                                    #:defaults ([next-method #'nm])
-                                    #:name "#:next-method")
-                         (~optional (~seq #:prefix-arg
-                                          (~or (~seq [prefix-arg prefix-default prefix-prefix])
-                                               (~seq [prefix-arg prefix-default])
-                                               prefix-arg))
-                                    #:defaults ([prefix-arg #'pa]
-                                                [prefix-default #''#:default]
-                                                [prefix-prefix #''#:prefix])
-                                    #:name "#:prefix-arg")
-                         (~optional (~seq #:selector self-selector)
-                                    #:defaults ([self-selector #'self])
-                                    #:name "#:self-selector")
-                         (~optional (~seq #:keyseq keyseq)
-                                    #:defaults ([keyseq #'keyseq])
-                                    #:name "#:keyseq"))
-                    ...)
-          (~seq #:bind-key bind-keyspec-exps) ...
-          body ...)
-       #`(let ((mode mode-exp))
-           (mode-define-command! mode 'selector
-                                 (lambda (buffer next-method self-selector prefix-arg keyseq)
-                                   (let ((prefix-arg (match prefix-arg
-                                                       ['#:default prefix-default]
-                                                       ['#:prefix prefix-prefix]
-                                                       [_ prefix-arg])))
-                                     body ...)))
-           #,@(for/list ((bind-keyspec-exp (syntax->list #'(bind-keyspec-exps ...))))
-                #`(mode-keymap-bind! mode #,bind-keyspec-exp 'selector))
-           (void))])))

rmacs/mode/fundamental.rkt

@@ -4,12 +4,7 @@
 
 (require racket/set)
 (require racket/match)
-(require ansi/lcd-terminal)
+(require "../api.rkt")
-(require "../mode.rkt")
-(require "../editor.rkt")
-(require "../buffer.rkt")
-(require "../keys.rkt")
-(require "../rope.rkt")
 
 (define fundamental-mode (make-mode "fundamental"))
 
@@ -20,7 +15,7 @@
     [_ #f]))
 
 (define-command fundamental-mode (unbound-key-sequence buf #:keyseq keyseq)
-  (invoke-command 'self-insert-command buf #:keyseq keyseq))
+  (invoke (command 'self-insert-command buf #:keyseq keyseq)))
 
 (define-key fundamental-mode (list "C-q" '#:default) self-insert-command)
 

rmacs/window.rkt

@@ -5,6 +5,7 @@
          (struct-out relative-size)
          make-window
          window-split
+         window-command
          )
 
 (require racket/match)
@@ -38,3 +39,8 @@
               (define new-size (if proportional? (cadr e) (scale-size (cadr e))))
               (list (list w new-size)
                     (list (make-window (window-buffer w)) new-size)))))
+
+(define (window-command selector window
+                        #:keyseq [keyseq #f]
+                        #:prefix-arg [prefix-arg '#:default])
+  (command selector (window-buffer window) #:window window #:keyseq keyseq #:prefix-arg prefix-arg))