WIP: started adding max-paragraph-width

Author: rfindler

gui-doc/scribblings/framework/text.scrbl

@@ -352,6 +352,25 @@
   preference changes.
 }
 
+@definterface[text:max-paragraph-width<%> ()]{
+
+ Text objects implementing this interface track the width of
+ the widest line.
+
+ @defmethod[#:mode public-final (get-max-width-paragraph) natural?]{
+  Returns the index of the widest paragraph, i.e. the value of
+  @racket[para] that maximizes the expression
+  @racketblock[(- (#,(method text% paragraph-end-position) para)
+                  (#,(method text% paragraph-start-position) para))]
+
+  }
+ @history[#:added "1.78"]
+}
+
+@defmixin[text:max-paragraph-width-mixin (text%) (text:max-paragraph-width<%>)]{
+ @history[#:added "1.78"]
+}
+
 @definterface[text:ascii-art-enlarge-boxes<%> ()]{
  @defmethod[(set-ascii-art-enlarge [e? any/c]) void?]{
   Enables or disables the ascii art box enlarging mode based on @racket[e?]'s true value.

gui-lib/framework/private/sig.rkt

@@ -186,6 +186,7 @@
    (open text-first-line^)
    (open text-inline-overview^)
    (open text-indent-guides^)
+   (open text-max-width-paragraph^)
    (open text-mixed-in-classes^)))
 
 (define-signature text^ extends text-class^

gui-lib/framework/private/text-inline-overview.rkt

@@ -23,8 +23,10 @@
 
 (define-unit text-inline-overview@
   (import mred^
-          [prefix color-prefs: framework:color-prefs^])
+          [prefix color-prefs: framework:color-prefs^]
+          [prefix text: text-max-width-paragraph^])
   (export text-inline-overview^)
+  (init-depend text-max-width-paragraph^)
 
   (define transparent-color (make-object color% 255 255 255 0))
   (define extra-blue-parts-margin 10)
@@ -35,8 +37,13 @@
                                set-inline-overview-enabled?
                                is-inline-overview-work-pending?
                                ))
-  (define inline-overview-mixin
-    (mixin ((class->interface text%)) (inline-overview<%>)
+
+  (define (inline-overview-mixin super%)
+    (inline-overview-mpw-mixin
+     (text:max-width-paragraph-mixin super%)))
+
+  (define inline-overview-mpw-mixin
+    (mixin ((class->interface text%) text:max-width-paragraph<%>) (inline-overview<%>)
       (define is-do-a-little-work-enqueued? #f)
       (define invalid-start #f)
       (define invalid-end #f)
@@ -78,7 +85,7 @@
           (set! known-blank 0))
         (union-invalid 0 h)
         (maybe-queue-do-a-little-work?))
-    
+
       (define/public (get-primary-bmp) primary-bmp)
       (define/public (get-secondary-bmp) secondary-bmp)
 
@@ -92,6 +99,14 @@
         (inner (void) after-load-file success?)
         (set! loading-file? #f)
         (reset-entire-overview))
+
+      (define/augment (after-max-width-paragraph-change)
+        (when enabled?
+          ;; avoid churn if someone is deleting, say, one
+          ;; character at a time from the widest line
+          (unless (<= (abs (- (get-max-width-paragraph) bmp-width)) 10)
+            (reset-entire-overview)))
+        (inner (void) after-max-width-paragraph-change))
 
       (define/augment (after-insert start len)
         (inner (void) after-insert start len)
@@ -411,7 +426,8 @@
                set-position
                scroll-editor-to
                begin-edit-sequence
-               end-edit-sequence)
+               end-edit-sequence
+               get-max-width-paragraph)
 
       (define/private (xy-to-paragraph x y)
         (position-paragraph (find-position x y)))
@@ -438,11 +454,8 @@
         (set! invalid-end #f))
 
       (define/private (update-bmp-width ps pe)
-        ;; initialize this to `1` so that we always have a non-empty bitmap
-        (define text-width 1)
-        (for ([i (in-range ps (+ 1 pe))])
-          (define w (- (paragraph-end-position i) (paragraph-start-position i)))
-          (set! text-width (max text-width w)))
+        ;; use `max` to ensure that we always have a non-empty bitmap
+        (define text-width (max 1 (get-max-width-paragraph)))
         (when (> text-width bmp-width)
           (set! bmp-width (min maximum-bitmap-width (+ 20 text-width))))
         (when (or (not scratch-string)

gui-lib/framework/private/text-max-width-paragraph.rkt

@@ -0,0 +1,102 @@
+#lang racket/base
+
+(require racket/class
+         "sig.rkt"
+         mred/mred-sig
+         racket/unit
+         "text-sig.rkt")
+
+(provide text-max-width-paragraph@)
+
+(define-unit text-max-width-paragraph@
+  (import mred^
+          text-basic^
+          [prefix editor: framework:editor^]
+          [prefix frame: framework:frame^])
+  (export text-max-width-paragraph^)
+
+  (define max-width-paragraph<%>
+    (interface ()
+      get-max-width-paragraph
+      after-max-width-paragraph-change))
+
+  (define max-width-paragraph-mixin
+    (mixin ((class->interface text%)) (max-width-paragraph<%>)
+      (inherit last-paragraph
+               paragraph-end-position
+               paragraph-start-position
+               position-paragraph)
+
+      (define max-width-paragraph #f)
+      (define max-width #f)
+
+      (define/public-final (get-max-width-paragraph)
+        (unless max-width-paragraph
+          (calc-max-width-paragraph))
+        max-width-paragraph)
+
+      (define/private (set-max-widths _max-width-paragraph _max-width)
+        (printf "set-max-widths\n")
+        (set! max-width-paragraph _max-width-paragraph)
+        (set! max-width _max-width)
+        (after-max-width-paragraph-change))
+      
+      (define/augment (after-insert start len)
+        (inner (void) after-insert start len)
+        (define insert-start-para (position-paragraph start))
+        (define insert-end-para (position-paragraph (+ start len)))
+        (when max-width-paragraph
+          (cond
+            [(< insert-start-para insert-end-para)
+             ;; multi-paragraph insertion, just give up on the cache
+             (set-max-widths #f #f)]
+            [(= insert-start-para max-width-paragraph)
+             ;; we made the max paragraph wider
+             (set-max-widths insert-start-para (get-paragraph-width max-width-paragraph))]
+            [else
+             ;; made some other paragraph wider
+             (define paragraph-new-width (get-paragraph-width insert-start-para))
+             ;; if it got wider than the previous max one or the same but earlier
+             ;; in the file, it is the new widest
+             (when (or (and (= max-width paragraph-new-width)
+                            (< insert-start-para max-width-paragraph))
+                       (< max-width paragraph-new-width))
+             (set-max-widths insert-start-para
+                             paragraph-new-width))])))
+
+      (define/augment (on-delete start len)
+        (inner (void) on-delete start len)
+        (define delete-start-para (position-paragraph start))
+        (define delete-end-para (position-paragraph (+ start len)))
+        (when max-width-paragraph
+          (cond
+            [(< delete-start-para delete-end-para)
+             ;; multi-paragraph deletion, just give up on the cache
+             (set-max-widths #f #f)]
+            [(= delete-start-para max-width-paragraph)
+             ;; we made the max paragraph narrower
+             (set-max-widths #f #f)]
+            [else
+             ;; made some other paragraph narrower
+             (void)])))
+
+      (define/private (get-paragraph-width para)
+        (- (paragraph-end-position para)
+           (paragraph-start-position para)))
+        
+      (define/private (calc-max-width-paragraph)
+        (set!-values
+         (max-width max-width-paragraph)
+         (for/fold ([width 0]
+                    [para-with-max-width 0])
+                   ([this-para (in-inclusive-range 0 (last-paragraph))])
+           (define this-width (get-paragraph-width this-para))
+           (cond
+             [(<= this-width width)
+              (values width para-with-max-width)]
+             [else
+              (values this-width this-para)]))))
+
+      (define/pubment (after-max-width-paragraph-change)
+        (inner (void) after-max-width-paragraph-change))
+      (super-new))))

gui-lib/framework/private/text-sig.rkt

@@ -12,6 +12,7 @@
          text-column-guide^
          text-ascii-art^
          text-misc^
+         text-max-width-paragraph^
          text-delegate^
          text-port^
          text-port-class^
@@ -95,7 +96,8 @@
 
 (define-signature text-inline-overview^
   (inline-overview<%>
-   inline-overview-mixin))
+   inline-overview-mixin
+   inline-overview-mpw-mixin))
 
 (define-signature text-first-line^
   (first-line<%>
@@ -125,6 +127,10 @@
    overwrite-disable<%>
    overwrite-disable-mixin))
 
+(define-signature text-max-width-paragraph^
+  (max-width-paragraph-mixin
+   max-width-paragraph<%>))
+
 (define-signature text-mixed-in-classes^
   (basic%
    line-spacing%

gui-lib/framework/private/text.rkt

@@ -16,6 +16,7 @@
          "text-port.rkt"
          "text-search.rkt"
          "text-inline-overview.rkt"
+         "text-max-width-paragraph.rkt"
          "text-sig.rkt"
          "srcloc-snip.rkt"
          "sig.rkt")
@@ -48,14 +49,16 @@
           text-misc^
           text-normalize-paste^
           text-port^
-          text-search^)
+          text-search^
+          text-max-width-paragraph^)
 
   (link text-ascii-art@
         text-autocomplete@
         text-basic@
         text-column-guide@
         text-delegate@
         text-first-line@
+        text-max-width-paragraph@
         text-inline-overview@
         text-line-numbers@
         text-indent-guides@
@@ -90,6 +93,7 @@
     text-line-numbers^
     text-indent-guides^
     text-misc^
+    text-max-width-paragraph^
     text-normalize-paste^
     text-port^
     text-search^)

gui-lib/info.rkt

@@ -35,7 +35,7 @@
 
 (define pkg-authors '(mflatt robby))
 
-(define version "1.77")
+(define version "1.78")
 
 (define license
   '(Apache-2.0 OR MIT))

gui-test/framework/tests/text.rkt

@@ -20,7 +20,8 @@
     (move/copy-to-edit-tests)
     (move/copy-to-edit-random-tests)
     (ascii-art-tests)
-    (autocomplete-tests)))
+    (autocomplete-tests)
+    (get-max-width-paragraph-tests)))
 
 (define (highlight-range-tests)
   (check-equal?
@@ -1147,3 +1148,78 @@
                         [key-code #\return]))
 
   (check-equal? (send t get-text) "pqr abcd xyz"))
+
+(define (get-max-width-paragraph-tests)
+  (struct ins (str pos) #:transparent)
+
+  (define (calc-widest t)
+    (define-values (widest-para widest-width)
+      (for/fold ([widest-para 0]
+                 [widest-width 0])
+                ([para (in-inclusive-range 0 (send t last-paragraph))])
+        (define this-width (- (send t paragraph-end-position para)
+                              (send t paragraph-start-position para)))
+        (cond
+          [(<= this-width widest-width)
+           (values widest-para widest-width)]
+          [else
+           (values para this-width)])))
+    widest-para)
+
+  (define (try loins)
+    (define t (new (text:max-width-paragraph-mixin text:basic%)))
+    (for ([a-ins (in-list loins)])
+      (match-define (ins str pos) a-ins)
+      (send t insert str pos))
+    (define should-be (calc-widest t))
+    (define is (send t get-max-width-paragraph))
+    (unless (equal? should-be is)
+      (eprintf "test failed; got ~s expected ~s\n" is should-be)
+      (pretty-print loins (current-error-port))
+      (eprintf "~s\n" (send t get-text))))
+
+  (try '())
+  (try (list (ins "a" 0)))
+  (try (list (ins "a" 0)
+             (ins "\n" 0)
+             (ins "aa" 0)))
+  (try (list (ins "aaaa" 0)
+             (ins "\n" 0)
+             (ins "aa" 0)))
+  (try (list (ins "aaaa" 0)
+             (ins "\n" 4)
+             (ins "aa" 5)))
+  (try (list (ins "aaaa" 0)
+             (ins "\n" 4)
+             (ins "aa" 5)
+             (ins "a" 0)))
+
+  (define (mk)
+    (let loop ([s 0])
+      (cond
+        [(zero? (random 10)) '()]
+        [else
+         (define str
+           (make-string (+ (random 3) 1)
+                        (case (random 4)
+                          [(0) #\a]
+                          [(1) #\b]
+                          [(2) #\c]
+                          [(3) #\newline])))
+         (cons (ins str (random (+ s 1)))
+               (loop (+ s (string-length str))))])))
+
+  (for ([i (in-range 100)])
+    (try (mk)))
+
+  (let ()
+    (define mw #f)
+    (define t (new (class (text:max-width-paragraph-mixin text:basic%)
+                     (inherit get-max-width-paragraph)
+                     (define/augment (after-max-width-paragraph-change)
+                       (printf "called\n")
+                       (set! mw (get-max-width-paragraph)))
+                     (super-new))))
+    (send t insert "a")
+    (check-equal? mw 0))
+  )