From dd6298f36b413d6f770e8b2c8c06b6ba56690a32 Mon Sep 17 00:00:00 2001 From: Tony Garnock-Jones Date: Sun, 28 Dec 2014 14:26:12 -0500 Subject: [PATCH] buffer-locals, editor-last-command, better tracking of vertical movement column --- rmacs/TODO | 2 -- rmacs/buffer.rkt | 24 ++++++++++++++++++++++-- rmacs/editor.rkt | 22 +++++++++++++++++++--- rmacs/mode/fundamental.rkt | 23 ++++++++++++++++------- 4 files changed, 57 insertions(+), 14 deletions(-) diff --git a/rmacs/TODO b/rmacs/TODO index 43dce02..b7668d0 100644 --- a/rmacs/TODO +++ b/rmacs/TODO @@ -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 diff --git a/rmacs/buffer.rkt b/rmacs/buffer.rkt index 4e24bfe..c4ec118 100644 --- a/rmacs/buffer.rkt +++ b/rmacs/buffer.rkt @@ -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) diff --git a/rmacs/editor.rkt b/rmacs/editor.rkt index 9c77871..6e3bfe6 100644 --- a/rmacs/editor.rkt +++ b/rmacs/editor.rkt @@ -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) diff --git a/rmacs/mode/fundamental.rkt b/rmacs/mode/fundamental.rkt index 62fefc5..92a14a8 100644 --- a/rmacs/mode/fundamental.rkt +++ b/rmacs/mode/fundamental.rkt @@ -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 "" (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 "" - (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 "" - (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))