diff --git a/rmacs/editor.rkt b/rmacs/editor.rkt index 60cafe5..01f6c56 100644 --- a/rmacs/editor.rkt +++ b/rmacs/editor.rkt @@ -2,6 +2,9 @@ (provide (except-out (struct-out editor) editor) make-editor + window-layout + window-width + window-height open-window close-other-windows close-window @@ -16,8 +19,7 @@ editor-active-modeset editor-mainloop editor-request-shutdown! - editor-force-redisplay! - ) + editor-force-redisplay!) (require racket/match) @@ -36,6 +38,7 @@ [active-window #:mutable] ;; (Option Window) [running? #:mutable] ;; Boolean [default-modeset #:mutable] ;; ModeSet + [layout #:mutable] ;; (Option (List Layout)) ) #:prefab) (define (make-editor #:tty [tty (stdin-tty)] @@ -44,15 +47,11 @@ (define scratch (make-buffer g "*scratch*" #:initial-contents ";; This is the scratch buffer.\n\n")) (define w (make-window scratch)) - (window-move-to! w (buffer-size scratch)) - (define e (editor g - tty - (list->circular-list (list (list w (relative-size 1)))) - w - #f - default-modeset)) + (define ws (list->circular-list (list (list w (relative-size 1))))) + (define e (editor g tty ws w #f default-modeset #f)) (initialize-buffergroup! g e) (configure-fresh-buffer! e scratch) + (window-move-to! w (buffer-size scratch)) e) (define (configure-fresh-buffer! editor buffer) @@ -82,25 +81,43 @@ (define (entry-for? window) (lambda (e) (eq? (car e) window))) -(define (window->size-spec editor window) - (cond [(circular-list-memf (entry-for? window) - (editor-windows editor)) => (compose cadr circular-car)] +(define (invalidate-layout! editor) + (set-editor-layout! editor #f)) + +(define (layout! editor) + (when (not (editor-layout editor)) + (set-editor-layout! editor (layout-windows (circular-list->list (editor-windows editor)) + (tty-columns (editor-tty editor)) + (tty-rows (editor-tty editor))))) + (editor-layout editor)) + +(define (window-layout editor win) + (cond [(memf (lambda (l) (eq? (layout-window l) win)) (layout! editor)) => car] [else #f])) +(define ((-layout-accessor- getter) editor window) + (cond [(window-layout editor window) => getter] + [else #f])) + +(define window-size-spec (-layout-accessor- layout-size-spec)) +(define window-width (-layout-accessor- layout-width)) +(define window-height (-layout-accessor- layout-height)) + (define (update-window-entry editor win updater) (set-editor-windows! editor (circular-list-replacef (editor-windows editor) (entry-for? win) - updater))) + updater)) + (invalidate-layout! editor)) (define (open-window editor buffer #:after-window [after-window (editor-active-window editor)] #:proportional? [proportional? #f] #:activate? [activate? #t]) (define existing-w (window-for-buffer editor buffer)) - (define existing-size (window->size-spec editor after-window)) + (define existing-size (window-size-spec editor after-window)) (define new-size (if proportional? existing-size (split-size existing-size))) (define new-point (or (and existing-w (buffer-mark-pos* buffer (window-point existing-w))) 0)) - (define new-window (make-window buffer new-point)) + (define new-window (make-window buffer #:point new-point)) (update-window-entry editor after-window (lambda (e) (list (list after-window new-size) (list new-window new-size)))) @@ -111,12 +128,13 @@ (for ((entry (circular-list->list (editor-windows editor))) #:when (not (eq? (car entry) win))) (set-window-buffer! (car entry) #f)) (set-editor-windows! editor (list->circular-list (list (list win (relative-size 1))))) - (set-editor-active-window! editor win)) + (set-editor-active-window! editor win) + (invalidate-layout! editor)) (define (close-window editor win) (define prev (editor-prev-window editor win)) - (define prev-size (window->size-spec editor prev)) - (define win-size (window->size-spec editor win)) + (define prev-size (window-size-spec editor prev)) + (define win-size (window-size-spec editor win)) (when (and prev (> (circular-length (editor-windows editor)) 1)) (when (eq? (editor-active-window editor) win) (set-editor-active-window! editor prev)) (update-window-entry editor win (lambda (e) '())) @@ -135,7 +153,7 @@ (define (render-editor! editor) (render-windows! (editor-tty editor) - (circular-list->list (editor-windows editor)) + (layout! editor) (editor-active-window editor))) (define (editor-active-buffer editor) @@ -233,17 +251,18 @@ (set-editor-running?! editor #f)) (define (editor-force-redisplay! editor) - (tty-reset (editor-tty editor))) + (tty-reset (editor-tty editor)) + (invalidate-layout! editor)) ;;--------------------------------------------------------------------------- -(define-command kernel-mode (save-buffers-kill-terminal buf) +(define-command kernel-mode (save-buffers-kill-terminal buf #:editor ed) #:bind-key "C-x C-c" - (editor-request-shutdown! (buffer-editor buf))) + (editor-request-shutdown! ed)) -(define-command kernel-mode (force-redisplay buf) +(define-command kernel-mode (force-redisplay buf #:editor ed) #:bind-key "C-l" - (editor-force-redisplay! (buffer-editor buf))) + (editor-force-redisplay! ed)) (define-command kernel-mode (dump-buffer-to-stderr buf #:window win) #:bind-key "C-M-x" diff --git a/rmacs/render.rkt b/rmacs/render.rkt index 6f30ce9..d3bf0b5 100644 --- a/rmacs/render.rkt +++ b/rmacs/render.rkt @@ -2,6 +2,8 @@ (provide (struct-out absolute-size) (struct-out relative-size) + (struct-out layout) + layout-windows render-windows!) (require racket/match) @@ -17,6 +19,15 @@ (struct absolute-size (lines) #:prefab) (struct relative-size (weight) #:prefab) +;; A Layout is a (layout Window SizeSpec Nat Nat) +(struct layout (window ;; Window + size-spec ;; SizeSpec + top ;; Nat, a row + left ;; Nat, a column + width ;; Nat + height ;; Nat + ) #:prefab) + (define (newline? c) (equal? c #\newline)) (define (not-newline? c) (not (newline? c))) @@ -90,7 +101,7 @@ [_ (emit (string c))])]))) -(define (render-window! t win window-top window-height is-active?) +(define (render-window! t win window-top window-width window-height is-active?) (define buf (window-buffer win)) (define available-line-count (- window-height 1)) (define top-of-window-pos (frame! win available-line-count)) @@ -124,7 +135,7 @@ (tty-display t (make-string remaining-length #\-)))) cursor-coordinates) -(define (layout-windows ws total-height [minimum-height 4]) +(define (layout-windows ws total-width total-height [minimum-height 4]) (define total-weight (foldl + 0 (map (lambda (e) (match (cadr e) [(absolute-size _) 0] @@ -137,29 +148,31 @@ (let loop ((ws ws) (offset 0) (remaining proportional-lines)) (match ws ['() '()] - [(cons (list w (absolute-size lines)) rest) - (cons (list w offset lines) (loop rest (+ offset lines) remaining))] - [(cons (list w (relative-size weight)) rest) + [(cons (list w (and spec (absolute-size lines))) rest) + (cons (layout w spec offset 0 total-width lines) + (loop rest (+ offset lines) remaining))] + [(cons (list w (and spec (relative-size weight))) rest) (define height (max minimum-height (inexact->exact (round (* proportional-lines (/ weight total-weight)))))) (if (>= remaining height) (if (null? rest) - (list (list w offset remaining)) - (cons (list w offset height) (loop rest (+ offset height) (- remaining height)))) + (list (layout w spec offset 0 total-width remaining)) + (cons (layout w spec offset 0 total-width height) + (loop rest (+ offset height) (- remaining height)))) (if (>= remaining minimum-height) - (list (list w offset remaining)) + (list (layout w spec offset 0 total-width remaining)) '()))]))) -(define (render-windows! t ws active-window) - (define layout (layout-windows ws (tty-rows t))) +(define (render-windows! t layouts active-window) (tty-body-style t #f) (tty-goto t 0 0) (define active-cursor-position - (for/fold [(cursor-position #f)] [(e layout)] - (match-define (list w window-top window-height) e) + (for/fold [(cursor-position #f)] [(e layouts)] + (match-define (layout w _spec window-top _left window-width window-height) e) (define is-active? (eq? w active-window)) - (define window-cursor-position (render-window! t w window-top window-height is-active?)) + (define window-cursor-position + (render-window! t w window-top window-width 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))) diff --git a/rmacs/window.rkt b/rmacs/window.rkt index c54f3a7..2132301 100644 --- a/rmacs/window.rkt +++ b/rmacs/window.rkt @@ -20,7 +20,7 @@ [buffer #:mutable] ;; (Option Buffer) ) #:prefab) -(define (make-window initial-buffer [initial-point-or-mark 0]) +(define (make-window initial-buffer #:point [initial-point-or-mark 0]) (define id (gensym 'window)) (define w (window id (mark-type (buffer-mark-type 'top id #f) 'left)