diff --git a/rmacs/buffer.rkt b/rmacs/buffer.rkt index c4ec118..06700e8 100644 --- a/rmacs/buffer.rkt +++ b/rmacs/buffer.rkt @@ -55,13 +55,9 @@ buffer-local define-buffer-local - command? - command-selector - command-buffer - command-window - command-editor + (except-out (struct-out command) command) + copy-command (rename-out [make-command command]) - replace-selector invoke define-key @@ -410,8 +406,20 @@ [(command? buffer-or-command) (command-buffer buffer-or-command)])) (command selector buffer window (or editor (buffer-editor buffer)) keyseq prefix-arg)) -(define (replace-selector cmd selector) - (struct-copy command cmd [selector selector])) +(define (copy-command cmd + #:selector [selector (command-selector cmd)] + #:buffer [buffer (command-buffer cmd)] + #:window [window (command-window cmd)] + #:editor [editor (command-editor cmd)] + #:keyseq [keyseq (command-keyseq cmd)] + #:prefix-arg [prefix-arg (command-prefix-arg cmd)]) + (struct-copy command cmd + [selector selector] + [buffer buffer] + [window window] + [editor editor] + [keyseq keyseq] + [prefix-arg prefix-arg])) (define (invoke cmd) (match-define (command selector buf _ _ keyseq _) cmd) diff --git a/rmacs/mode/fundamental.rkt b/rmacs/mode/fundamental.rkt index 0c9346c..21014fe 100644 --- a/rmacs/mode/fundamental.rkt +++ b/rmacs/mode/fundamental.rkt @@ -12,12 +12,19 @@ (match keyseq [(list (key (? char? ch) modifiers)) #:when (set-empty? (set-remove modifiers 'shift)) (buffer-insert! buf (window-point win) (string->rope (string ch)))] + [(list (key (? char? ch0) modifiers)) #:when (equal? modifiers (set 'control)) + (define ch (integer->char (- (char->integer (char-upcase ch0)) (char->integer #\A) -1))) + (buffer-insert! buf (window-point win) (string->rope (string ch)))] [_ #f])) (define-command fundamental-mode (unbound-key-sequence buf #:command cmd #:keyseq keyseq) - (invoke (replace-selector cmd 'self-insert-command))) + (invoke (copy-command cmd #:selector 'self-insert-command))) -(define-key fundamental-mode (list "C-q" '#:default) self-insert-command) +(define-command fundamental-mode (quoted-insert buf #:command cmd #:keyseq keyseq) + #:bind-key "C-q #:default" + (invoke (copy-command cmd + #:selector 'self-insert-command + #:keyseq (list (cadr keyseq))))) (define-command fundamental-mode (newline buf #:window win) #:bind-key "C-m"