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:
parent
d9fd94f608
commit
ab998c9f53
|
@ -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.
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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%))
|
||||
|
|
|
@ -30,4 +30,4 @@
|
|||
|
||||
(define pkg-authors '(mflatt robby))
|
||||
|
||||
(define version "1.10")
|
||||
(define version "1.11")
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue
Block a user