add all-string-snips<%> and all-string-snips-mixin

This is pulled out of DrRacket, mostly just to be able to add test cases
This commit is contained in:
Robby Findler 2015-05-09 11:17:54 -05:00
parent d9fd94f608
commit ab998c9f53
5 changed files with 178 additions and 1 deletions

View File

@ -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.

View File

@ -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

View File

@ -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%))

View File

@ -30,4 +30,4 @@
(define pkg-authors '(mflatt robby))
(define version "1.10")
(define version "1.11")

View File

@ -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