diff --git a/gui-doc/scribblings/framework/text.scrbl b/gui-doc/scribblings/framework/text.scrbl index 0090ca8d..1354bcf7 100644 --- a/gui-doc/scribblings/framework/text.scrbl +++ b/gui-doc/scribblings/framework/text.scrbl @@ -477,6 +477,33 @@ } } +@definterface[text:all-string-snips<%> ()]{ + @defmethod[(all-string-snips?) boolean?]{ + Returns @racket[#t] if all of the snips in the @racket[text%] object + are @racket[string-snip%]s. + + This method usually returns quickly, tracking changes to the editor + to update internal state. But if a non-@racket[string-snip%] is deleted, + then the next call to @method[text:all-string-snips<%> all-string-snips?] + traverses the entire content to search to see if there are other + non-@racket[string-snip%]s. + } +} + +@defmixin[text:all-string-snips-mixin (text%) (text:all-string-snips<%>)]{ + @defmethod[#:mode augment (on-insert [start exact-nonnegative-integer?] + [len exact-nonnegative-integer?]) void?]{ + Checks to see if there were any non-@racket[string-snip%]s inserted + in the given range and, if so, updates the internal state. + } + + @defmethod[#:mode augment (after-delete [start exact-nonnegative-integer?] + [len exact-nonnegative-integer?]) void?]{ + Checks to see if there were any non-@racket[string-snip%]s deleted + in the given range and, if so, updates the internal state. + } +} + @definterface[text:searching<%> (editor:keymap<%> text:basic<%>)]{ Any object matching this interface can be searched. diff --git a/gui-lib/framework/private/sig.rkt b/gui-lib/framework/private/sig.rkt index 0c2ed285..ec1cb273 100644 --- a/gui-lib/framework/private/sig.rkt +++ b/gui-lib/framework/private/sig.rkt @@ -188,6 +188,7 @@ nbsp->space<%> column-guide<%> normalize-paste<%> + all-string-snips<%> delegate<%> wide-snip<%> searching<%> @@ -229,6 +230,7 @@ nbsp->space-mixin column-guide-mixin normalize-paste-mixin + all-string-snips-mixin wide-snip-mixin delegate-mixin searching-mixin diff --git a/gui-lib/framework/private/text.rkt b/gui-lib/framework/private/text.rkt index 9ebba035..59b36723 100644 --- a/gui-lib/framework/private/text.rkt +++ b/gui-lib/framework/private/text.rkt @@ -4494,6 +4494,62 @@ designates the character that triggers autocompletion (define-struct saved-dc-state (smoothing pen brush font text-foreground-color text-mode)) (define padding-dc (new bitmap-dc% [bitmap (make-screen-bitmap 1 1)])) +(define all-string-snips<%> + (interface () + all-string-snips?)) + +(define all-string-snips-mixin + (mixin ((class->interface text%)) (all-string-snips<%>) + (inherit find-first-snip find-snip) + + (define/private (all-string-snips?/slow) + (let loop ([s (find-first-snip)]) + (cond + [(not s) #t] + [(is-a? s string-snip%) (loop (send s next))] + [else #f]))) + + (define/augment (after-insert start end) + (inner (void) after-insert start end) + + (when (equal? all-string-snips-state #t) + (let loop ([s (find-snip start 'after-or-none)] + [i start]) + (cond + [(not s) (void)] + [(not (< i end)) (void)] + [(is-a? s string-snip%) + (define size (send s get-count)) + (loop (send s next) (+ i size))] + [else (set! all-string-snips-state #f)])))) + + (define/augment (on-delete start end) + (inner (void) on-delete start end) + (when (equal? all-string-snips-state #f) + (let loop ([s (find-snip start 'after-or-none)] + [i start]) + (cond + [(not s) (void)] + [(not (< i end)) (void)] + [(is-a? s string-snip%) + (define size (send s get-count)) + (loop (send s next) (+ i size))] + [else (set! all-string-snips-state 'dont-know)])))) + + + ;; (or/c #t #f 'dont-know) + (define all-string-snips-state #t) + (define/public (all-string-snips?) + (cond + [(boolean? all-string-snips-state) + all-string-snips-state] + [else + (define all-string-snips? (all-string-snips?/slow)) + (set! all-string-snips-state all-string-snips?) + all-string-snips?])) + + (super-new))) + (define basic% (basic-mixin (editor:basic-mixin text%))) (define line-spacing% (line-spacing-mixin basic%)) (define hide-caret/selection% (hide-caret/selection-mixin line-spacing%)) diff --git a/gui-lib/info.rkt b/gui-lib/info.rkt index 793ea534..3a2b76c7 100644 --- a/gui-lib/info.rkt +++ b/gui-lib/info.rkt @@ -30,4 +30,4 @@ (define pkg-authors '(mflatt robby)) -(define version "1.10") +(define version "1.11") diff --git a/gui-test/framework/tests/text.rkt b/gui-test/framework/tests/text.rkt index 0117c76a..aee64497 100644 --- a/gui-test/framework/tests/text.rkt +++ b/gui-test/framework/tests/text.rkt @@ -252,6 +252,98 @@ (and (false? pos) (is-a? edit pasteboard%))))))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; all-string-snips<%> +;; + +(test + 'all-string-snips<%>.1 + (λ (x) (equal? x #t)) + (λ () + (queue-sexp-to-mred + '(let () + (define t (new (text:all-string-snips-mixin text%))) + (send t all-string-snips?))))) + +(test + 'all-string-snips<%>.2 + (λ (x) (equal? x #t)) + (λ () + (queue-sexp-to-mred + '(let () + (define t (new (text:all-string-snips-mixin text%))) + (send t insert "xx") + (send t all-string-snips?))))) + +(test + 'all-string-snips<%>.3 + (λ (x) (equal? x #t)) + (λ () + (queue-sexp-to-mred + '(let () + (define t (new (text:all-string-snips-mixin text%))) + (send t insert "xx") + (send t delete 0 1) + (send t all-string-snips?))))) + +(test + 'all-string-snips<%>.4 + (λ (x) (equal? x #t)) + (λ () + (queue-sexp-to-mred + '(let () + (define t (new (text:all-string-snips-mixin text%))) + (send t insert "xx") + (send t delete 0 2) + (send t all-string-snips?))))) + +(test + 'all-string-snips<%>.5 + (λ (x) (equal? x #f)) + (λ () + (queue-sexp-to-mred + '(let () + (define t (new (text:all-string-snips-mixin text%))) + (send t insert (new snip%)) + (send t all-string-snips?))))) + +(test + 'all-string-snips<%>.6 + (λ (x) (equal? x #t)) + (λ () + (queue-sexp-to-mred + '(let () + (define t (new (text:all-string-snips-mixin text%))) + (send t insert (new snip%)) + (send t delete 0 1) + (send t all-string-snips?))))) + +(test + 'all-string-snips<%>.7 + (λ (x) (equal? x #f)) + (λ () + (queue-sexp-to-mred + '(let () + (define t (new (text:all-string-snips-mixin text%))) + (send t insert (new snip%)) + (send t insert (new snip%)) + (send t delete 0 1) + (send t all-string-snips?))))) + +(test + 'all-string-snips<%>.8 + (λ (x) (equal? x #f)) + (λ () + (queue-sexp-to-mred + '(let () + (define t (new (text:all-string-snips-mixin text%))) + (send t insert (new snip%)) + (send t insert "abcdef") + (send t insert (new snip%)) + (send t delete 2 4) + (send t all-string-snips?))))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; print-to-dc