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

buffer-locals, editor-last-command, better tracking of vertical movement column

This commit is contained in:
Tony Garnock-Jones 2014-12-28 14:26:12 -05:00
parent a99eed55a4
commit dd6298f36b
4 changed files with 57 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
rmacs/TODO
View File

@ -1,6 +1,4 @@
Make it reloadable
Preserve column on up/down better.
Catch and handle SIGWINCH.
See http://man7.org/tlpi/code/online/dist/tty/demo_SIGWINCH.c.html

24
rmacs/buffer.rkt
View File

@ -20,6 +20,7 @@
buffer-source
buffer-rope
buffer-group
buffer-locals
mark-buffer-clean!
buffer-editor
buffer-modeset
@ -51,6 +52,8 @@
buffer-replace-contents!
buffer-search
buffer-findf
buffer-local
define-buffer-local
command?
command-selector
@ -93,6 +96,7 @@
[modeset #:mutable] ;; ModeSet
[dirty? #:mutable] ;; Boolean
[source #:mutable] ;; (Option BufferSource)
[locals #:mutable] ;; (HashEqTable Symbol Any)
) #:prefab)
(struct command (selector ;; Symbol
@ -127,7 +131,8 @@
#f
kernel-modeset
#f
#f)))
#f
(hasheq))))
(define (register-buffer! group buf)
(define old-group (buffer-group buf))
@ -242,7 +247,7 @@
[(? char?) (loop (+ column-count 1) (+ pos 1))]
[_ pos])]
[(= column-count column) pos]
[(< column-count column) (- pos 1)])))
[(> column-count column) (- pos 1)])))
(define (buffer-apply-modeset! buf modeset)
(set-buffer-modeset! buf modeset))
@ -373,6 +378,21 @@
(buffer-search* buf start-pos-or-mtype forward?
(lambda (piece) (findf-in-rope f piece #:forward? forward?))))
(define (buffer-local name [default #f])
(case-lambda
[(buf)
(hash-ref (buffer-locals buf) name default)]
[(buf val)
(set-buffer-locals! buf (if (equal? val default)
(hash-remove (buffer-locals buf) name)
(hash-set (buffer-locals buf) name val)))
val]))
(define-syntax define-buffer-local
(syntax-rules ()
((_ name) (define name (buffer-local 'name)))
((_ name default) (define name (buffer-local 'name default)))))
(define (buffer-lift f buf . args)
(define new-rope (apply f (buffer-rope buf) args))
(set-buffer-rope! buf new-rope)

22
rmacs/editor.rkt
View File

@ -15,6 +15,8 @@
editor-next-window
editor-prev-window
editor-command
invoke/history
editor-last-command?
editor-active-buffer
editor-active-modeset
editor-mainloop
@ -40,6 +42,7 @@
[running? #:mutable] ;; Boolean
[default-modeset #:mutable] ;; ModeSet
[layout #:mutable] ;; (Option (List Layout))
[last-command #:mutable] ;; (Option Command)
) #:prefab)
(define (make-editor #:tty [tty (stdin-tty)]
@ -49,7 +52,7 @@
#:initial-contents ";; This is the scratch buffer.\n\n"))
(define w (make-window scratch))
(define ws (list->circular-list (list (list w (relative-size 1)))))
(define e (editor g tty ws w #f default-modeset #f))
(define e (editor g tty ws w #f default-modeset #f #f))
(initialize-buffergroup! g e)
(configure-fresh-buffer! e scratch)
(window-move-to! w (buffer-size scratch))
@ -185,6 +188,16 @@
#:prefix-arg [prefix-arg '#:default])
(window-command selector (editor-active-window editor) #:keyseq keyseq #:prefix-arg prefix-arg))
(define (invoke/history cmd)
(define result (invoke cmd))
(set-editor-last-command! (command-editor cmd) cmd)
result)
(define (editor-last-command? editor . possible-selectors)
(and (editor-last-command editor)
(for/or ((selector (in-list possible-selectors)))
(eq? (command-selector (editor-last-command editor)) selector))))
(define (root-keyseq-handler editor)
(modeset-keyseq-handler (editor-active-modeset editor)))
@ -234,7 +247,8 @@
[else
(match (handler editor input)
[(unbound-key-sequence)
(if (invoke (editor-command 'unbound-key-sequence editor #:keyseq total-keyseq))
(if (invoke/history (editor-command 'unbound-key-sequence editor
#:keyseq total-keyseq))
(loop '() '() (root-keyseq-handler editor) (request-repaint))
(error 'editor-mainloop "Unbound key sequence: ~a"
(keyseq->keyspec total-keyseq)))]
@ -246,7 +260,9 @@
(if (equal? keyseq remaining-input)
'()
(cons (car keyseq) (remove-tail (cdr keyseq))))))
(invoke (editor-command selector editor #:keyseq accepted-input #:prefix-arg prefix-arg))
(invoke/history (editor-command selector editor
#:keyseq accepted-input
#:prefix-arg prefix-arg))
(loop '() remaining-input (root-keyseq-handler editor) (request-repaint))])]))))
(define (editor-request-shutdown! editor)

23
rmacs/mode/fundamental.rkt
View File

@ -38,11 +38,8 @@
(define (move-to-column win col)
(define buf (window-buffer win))
(buffer-mark! buf (window-point win)
(buffer-closest-pos-for-column buf
(buffer-start-of-line buf (window-point win))
0
col)))
(define sol (buffer-start-of-line buf (window-point win)))
(buffer-mark! buf (window-point win) (buffer-closest-pos-for-column buf sol 0 col)))
(define-command fundamental-mode (forward-char buf #:window win #:prefix-arg [count 1])
#:bind-key "C-f"
@ -54,17 +51,29 @@
#:bind-key "<left>"
(buffer-move-mark! buf (window-point win) (- count)))
(define-buffer-local last-vertical-movement-preferred-column)
(define (vertical-movement-preferred-column win)
(define buf (window-buffer win))
(last-vertical-movement-preferred-column
buf
(or (and (editor-last-command? (buffer-editor buf)
'next-line
'prev-line)
(last-vertical-movement-preferred-column buf))
(buffer-column buf (window-point win)))))
(define-command fundamental-mode (next-line buf #:window win #:prefix-arg [count 1])
#:bind-key "C-n"
#:bind-key "<down>"
(define col (buffer-column buf (window-point win)))
(define col (vertical-movement-preferred-column win))
(move-forward-n-lines win count)
(move-to-column win col))
(define-command fundamental-mode (prev-line buf #:window win #:prefix-arg [count 1])
#:bind-key "C-p"
#:bind-key "<up>"
(define col (buffer-column buf (window-point win)))
(define col (vertical-movement-preferred-column win))
(move-backward-n-lines win count)
(move-to-column win col))