racket-ansi/rmacs/editor.rkt

147 lines
5.6 KiB
Racket

#lang racket/base
(provide (except-out (struct-out editor) editor)
make-editor
visit-file!
render-editor!
editor-active-buffer
editor-active-modeset
editor-invoke-command
editor-mainloop
editor-request-shutdown!
)
(require racket/match)
(require "buffer.rkt")
(require "display.rkt")
(require "window.rkt")
(require "render.rkt")
(require "mode.rkt")
(require "keys.rkt")
(require "rope.rkt")
(struct editor (buffers ;; BufferGroup
[tty #:mutable] ;; Tty
[windows #:mutable] ;; (List (List Window SizeSpec)), abstract window layout
[active-window #:mutable] ;; (Option Window)
[running? #:mutable] ;; Boolean
[default-modeset #:mutable] ;; ModeSet
) #:prefab)
(define (make-editor #:tty [tty (stdin-tty)]
#:default-modeset [default-modeset (make-modeset)])
(define g (make-buffergroup))
(define scratch (make-buffer g "*scratch*" #:initial-contents ";; This is the scratch buffer."))
(define w (make-window scratch))
(define e (editor g
tty
(list (list w (relative-size 1)))
w
#f
default-modeset))
(configure-fresh-buffer! e scratch)
e)
(define (configure-fresh-buffer! editor buffer)
(buffer-apply-modeset! buffer (editor-default-modeset editor))
buffer)
(define (find-buffer editor [title0 #f] #:initial-contents [initial-contents ""])
(define g (editor-buffers editor))
(define title (or title0 (unused-buffer-title g '())))
(or (lookup-buffer g title)
(configure-fresh-buffer! editor (make-buffer g title #:initial-contents initial-contents))))
(define (open-window editor buffer
#:size [size (relative-size 1)]
#:activate? [activate? #t])
(define w (make-window buffer))
(set-editor-windows! editor (append (editor-windows editor) (list (list w size))))
(when activate? (set-editor-active-window! editor w))
w)
(define (visit-file! editor filename)
(set-window-buffer! (editor-active-window editor)
(configure-fresh-buffer! editor
(file->buffer (editor-buffers editor) filename))))
(define (render-editor! editor)
(render-windows! (editor-tty editor)
(editor-windows editor)
(editor-active-window editor)))
(define (editor-active-buffer editor)
(define w (editor-active-window editor))
(and w (window-buffer w)))
(define (editor-active-modeset editor)
(define b (editor-active-buffer editor))
(and b (buffer-modeset b)))
(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))
(log-error "Exception:\n~a\n" error-report)
(define b (find-buffer editor "*Error*"))
(buffer-replace-contents! b (string->rope error-report))
(open-window editor b))
(define (editor-mainloop editor)
(when (editor-running? editor) (error 'editor-mainloop "Nested mainloop"))
(set-editor-running?! editor #t)
(with-handlers* ([exn? (lambda (exc)
(set-editor-running?! editor #f)
(open-debugger editor exc)
(editor-mainloop editor))])
(let loop ((total-keyseq '())
(input '())
(handler (root-keyseq-handler editor)))
(define (wait-for-input next-handler)
(render-editor! editor)
(when (editor-running? editor)
(sync (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 (editor-invoke-command 'unbound-key-sequence 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))))))
(editor-invoke-command selector editor #:keyseq accepted-input #:prefix-arg prefix-arg)
(loop '() remaining-input (root-keyseq-handler editor))])))))
(define (editor-request-shutdown! editor)
(set-editor-running?! editor #f))
;;---------------------------------------------------------------------------
(define-command kernel-mode (save-buffers-kill-terminal e)
#:bind-key "C-x C-c"
(editor-request-shutdown! e))