misc-deps
/
racket-ansi
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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

commands take a buffer instead of an editor.
This commit is contained in:
Tony Garnock-Jones 2014-12-23 11:49:17 -05:00
parent 79e994ef9c
commit c6f15b6881
5 changed files with 56 additions and 51 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
rmacs/TODO
View File

@ -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.

27
rmacs/buffer.rkt
View File

@ -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)

23
rmacs/editor.rkt
View File

@ -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)))

4
rmacs/mode.rkt
View File

@ -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]

50
rmacs/mode/fundamental.rkt
View File

@ -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 "<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)))