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

View File

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

View File

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

View File

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

View File

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