From c6f15b6881dcae117740d207e740550fe6895ad0 Mon Sep 17 00:00:00 2001 From: Tony Garnock-Jones Date: Tue, 23 Dec 2014 11:49:17 -0500 Subject: [PATCH] Invert editor-->buffer so it's buffer-->editor instead, and make commands take a buffer instead of an editor. --- rmacs/TODO | 3 --- rmacs/buffer.rkt | 27 +++++++++++++++++++- rmacs/editor.rkt | 23 ++++++------------ rmacs/mode.rkt | 4 +-- rmacs/mode/fundamental.rkt | 50 +++++++++++++++----------------------- 5 files changed, 56 insertions(+), 51 deletions(-) diff --git a/rmacs/TODO b/rmacs/TODO index 53430d5..20d230e 100644 --- a/rmacs/TODO +++ b/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. diff --git a/rmacs/buffer.rkt b/rmacs/buffer.rkt index ab00a41..351cc31 100644 --- a/rmacs/buffer.rkt +++ b/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) diff --git a/rmacs/editor.rkt b/rmacs/editor.rkt index 7f19e3a..61c815d 100644 --- a/rmacs/editor.rkt +++ b/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))) diff --git a/rmacs/mode.rkt b/rmacs/mode.rkt index bf77f8c..1f59db8 100644 --- a/rmacs/mode.rkt +++ b/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] diff --git a/rmacs/mode/fundamental.rkt b/rmacs/mode/fundamental.rkt index 58254d0..b987a50 100644 --- a/rmacs/mode/fundamental.rkt +++ b/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) - (editor-invoke-command 'self-insert-command e #:keyseq keyseq)) +(define-command fundamental-mode (unbound-key-sequence buf #: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 "" - (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 "" - (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 "" - (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 "" - (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 "" - (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 "" - (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 "" #: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 "" #: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-" #:bind-key "" - (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-" - (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)))