Better layout, with width-tracking

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 ws (list->circular-list (list (list w (relative-size 1)))))
-  (define e (editor g
+  (define e (editor g tty ws w #f default-modeset #f))
-                    tty
-                    (list->circular-list (list (list w (relative-size 1))))
-                    w
-                    #f
-                    default-modeset))
   (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)
+(define (invalidate-layout! editor)
-  (cond [(circular-list-memf (entry-for? window)
+  (set-editor-layout! editor #f))
-                             (editor-windows editor)) => (compose cadr circular-car)]
+
+(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 prev-size (window-size-spec editor prev))
-  (define win-size (window->size-spec editor win))
+  (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"

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 (and spec (absolute-size lines))) rest)
-       (cons (list w offset lines) (loop rest (+ offset lines) remaining))]
+       (cons (layout w spec offset 0 total-width lines)
-      [(cons (list w (relative-size weight)) rest)
+             (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))
+               (list (layout w spec offset 0 total-width remaining))
-               (cons (list w offset height) (loop rest (+ offset height) (- remaining height))))
+               (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 (render-windows! t layouts active-window)
-  (define layout (layout-windows ws (tty-rows t)))
   (tty-body-style t #f)
   (tty-goto t 0 0)
   (define active-cursor-position
-    (for/fold [(cursor-position #f)] [(e layout)]
+    (for/fold [(cursor-position #f)] [(e layouts)]
-      (match-define (list w window-top window-height) e)
+      (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)))

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)