Incremental redisplay.
This commit is contained in:
Tony Garnock-Jones
parent
7b7676b1ab
commit
bf0e56b963
18
rmacs/TODO
18
rmacs/TODO
|
|
@ -1,5 +1,19 @@
|
|||
Make it reloadable
|
||||
|
||||
Incremental display repair
|
||||
|
||||
Windows need their own top-of-window-mtype and point location
|
||||
|
||||
Preserve column on up/down better. This includes dealing with tab expansion
|
||||
|
||||
Bundle up all mutable command context into a single record, to let the
|
||||
command handler have everything it needs even in the face of change
|
||||
|
||||
Need line wrap of some kind.
|
||||
|
||||
unknown-escape-sequence contents are byte strings, and keyseq parsing
|
||||
and printing should reflect that.
|
||||
|
||||
something to do with framing is broken, causing odd scroll-lock
|
||||
behaviour near the end of the demo file.
|
||||
|
||||
Catch and handle SIGWINCH.
|
||||
See http://man7.org/tlpi/code/online/dist/tty/demo_SIGWINCH.c.html
|
||||
|
|
|
|||
|
|
@ -1,124 +1,96 @@
|
|||
#lang racket/base
|
||||
|
||||
(provide (struct-out tty)
|
||||
(struct-out pen)
|
||||
stdin-tty
|
||||
tty-rows
|
||||
tty-columns
|
||||
tty-last-row
|
||||
tty-last-column
|
||||
stdin-tty
|
||||
tty-cursor-row
|
||||
tty-cursor-column
|
||||
tty-display
|
||||
tty-newline
|
||||
tty-clear
|
||||
tty-clear-to-eol
|
||||
tty-reset
|
||||
tty-goto
|
||||
tty-style
|
||||
tty-style-reset
|
||||
tty-set-pen!
|
||||
tty-pen
|
||||
tty-flush
|
||||
tty-next-key
|
||||
tty-next-key-evt
|
||||
|
||||
;; From ansi
|
||||
color-black
|
||||
color-red
|
||||
color-green
|
||||
color-yellow
|
||||
color-blue
|
||||
color-magenta
|
||||
color-cyan
|
||||
color-white)
|
||||
(rename-out [ansi:color-black color-black]
|
||||
[ansi:color-red color-red]
|
||||
[ansi:color-green color-green]
|
||||
[ansi:color-yellow color-yellow]
|
||||
[ansi:color-blue color-blue]
|
||||
[ansi:color-magenta color-magenta]
|
||||
[ansi:color-cyan color-cyan]
|
||||
[ansi:color-white color-white]))
|
||||
|
||||
(require racket/set)
|
||||
(require racket/match)
|
||||
(require ansi)
|
||||
(require (only-in racket/vector vector-copy))
|
||||
(require (prefix-in ansi: ansi))
|
||||
|
||||
(require "diff.rkt")
|
||||
|
||||
(struct pen (foreground-color ;; Nat
|
||||
background-color ;; Nat
|
||||
bold? ;; Boolean
|
||||
italic? ;; Boolean
|
||||
) #:prefab)
|
||||
|
||||
(struct screen (rows ;; Nat
|
||||
columns ;; Nat
|
||||
[cursor-row #:mutable] ;; Nat
|
||||
[cursor-column #:mutable] ;; Nat
|
||||
[pen #:mutable] ;; Pen
|
||||
contents ;; (Vector[rows] (Vector[columns] (Cons Pen Character)))
|
||||
) #:prefab)
|
||||
|
||||
(struct tty (input ;; InputPort
|
||||
output ;; OutputPort
|
||||
key-reader ;; InputPort -> Key
|
||||
[rows #:mutable] ;; Nat
|
||||
[columns #:mutable] ;; Nat
|
||||
[cursor-row #:mutable] ;; Nat
|
||||
[cursor-column #:mutable] ;; Nat
|
||||
[foreground-color #:mutable] ;; Nat
|
||||
[background-color #:mutable] ;; Nat
|
||||
[bold? #:mutable] ;; Boolean
|
||||
[italic? #:mutable] ;; Boolean
|
||||
[displayed-screen #:mutable] ;; Screen
|
||||
[pending-screen #:mutable] ;; Screen
|
||||
) #:prefab)
|
||||
|
||||
(define (tty-last-row t) (- (tty-rows t) 1))
|
||||
(define (tty-last-column t) (- (tty-columns t) 1))
|
||||
(define (make-screen rows columns pen)
|
||||
(define contents (for/vector ((row rows)) (make-vector columns (cons pen #\space))))
|
||||
(screen rows columns 0 0 pen contents))
|
||||
|
||||
(define (copy-screen s)
|
||||
(match-define (screen rows columns cursor-row cursor-column pen contents) s)
|
||||
(define new-contents (for/vector ((row rows)) (vector-copy (vector-ref contents row))))
|
||||
(screen rows columns cursor-row cursor-column pen new-contents))
|
||||
|
||||
(define *pen-white-on-black* (pen ansi:color-white ansi:color-black #f #f))
|
||||
|
||||
(define *stdin-tty* #f)
|
||||
(define (stdin-tty)
|
||||
(when (not *stdin-tty*)
|
||||
(tty-raw!)
|
||||
(ansi:tty-raw!)
|
||||
(set! *stdin-tty*
|
||||
(tty (current-input-port)
|
||||
(current-output-port)
|
||||
lex-lcd-input
|
||||
24
|
||||
80
|
||||
0
|
||||
0
|
||||
color-white
|
||||
color-black
|
||||
#f
|
||||
#f))
|
||||
(tty-reset *stdin-tty*)
|
||||
ansi:lex-lcd-input
|
||||
(make-screen 24 80 *pen-white-on-black*)
|
||||
(make-screen 24 80 *pen-white-on-black*)))
|
||||
(reset *stdin-tty*)
|
||||
(plumber-add-flush! (current-plumber)
|
||||
(lambda (h)
|
||||
(tty-display *stdin-tty*
|
||||
(select-graphic-rendition style-normal))
|
||||
(tty-goto *stdin-tty* (tty-last-row *stdin-tty*) 0))))
|
||||
(output *stdin-tty*
|
||||
(ansi:select-graphic-rendition ansi:style-normal)
|
||||
(ansi:goto (tty-rows *stdin-tty*) 1))
|
||||
(flush *stdin-tty*))))
|
||||
*stdin-tty*)
|
||||
|
||||
(define (tty-display tty . items)
|
||||
(for ((i items)) (display i (tty-output tty)))
|
||||
(flush-output (tty-output tty)))
|
||||
|
||||
(define (tty-newline tty)
|
||||
(tty-display tty "\r\n"))
|
||||
|
||||
(define (tty-goto tty row0 column0)
|
||||
(define row (max 0 (min (tty-last-row tty) row0)))
|
||||
(define column (max 0 (min (tty-last-column tty) column0)))
|
||||
(tty-display tty (goto (+ row 1) (+ column 1)))
|
||||
(set-tty-cursor-row! tty row)
|
||||
(set-tty-cursor-column! tty column)
|
||||
tty)
|
||||
|
||||
(define (tty-clear tty)
|
||||
(tty-style tty) ;; applies style from tty
|
||||
(tty-display tty (clear-screen/home))
|
||||
(set-tty-cursor-row! tty 0)
|
||||
(set-tty-cursor-column! tty 0)
|
||||
tty)
|
||||
|
||||
(define (tty-clear-to-eol tty)
|
||||
(tty-display tty (clear-to-eol))
|
||||
tty)
|
||||
|
||||
(define (tty-style tty
|
||||
#:foreground-color [fgcolor (tty-foreground-color tty)]
|
||||
#:background-color [bgcolor (tty-background-color tty)]
|
||||
#:bold? [bold? (tty-bold? tty)]
|
||||
#:italic? [italic? (tty-italic? tty)])
|
||||
(tty-display tty
|
||||
(select-graphic-rendition)
|
||||
(apply select-graphic-rendition
|
||||
`(,@(if bold? (list style-bold) (list))
|
||||
,@(if italic? (list style-italic/inverse) (list))
|
||||
,(style-text-color fgcolor)
|
||||
,(style-background-color bgcolor))))
|
||||
(set-tty-foreground-color! tty fgcolor)
|
||||
(set-tty-background-color! tty bgcolor)
|
||||
(set-tty-bold?! tty bold?)
|
||||
(set-tty-italic?! tty italic?)
|
||||
tty)
|
||||
|
||||
(define (tty-style-reset tty)
|
||||
(tty-style tty
|
||||
#:foreground-color color-white
|
||||
#:background-color color-black
|
||||
#:bold? #f
|
||||
#:italic? #f))
|
||||
;;---------------------------------------------------------------------------
|
||||
;; Actually send changes to the display
|
||||
|
||||
(define (collect-position-report tty)
|
||||
(let loop ()
|
||||
|
|
@ -126,27 +98,235 @@
|
|||
(handle-evt (tty-input tty)
|
||||
(lambda (p)
|
||||
(match ((tty-key-reader tty) p)
|
||||
[(? position-report? r) r]
|
||||
[(? ansi:position-report? r) r]
|
||||
[_ (loop)]))))))
|
||||
|
||||
(define (tty-reset tty)
|
||||
(tty-display tty
|
||||
(clear-screen)
|
||||
(goto 999 999)
|
||||
(position-report-request))
|
||||
(define (reset tty)
|
||||
(output tty
|
||||
(ansi:clear-screen)
|
||||
(ansi:goto 999 999)
|
||||
(ansi:position-report-request))
|
||||
(flush tty)
|
||||
(define report (or (collect-position-report tty)
|
||||
(position-report 24 80))) ;; TODO: have a more flexible fallback
|
||||
(tty-clear tty)
|
||||
(set-tty-rows! tty (position-report-row report))
|
||||
(set-tty-columns! tty (position-report-column report))
|
||||
(ansi:position-report 24 80))) ;; TODO: have a more flexible fallback
|
||||
;; (set! report (ansi:position-report 5 10))
|
||||
(define rows (ansi:position-report-row report))
|
||||
(define columns (ansi:position-report-column report))
|
||||
(set-pen tty *pen-white-on-black* #:force #t)
|
||||
(clear tty)
|
||||
(flush tty)
|
||||
(set-tty-displayed-screen! tty (make-screen rows columns *pen-white-on-black*))
|
||||
(set-tty-pending-screen! tty (make-screen rows columns *pen-white-on-black*))
|
||||
tty)
|
||||
|
||||
(define (set-pen tty p #:force [force #f])
|
||||
(match-define (pen fgcolor bgcolor bold? italic?) p)
|
||||
(when (or force (not (equal? p (screen-pen (tty-displayed-screen tty)))))
|
||||
(output tty
|
||||
(apply ansi:select-graphic-rendition
|
||||
`(,@(if bold? (list ansi:style-bold) (list))
|
||||
,@(if italic? (list ansi:style-italic/inverse) (list))
|
||||
,(ansi:style-text-color fgcolor)
|
||||
,(ansi:style-background-color bgcolor))))
|
||||
(set-screen-pen! (tty-displayed-screen tty) p))
|
||||
tty)
|
||||
|
||||
(define (clear tty)
|
||||
(output tty (ansi:clear-screen/home))
|
||||
(set-screen-cursor-row! (tty-displayed-screen tty) 0)
|
||||
(set-screen-cursor-column! (tty-displayed-screen tty) 0)
|
||||
tty)
|
||||
|
||||
(define (delete-lines tty n)
|
||||
(define s (tty-displayed-screen tty))
|
||||
(output tty (ansi:delete-lines n))
|
||||
(define blank-line (make-vector (screen-columns s) (cons 'unknown #\space)))
|
||||
(vector-copy! (screen-contents s)
|
||||
(screen-cursor-row s)
|
||||
(screen-contents s)
|
||||
(+ (screen-cursor-row s) n)
|
||||
(screen-rows s))
|
||||
(for ((i (in-range (- (screen-rows s) n) (screen-rows s))))
|
||||
(vector-set! (screen-contents s) i blank-line))
|
||||
tty)
|
||||
|
||||
(define (insert-lines tty n)
|
||||
(define s (tty-displayed-screen tty))
|
||||
(set-pen tty (car (vector-ref (vector-ref (screen-contents s)
|
||||
(max 0 (- (screen-cursor-row s) 1)))
|
||||
(screen-cursor-column s))))
|
||||
(output tty (ansi:insert-lines n))
|
||||
(define blank-line (make-vector (screen-columns s) (cons (screen-pen s) #\space)))
|
||||
(vector-copy! (screen-contents s)
|
||||
(+ (screen-cursor-row s) n)
|
||||
(screen-contents s)
|
||||
(screen-cursor-row s)
|
||||
(- (screen-rows s) n))
|
||||
(for ((i (in-range (screen-cursor-row s) (+ (screen-cursor-row s) n))))
|
||||
(vector-set! (screen-contents s) i blank-line))
|
||||
tty)
|
||||
|
||||
(define (output tty . items)
|
||||
(for ((i items)) (display i (tty-output tty))))
|
||||
|
||||
(define (flush tty)
|
||||
(flush-output (tty-output tty)))
|
||||
|
||||
;;---------------------------------------------------------------------------
|
||||
;; Display to buffered screen
|
||||
|
||||
(define (tty-rows t) (screen-rows (tty-pending-screen t)))
|
||||
(define (tty-columns t) (screen-columns (tty-pending-screen t)))
|
||||
|
||||
(define (tty-last-row t) (- (tty-rows t) 1))
|
||||
(define (tty-last-column t) (- (tty-columns t) 1))
|
||||
|
||||
(define (tty-cursor-row t) (screen-cursor-row (tty-pending-screen t)))
|
||||
(define (tty-cursor-column t) (screen-cursor-column (tty-pending-screen t)))
|
||||
|
||||
(define (putc tty ch)
|
||||
(define s (tty-pending-screen tty))
|
||||
(match ch
|
||||
[#\return
|
||||
(tty-goto tty (screen-cursor-row s) 0)]
|
||||
[#\newline
|
||||
(tty-goto tty (+ (screen-cursor-row s) 1) (screen-cursor-column s))]
|
||||
[#\tab
|
||||
(for ((i (- 8 (modulo (screen-cursor-column s) 8)))) (putc tty #\space))]
|
||||
[(? char-iso-control?)
|
||||
(puts tty (format "[~x]" (char->integer ch)))]
|
||||
[_
|
||||
(when (< (screen-cursor-column s) (screen-columns s))
|
||||
;; (tty-goto tty (+ (screen-cursor-row s) 1) 0)
|
||||
(vector-set! (vector-ref (screen-contents s) (screen-cursor-row s))
|
||||
(screen-cursor-column s)
|
||||
(cons (screen-pen s) ch)))
|
||||
(set-screen-cursor-column! s (+ (screen-cursor-column s) 1))]))
|
||||
|
||||
(define (puts tty s)
|
||||
(for ((ch s)) (putc tty ch)))
|
||||
|
||||
(define (tty-display tty . strings)
|
||||
(for ((s strings)) (puts tty s)))
|
||||
|
||||
(define (tty-newline tty)
|
||||
(putc tty #\return)
|
||||
(putc tty #\newline))
|
||||
|
||||
(define (tty-clear tty)
|
||||
(set-tty-pending-screen! tty (make-screen (tty-rows tty) (tty-columns tty) (tty-pen tty)))
|
||||
tty)
|
||||
|
||||
(define (tty-clear-to-eol tty)
|
||||
(define start-column (tty-cursor-column tty))
|
||||
(for ((i (- (tty-columns tty) (tty-cursor-column tty)))) (putc tty #\space))
|
||||
(tty-goto tty (tty-cursor-row tty) start-column)
|
||||
tty)
|
||||
|
||||
(define (tty-reset tty)
|
||||
(reset tty)
|
||||
tty)
|
||||
|
||||
(define (tty-goto tty row0 column0)
|
||||
(define row (max 0 (min (tty-last-row tty) row0)))
|
||||
(define column (max 0 (min (tty-last-column tty) column0)))
|
||||
(set-screen-cursor-row! (tty-pending-screen tty) row)
|
||||
(set-screen-cursor-column! (tty-pending-screen tty) column)
|
||||
tty)
|
||||
|
||||
(define (tty-set-pen! tty pen)
|
||||
(set-screen-pen! (tty-pending-screen tty) pen)
|
||||
tty)
|
||||
|
||||
(define (tty-pen tty)
|
||||
(screen-pen (tty-pending-screen tty)))
|
||||
|
||||
;; (define (dump-screen s)
|
||||
;; (list 'screen
|
||||
;; (screen-rows s)
|
||||
;; (screen-columns s)
|
||||
;; (screen-cursor-row s)
|
||||
;; (screen-cursor-column s)
|
||||
;; (list->string
|
||||
;; (for*/list ((line (screen-contents s))
|
||||
;; (cell line)
|
||||
;; #:when (not (equal? (cdr cell) #\space)))
|
||||
;; (cdr cell)))))
|
||||
|
||||
(define (goto-if-needed s row column)
|
||||
(if (and (= (screen-cursor-row s) row)
|
||||
(= (screen-cursor-column s) column))
|
||||
""
|
||||
(begin0 (ansi:goto (+ row 1) (+ column 1))
|
||||
(set-screen-cursor-row! s row)
|
||||
(set-screen-cursor-column! s column))))
|
||||
|
||||
(define (advance-cursor! s)
|
||||
(set-screen-cursor-column! s (+ (screen-cursor-column s) 1))
|
||||
(when (= (screen-cursor-column s) (screen-columns s))
|
||||
(set-screen-cursor-column! s 0)
|
||||
(set-screen-cursor-row! s (+ (screen-cursor-row s) 1))))
|
||||
|
||||
(define (tty-flush tty)
|
||||
;; (set-pen tty *pen-white-on-black* #:force #t)
|
||||
;; (clear tty)
|
||||
(define old (tty-displayed-screen tty))
|
||||
(define new (tty-pending-screen tty))
|
||||
(define patches (diff-indices (screen-contents old) (screen-contents new)))
|
||||
|
||||
;; Proceed in two stages:
|
||||
;; - delete unwanted lines
|
||||
;; - insert and blank lines
|
||||
|
||||
(for/fold [(skew 0)]
|
||||
[(patch patches)]
|
||||
(match-define (list patch-old-line patch-old-count patch-new-line patch-new-count) patch)
|
||||
(define delta-lines (- patch-new-count patch-old-count))
|
||||
(define first-row (+ patch-old-line skew))
|
||||
(if (negative? delta-lines)
|
||||
(begin (output tty (goto-if-needed old first-row (screen-cursor-column old)))
|
||||
(delete-lines tty (- delta-lines))
|
||||
(+ skew delta-lines))
|
||||
skew))
|
||||
|
||||
(for/fold [(skew 0)]
|
||||
[(patch patches)]
|
||||
(match-define (list patch-old-line patch-old-count patch-new-line patch-new-count) patch)
|
||||
(define delta-lines (- patch-new-count patch-old-count))
|
||||
(define first-row (+ patch-old-line skew))
|
||||
(when (positive? delta-lines)
|
||||
(output tty (goto-if-needed old first-row (screen-cursor-column old)))
|
||||
(insert-lines tty delta-lines))
|
||||
(for ((row (in-range first-row (+ patch-old-line skew patch-new-count))))
|
||||
(define old-line (vector-ref (screen-contents old) row))
|
||||
(define new-line (vector-ref (screen-contents new) row))
|
||||
;; TODO: consider diffing old-line and new-line and applying
|
||||
;; patches rather than just blitting out the whole line
|
||||
;; whereever it is different.
|
||||
(for ((column (screen-columns new)))
|
||||
(match-define (cons old-pen old-ch) (vector-ref old-line column))
|
||||
(match-define (cons new-pen new-ch) (vector-ref new-line column))
|
||||
(when (not (and (equal? old-pen new-pen) (equal? old-ch new-ch)))
|
||||
(set-pen tty new-pen)
|
||||
(output tty (goto-if-needed old row column) new-ch)
|
||||
(advance-cursor! old))))
|
||||
(+ skew delta-lines))
|
||||
|
||||
(output tty (goto-if-needed old (screen-cursor-row new) (screen-cursor-column new)))
|
||||
(flush tty)
|
||||
(set-tty-displayed-screen! tty new)
|
||||
(set-tty-pending-screen! tty (copy-screen new))
|
||||
tty)
|
||||
|
||||
;;---------------------------------------------------------------------------
|
||||
;; Input
|
||||
|
||||
(define (tty-next-key tty)
|
||||
(define k (lex-lcd-input (tty-input tty)))
|
||||
(if (equal? k (key #\[ (set 'control))) ;; ESC
|
||||
(define k (ansi:lex-lcd-input (tty-input tty)))
|
||||
(if (equal? k (ansi:key #\[ (set 'control))) ;; ESC
|
||||
(or (sync/timeout 0.5
|
||||
(handle-evt (tty-next-key-evt tty)
|
||||
(lambda (k) (add-modifier 'meta k))))
|
||||
(lambda (k) (ansi:add-modifier 'meta k))))
|
||||
k)
|
||||
k))
|
||||
|
||||
|
|
|
|||
|
|
@ -8,6 +8,7 @@
|
|||
editor-active-modeset
|
||||
editor-mainloop
|
||||
editor-request-shutdown!
|
||||
editor-force-redisplay!
|
||||
)
|
||||
|
||||
(require racket/match)
|
||||
|
|
@ -99,41 +100,62 @@
|
|||
(editor-mainloop editor))])
|
||||
(let loop ((total-keyseq '())
|
||||
(input '())
|
||||
(handler (root-keyseq-handler editor)))
|
||||
(handler (root-keyseq-handler editor))
|
||||
(next-repaint-deadline 0))
|
||||
(define (request-repaint) (or next-repaint-deadline (+ (current-inexact-milliseconds) 20)))
|
||||
(define (wait-for-input next-handler)
|
||||
(render-editor! editor)
|
||||
(when (editor-running? editor)
|
||||
(sync (handle-evt (tty-next-key-evt (editor-tty editor))
|
||||
(sync (if next-repaint-deadline
|
||||
(handle-evt (alarm-evt next-repaint-deadline)
|
||||
(lambda (_)
|
||||
(loop total-keyseq '() next-handler next-repaint-deadline)))
|
||||
never-evt)
|
||||
(handle-evt (tty-next-key-evt (editor-tty editor))
|
||||
(lambda (new-key)
|
||||
(define new-input (list new-key))
|
||||
(loop (append total-keyseq new-input) new-input next-handler))))))
|
||||
(if (null? input)
|
||||
(wait-for-input handler)
|
||||
(match (handler editor input)
|
||||
[(unbound-key-sequence)
|
||||
(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)))]
|
||||
[(incomplete-key-sequence next-handler)
|
||||
(wait-for-input next-handler)]
|
||||
[(command-invocation selector prefix-arg remaining-input)
|
||||
(define accepted-input
|
||||
(let remove-tail ((keyseq total-keyseq))
|
||||
(if (equal? keyseq remaining-input)
|
||||
'()
|
||||
(cons (car keyseq) (remove-tail (cdr keyseq))))))
|
||||
(invoke-command selector (editor-active-buffer editor)
|
||||
#:keyseq accepted-input
|
||||
#:prefix-arg prefix-arg)
|
||||
(loop '() remaining-input (root-keyseq-handler editor))])))))
|
||||
(loop (append total-keyseq new-input)
|
||||
new-input
|
||||
next-handler
|
||||
next-repaint-deadline))))))
|
||||
(cond
|
||||
[(and next-repaint-deadline (>= (current-inexact-milliseconds) next-repaint-deadline))
|
||||
(render-editor! editor)
|
||||
(loop total-keyseq input handler #f)]
|
||||
[(null? input)
|
||||
(wait-for-input handler)]
|
||||
[else
|
||||
(match (handler editor input)
|
||||
[(unbound-key-sequence)
|
||||
(if (invoke-command 'unbound-key-sequence (editor-active-buffer editor)
|
||||
#:keyseq total-keyseq)
|
||||
(loop '() '() (root-keyseq-handler editor) (request-repaint))
|
||||
(error 'editor-mainloop "Unbound key sequence: ~a"
|
||||
(keyseq->keyspec total-keyseq)))]
|
||||
[(incomplete-key-sequence next-handler)
|
||||
(wait-for-input next-handler)]
|
||||
[(command-invocation selector prefix-arg remaining-input)
|
||||
(define accepted-input
|
||||
(let remove-tail ((keyseq total-keyseq))
|
||||
(if (equal? keyseq remaining-input)
|
||||
'()
|
||||
(cons (car keyseq) (remove-tail (cdr keyseq))))))
|
||||
(invoke-command selector (editor-active-buffer editor)
|
||||
#:keyseq accepted-input
|
||||
#:prefix-arg prefix-arg)
|
||||
(loop '() remaining-input (root-keyseq-handler editor) (request-repaint))])]))))
|
||||
|
||||
(define (editor-request-shutdown! editor)
|
||||
(set-editor-running?! editor #f))
|
||||
|
||||
(define (editor-force-redisplay! editor)
|
||||
(tty-reset (editor-tty editor)))
|
||||
|
||||
;;---------------------------------------------------------------------------
|
||||
|
||||
(define-command kernel-mode (save-buffers-kill-terminal buf)
|
||||
#:bind-key "C-x C-c"
|
||||
(editor-request-shutdown! (buffer-editor buf)))
|
||||
|
||||
(define-command kernel-mode (force-redisplay buf)
|
||||
#:bind-key "C-l"
|
||||
(editor-force-redisplay! (buffer-editor buf)))
|
||||
|
|
|
|||
|
|
@ -15,4 +15,6 @@
|
|||
(editor-mainloop e))
|
||||
|
||||
(module+ main
|
||||
(local-require racket/trace)
|
||||
(current-trace-notify (lambda (s) (log-info "TRACE: ~a" s)))
|
||||
(void (main)))
|
||||
|
|
|
|||
|
|
@ -49,15 +49,10 @@
|
|||
new-top-of-window-pos)])))
|
||||
|
||||
(define (tty-body-style t is-active?)
|
||||
(tty-style t
|
||||
#:foreground-color color-white
|
||||
#:background-color color-blue
|
||||
#:bold? #f))
|
||||
(tty-set-pen! t (pen color-white color-blue #f #f)))
|
||||
|
||||
(define (tty-statusline-style t is-active?)
|
||||
(tty-style t
|
||||
#:foreground-color color-black
|
||||
#:background-color color-white))
|
||||
(tty-set-pen! t (pen color-black color-white #f #f)))
|
||||
|
||||
(define (format-line line window-width cursor-input-pos)
|
||||
(let loop ((chars (string->list line))
|
||||
|
|
@ -117,8 +112,9 @@
|
|||
cursor-coordinates))])))
|
||||
(tty-statusline-style t is-active?)
|
||||
(tty-display t (if is-active? "== " "-- ") (buffer-title b) " ")
|
||||
(tty-display t (make-string (- (tty-columns t) 4 (string-length (buffer-title b)))
|
||||
(if is-active? #\= #\-)))
|
||||
(let ((remaining-length (- (tty-columns t) 4 (string-length (buffer-title b)))))
|
||||
(when (positive? remaining-length)
|
||||
(tty-display t (make-string remaining-length (if is-active? #\= #\-)))))
|
||||
cursor-coordinates)
|
||||
|
||||
(define (layout-windows ws total-height [minimum-height 4])
|
||||
|
|
@ -160,4 +156,5 @@
|
|||
(define window-cursor-position (render-buffer! t b window-top window-height is-active?))
|
||||
(if is-active? window-cursor-position cursor-position)))
|
||||
(when active-cursor-position
|
||||
(tty-goto t (car active-cursor-position) (cadr active-cursor-position))))
|
||||
(tty-goto t (car active-cursor-position) (cadr active-cursor-position)))
|
||||
(tty-flush t))
|
||||
|
|
|
|||
Loading…
Reference in New Issue