racket/gui: fix some concurrency problems `text%'
Changed `open-output-text-editor' to put its additions into an edit sequence to better work with threads. Fixed problems in editor-canvas refresh and resize events, where the editor's refresh synchronization wasn't used properly. Fixed race conditions in the the protocol that is used to separate refreshes and edit sequences. Related to PR 12749
This commit is contained in:
parent
1fae7942d5
commit
48f7ddafe4
|
@ -322,7 +322,9 @@
|
||||||
(define raw-buffer (make-bytes 128))
|
(define raw-buffer (make-bytes 128))
|
||||||
(define utf8-buffer (make-bytes 128))
|
(define utf8-buffer (make-bytes 128))
|
||||||
(define (show s)
|
(define (show s)
|
||||||
|
(send text begin-edit-sequence)
|
||||||
(send text insert s pos)
|
(send text insert s pos)
|
||||||
|
(send text end-edit-sequence)
|
||||||
(set! pos (+ (string-length s) pos)))
|
(set! pos (+ (string-length s) pos)))
|
||||||
(define (flush-text)
|
(define (flush-text)
|
||||||
(let ([cnt (peek-bytes-avail!* raw-buffer 0 #f in)])
|
(let ([cnt (peek-bytes-avail!* raw-buffer 0 #f in)])
|
||||||
|
|
|
@ -294,12 +294,14 @@
|
||||||
(unless noloop?
|
(unless noloop?
|
||||||
(unless (and media
|
(unless (and media
|
||||||
(send media get-printing))
|
(send media get-printing))
|
||||||
|
(begin-refresh-sequence)
|
||||||
(let-boxes ([w 0]
|
(let-boxes ([w 0]
|
||||||
[h 0])
|
[h 0])
|
||||||
(get-size w h)
|
(get-size w h)
|
||||||
(unless (and (= w lastwidth)
|
(unless (and (= w lastwidth)
|
||||||
(= h lastheight))
|
(= h lastheight))
|
||||||
(reset-size))))))
|
(reset-size)))
|
||||||
|
(end-refresh-sequence))))
|
||||||
|
|
||||||
(define/private (reset-size)
|
(define/private (reset-size)
|
||||||
(reset-visual #f)
|
(reset-visual #f)
|
||||||
|
@ -514,9 +516,7 @@
|
||||||
(set! need-refresh? #f)
|
(set! need-refresh? #f)
|
||||||
(if media
|
(if media
|
||||||
(when (not (send media get-printing))
|
(when (not (send media get-printing))
|
||||||
(let-boxes ([x 0][y 0][w 0][h 0])
|
(redraw 'view 'view 'view 'view #f))
|
||||||
(get-view x y w h)
|
|
||||||
(redraw x y w h #f)))
|
|
||||||
(let ([bg (get-canvas-background)])
|
(let ([bg (get-canvas-background)])
|
||||||
(when bg
|
(when bg
|
||||||
(let ([adc (get-dc)])
|
(let ([adc (get-dc)])
|
||||||
|
@ -607,44 +607,50 @@
|
||||||
(when (and media
|
(when (and media
|
||||||
(not (send media get-printing)))
|
(not (send media get-printing)))
|
||||||
(begin-refresh-sequence)
|
(begin-refresh-sequence)
|
||||||
(when clear?
|
(let-values ([(localx localy fw fh)
|
||||||
(let ([bg (get-canvas-background)])
|
(if (eq? localx 'view)
|
||||||
(when bg
|
(let-boxes ([x 0][y 0][w 0][h 0])
|
||||||
(let ([adc (get-dc)])
|
(get-view x y w h)
|
||||||
(let ([b (send adc get-brush)]
|
(values x y w h))
|
||||||
[p (send adc get-pen)])
|
(values localx localy fw fh))])
|
||||||
(send adc set-brush bg 'solid)
|
(when clear?
|
||||||
(send adc set-pen bg 1 'transparent)
|
(let ([bg (get-canvas-background)])
|
||||||
(send adc draw-rectangle localx localy fw fh)
|
(when bg
|
||||||
(send adc set-brush b)
|
(let ([adc (get-dc)])
|
||||||
(send adc set-pen p))))))
|
(let ([b (send adc get-brush)]
|
||||||
(let ([x (box 0)]
|
[p (send adc get-pen)])
|
||||||
[y (box 0)]
|
(send adc set-brush bg 'solid)
|
||||||
[w (box 0)]
|
(send adc set-pen bg 1 'transparent)
|
||||||
[h (box 0)])
|
(send adc draw-rectangle localx localy fw fh)
|
||||||
(get-view x y w h)
|
(send adc set-brush b)
|
||||||
(let ([x (unbox x)]
|
(send adc set-pen p))))))
|
||||||
[y (unbox y)]
|
(let ([x (box 0)]
|
||||||
[w (unbox w)]
|
[y (box 0)]
|
||||||
[h (unbox h)])
|
[w (box 0)]
|
||||||
(let ([right (+ x w)]
|
[h (box 0)])
|
||||||
[bottom (+ y h)])
|
(get-view x y w h)
|
||||||
(let ([x (max x localx)]
|
(let ([x (unbox x)]
|
||||||
[y (max y localy)]
|
[y (unbox y)]
|
||||||
[right (min right (+ localx fw))]
|
[w (unbox w)]
|
||||||
[bottom (min bottom (+ localy fh))])
|
[h (unbox h)])
|
||||||
(let ([w (max 0 (- right x))]
|
(let ([right (+ x w)]
|
||||||
[h (max 0 (- bottom y))])
|
[bottom (+ y h)])
|
||||||
(when (or (positive? w)
|
(let ([x (max x localx)]
|
||||||
(positive? h))
|
[y (max y localy)]
|
||||||
(using-admin
|
[right (min right (+ localx fw))]
|
||||||
(when media
|
[bottom (min bottom (+ localy fh))])
|
||||||
(send media refresh
|
(let ([w (max 0 (- right x))]
|
||||||
x y w h
|
[h (max 0 (- bottom y))])
|
||||||
(if (or focuson? focusforcedon?)
|
(when (or (positive? w)
|
||||||
'show-caret
|
(positive? h))
|
||||||
'show-inactive-caret)
|
(using-admin
|
||||||
(get-canvas-background))))))))))
|
(when media
|
||||||
|
(send media refresh
|
||||||
|
x y w h
|
||||||
|
(if (or focuson? focusforcedon?)
|
||||||
|
'show-caret
|
||||||
|
'show-inactive-caret)
|
||||||
|
(get-canvas-background)))))))))))
|
||||||
(end-refresh-sequence)))
|
(end-refresh-sequence)))
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -1380,9 +1380,12 @@
|
||||||
(semaphore-post seq-lock))
|
(semaphore-post seq-lock))
|
||||||
|
|
||||||
(def/public (wait-sequence-lock)
|
(def/public (wait-sequence-lock)
|
||||||
(when seq-lock
|
(cond
|
||||||
|
[seq-lock
|
||||||
(sync seq-lock)
|
(sync seq-lock)
|
||||||
(semaphore-post seq-lock)))
|
(lambda ()
|
||||||
|
(semaphore-post seq-lock))]
|
||||||
|
[else void]))
|
||||||
|
|
||||||
(def/public (get-file [(make-or-false path-string?) path])
|
(def/public (get-file [(make-or-false path-string?) path])
|
||||||
(editor-get-file "choose a file" (extract-parent) #f path))
|
(editor-get-file "choose a file" (extract-parent) #f path))
|
||||||
|
|
|
@ -1986,14 +1986,15 @@
|
||||||
;; ----------------------------------------
|
;; ----------------------------------------
|
||||||
|
|
||||||
(def/override (begin-edit-sequence [any? [undoable? #t]] [any? [interrupt-seqs? #t]])
|
(def/override (begin-edit-sequence [any? [undoable? #t]] [any? [interrupt-seqs? #t]])
|
||||||
(wait-sequence-lock)
|
(define ready! (wait-sequence-lock))
|
||||||
(when (or (positive? s-noundomode)
|
(when (or (positive? s-noundomode)
|
||||||
(not undoable?))
|
(not undoable?))
|
||||||
(set! s-noundomode (add1 s-noundomode)))
|
(set! s-noundomode (add1 s-noundomode)))
|
||||||
(when (and (zero? sequence)
|
(when (and (zero? sequence)
|
||||||
(zero? write-locked))
|
(zero? write-locked))
|
||||||
(on-edit-sequence))
|
(on-edit-sequence))
|
||||||
(set! sequence (add1 sequence)))
|
(set! sequence (add1 sequence))
|
||||||
|
(ready!))
|
||||||
|
|
||||||
(def/override (end-edit-sequence)
|
(def/override (end-edit-sequence)
|
||||||
(set! sequence (sub1 sequence))
|
(set! sequence (sub1 sequence))
|
||||||
|
|
|
@ -66,6 +66,8 @@
|
||||||
|
|
||||||
(define-struct clickback (start end f call-on-down? delta hilited? unhilite) #:mutable)
|
(define-struct clickback (start end f call-on-down? delta hilited? unhilite) #:mutable)
|
||||||
|
|
||||||
|
(define in-delayed-refresh (make-parameter #f))
|
||||||
|
|
||||||
(defclass text% editor%
|
(defclass text% editor%
|
||||||
(inherit-field s-admin
|
(inherit-field s-admin
|
||||||
s-offscreen
|
s-offscreen
|
||||||
|
@ -291,6 +293,8 @@
|
||||||
(define refresh-r 0.0) ; can be 'display-end
|
(define refresh-r 0.0) ; can be 'display-end
|
||||||
(define refresh-b 0.0) ; can be 'display-end
|
(define refresh-b 0.0) ; can be 'display-end
|
||||||
|
|
||||||
|
(define refresh-box-lock (make-semaphore 1)) ; protects refresh-{l,t,r,b} and refresh-box-unset?
|
||||||
|
|
||||||
(define last-draw-l 0.0)
|
(define last-draw-l 0.0)
|
||||||
(define last-draw-t 0.0)
|
(define last-draw-t 0.0)
|
||||||
(define last-draw-r 0.0)
|
(define last-draw-r 0.0)
|
||||||
|
@ -729,7 +733,7 @@
|
||||||
;; ----------------------------------------
|
;; ----------------------------------------
|
||||||
|
|
||||||
(def/override (begin-edit-sequence [any? [undoable? #t]] [any? [interrupt-seqs? #t]])
|
(def/override (begin-edit-sequence [any? [undoable? #t]] [any? [interrupt-seqs? #t]])
|
||||||
(wait-sequence-lock)
|
(define ready! (wait-sequence-lock))
|
||||||
|
|
||||||
(when (and (zero? delay-refresh)
|
(when (and (zero? delay-refresh)
|
||||||
(not interrupt-seqs?))
|
(not interrupt-seqs?))
|
||||||
|
@ -747,34 +751,38 @@
|
||||||
(set! need-x-copy? #t))
|
(set! need-x-copy? #t))
|
||||||
(set! delay-refresh 1)
|
(set! delay-refresh 1)
|
||||||
(on-edit-sequence))
|
(on-edit-sequence))
|
||||||
(set! delay-refresh (add1 delay-refresh))))
|
(set! delay-refresh (add1 delay-refresh)))
|
||||||
|
|
||||||
|
(ready!))
|
||||||
|
|
||||||
(def/override (end-edit-sequence)
|
(def/override (end-edit-sequence)
|
||||||
(if (zero? delay-refresh)
|
(if (zero? delay-refresh)
|
||||||
(log-error "end-edit-sequence without begin-edit-sequence")
|
(log-error "end-edit-sequence without begin-edit-sequence")
|
||||||
(begin
|
(let ([new-delay-refresh (sub1 delay-refresh)])
|
||||||
(set! delay-refresh (sub1 delay-refresh))
|
(when (zero? new-delay-refresh)
|
||||||
(when (zero? delay-refresh)
|
|
||||||
(end-streaks null)
|
(end-streaks null)
|
||||||
(pop-streaks)
|
(pop-streaks)
|
||||||
(redraw)
|
(parameterize ([in-delayed-refresh #t])
|
||||||
|
(redraw))
|
||||||
(when ALLOW-X-STYLE-SELECTION?
|
(when ALLOW-X-STYLE-SELECTION?
|
||||||
(set! need-x-copy? #f))
|
(set! need-x-copy? #f))
|
||||||
(after-edit-sequence))
|
(after-edit-sequence)
|
||||||
(when (positive? s-noundomode)
|
(when (positive? s-noundomode)
|
||||||
(set! s-noundomode (sub1 s-noundomode)))
|
(set! s-noundomode (sub1 s-noundomode)))
|
||||||
(when (and (zero? delay-refresh)
|
(when s-need-on-display-size?
|
||||||
s-need-on-display-size?)
|
(set! s-need-on-display-size? #f)
|
||||||
(set! s-need-on-display-size? #f)
|
(on-display-size)))
|
||||||
(on-display-size)))))
|
(set! delay-refresh new-delay-refresh))))
|
||||||
|
|
||||||
(def/override (refresh-delayed?)
|
(def/override (refresh-delayed?)
|
||||||
(or (delay-refresh . > . 0)
|
(or (and (delay-refresh . > . 0)
|
||||||
|
(not (in-delayed-refresh)))
|
||||||
(not s-admin)
|
(not s-admin)
|
||||||
(send s-admin refresh-delayed?)))
|
(send s-admin refresh-delayed?)))
|
||||||
|
|
||||||
(def/override-final (in-edit-sequence?)
|
(def/override-final (in-edit-sequence?)
|
||||||
(delay-refresh . > . 0))
|
(and (delay-refresh . > . 0)
|
||||||
|
(not (in-delayed-refresh))))
|
||||||
|
|
||||||
(def/override (locations-computed?)
|
(def/override (locations-computed?)
|
||||||
(not graphic-maybe-invalid?))
|
(not graphic-maybe-invalid?))
|
||||||
|
@ -850,7 +858,8 @@
|
||||||
(when (or (= end start)
|
(when (or (= end start)
|
||||||
(not (eq? editor-x-selection-allowed this))
|
(not (eq? editor-x-selection-allowed this))
|
||||||
(eq? 'local seltype))
|
(eq? 'local seltype))
|
||||||
(when (or (zero? delay-refresh) need-x-copy?)
|
(when (or (not (in-edit-sequence?))
|
||||||
|
need-x-copy?)
|
||||||
(set! need-x-copy? #f)
|
(set! need-x-copy? #f)
|
||||||
(copy-out-x-selection))))
|
(copy-out-x-selection))))
|
||||||
|
|
||||||
|
@ -931,7 +940,7 @@
|
||||||
(not flow-locked?)
|
(not flow-locked?)
|
||||||
(let ([end (if (eq? end 'same) start (max start end))])
|
(let ([end (if (eq? end 'same) start (max start end))])
|
||||||
(cond
|
(cond
|
||||||
[(positive? delay-refresh)
|
[(in-edit-sequence?)
|
||||||
(when s-admin
|
(when s-admin
|
||||||
(set! delayedscrollbox? #f)
|
(set! delayedscrollbox? #f)
|
||||||
(set! delayedscroll start)
|
(set! delayedscroll start)
|
||||||
|
@ -1282,13 +1291,13 @@
|
||||||
(start . < . end)
|
(start . < . end)
|
||||||
(begin
|
(begin
|
||||||
(when ALLOW-X-STYLE-SELECTION?
|
(when ALLOW-X-STYLE-SELECTION?
|
||||||
(when (zero? delay-refresh)
|
(when (not (in-edit-sequence?))
|
||||||
(set! need-x-copy? #t)))
|
(set! need-x-copy? #t)))
|
||||||
(when (or isnip str snipsl)
|
(when (or isnip str snipsl)
|
||||||
(begin-edit-sequence))
|
(begin-edit-sequence))
|
||||||
(delete start end scroll-ok?)
|
(delete start end scroll-ok?)
|
||||||
(when ALLOW-X-STYLE-SELECTION?
|
(when ALLOW-X-STYLE-SELECTION?
|
||||||
(when (zero? delay-refresh)
|
(when (not (in-edit-sequence?))
|
||||||
(set! need-x-copy? #f)))
|
(set! need-x-copy? #f)))
|
||||||
#t))])
|
#t))])
|
||||||
(when (or isnip str snipsl)
|
(when (or isnip str snipsl)
|
||||||
|
@ -1310,7 +1319,7 @@
|
||||||
insert-force-streak?
|
insert-force-streak?
|
||||||
(not s-modified?))
|
(not s-modified?))
|
||||||
startpos endpos)))
|
startpos endpos)))
|
||||||
(when (positive? delay-refresh)
|
(when (in-edit-sequence?)
|
||||||
(set! delayed-streak? #t))
|
(set! delayed-streak? #t))
|
||||||
|
|
||||||
(let ([scroll? (= start startpos)])
|
(let ([scroll? (= start startpos)])
|
||||||
|
@ -1335,7 +1344,8 @@
|
||||||
|
|
||||||
(when (and scroll? scroll-ok?)
|
(when (and scroll? scroll-ok?)
|
||||||
(set! delay-refresh (add1 delay-refresh))
|
(set! delay-refresh (add1 delay-refresh))
|
||||||
(scroll-to-position/refresh startpos)
|
(parameterize ([in-delayed-refresh #f])
|
||||||
|
(scroll-to-position/refresh startpos))
|
||||||
(set! delay-refresh (sub1 delay-refresh)))
|
(set! delay-refresh (sub1 delay-refresh)))
|
||||||
|
|
||||||
(set! changed? #t)
|
(set! changed? #t)
|
||||||
|
@ -1808,7 +1818,8 @@
|
||||||
(let ([end (min end len)])
|
(let ([end (min end len)])
|
||||||
(when ALLOW-X-STYLE-SELECTION?
|
(when ALLOW-X-STYLE-SELECTION?
|
||||||
(when (and (start . <= . startpos) (end . >= . endpos))
|
(when (and (start . <= . startpos) (end . >= . endpos))
|
||||||
(when (or (zero? delay-refresh) need-x-copy?)
|
(when (or (not (in-edit-sequence?))
|
||||||
|
need-x-copy?)
|
||||||
(set! need-x-copy? #f)
|
(set! need-x-copy? #f)
|
||||||
(copy-out-x-selection))))
|
(copy-out-x-selection))))
|
||||||
|
|
||||||
|
@ -1949,7 +1960,7 @@
|
||||||
|
|
||||||
(when with-undo?
|
(when with-undo?
|
||||||
(add-undo-rec rec)
|
(add-undo-rec rec)
|
||||||
(when (positive? delay-refresh)
|
(when (in-edit-sequence?)
|
||||||
(set! delayed-streak? #t)))
|
(set! delayed-streak? #t)))
|
||||||
|
|
||||||
(let ([dellen (- end start)])
|
(let ([dellen (- end start)])
|
||||||
|
@ -1990,7 +2001,8 @@
|
||||||
|
|
||||||
(when (and scroll-ok? (= start startpos))
|
(when (and scroll-ok? (= start startpos))
|
||||||
(set! delay-refresh (add1 delay-refresh))
|
(set! delay-refresh (add1 delay-refresh))
|
||||||
(scroll-to-position/refresh startpos)
|
(parameterize ([in-delayed-refresh #f])
|
||||||
|
(scroll-to-position/refresh startpos))
|
||||||
(set! delay-refresh (sub1 delay-refresh)))
|
(set! delay-refresh (sub1 delay-refresh)))
|
||||||
|
|
||||||
(set! changed? #t)
|
(set! changed? #t)
|
||||||
|
@ -3780,7 +3792,7 @@
|
||||||
(add-undo-rec (make-object unmodify-record% delayed-streak?)))
|
(add-undo-rec (make-object unmodify-record% delayed-streak?)))
|
||||||
(when rec
|
(when rec
|
||||||
(add-undo-rec rec))
|
(add-undo-rec rec))
|
||||||
(when (positive? delay-refresh)
|
(when (in-edit-sequence?)
|
||||||
(set! delayed-streak? #t))
|
(set! delayed-streak? #t))
|
||||||
|
|
||||||
(check-merge-snips start)
|
(check-merge-snips start)
|
||||||
|
@ -3902,7 +3914,7 @@
|
||||||
(define/private (do-scroll-to snip localx localy w h refresh? [bias 'none])
|
(define/private (do-scroll-to snip localx localy w h refresh? [bias 'none])
|
||||||
(cond
|
(cond
|
||||||
[flow-locked? #f]
|
[flow-locked? #f]
|
||||||
[(positive? delay-refresh)
|
[(in-edit-sequence?)
|
||||||
(when s-admin
|
(when s-admin
|
||||||
(set! delayedscroll -1)
|
(set! delayedscroll -1)
|
||||||
(set! delayedscrollbox? #t)
|
(set! delayedscrollbox? #t)
|
||||||
|
@ -3962,7 +3974,8 @@
|
||||||
(set! changed? #t)
|
(set! changed? #t)
|
||||||
|
|
||||||
(unless redraw-now? (set! delay-refresh (add1 delay-refresh)))
|
(unless redraw-now? (set! delay-refresh (add1 delay-refresh)))
|
||||||
(refresh-by-line-demand)
|
(parameterize ([in-delayed-refresh #f])
|
||||||
|
(refresh-by-line-demand))
|
||||||
(unless redraw-now? (set! delay-refresh (sub1 delay-refresh))))))
|
(unless redraw-now? (set! delay-refresh (sub1 delay-refresh))))))
|
||||||
|
|
||||||
(def/override (recounted [snip% snip] [any? redraw-now?])
|
(def/override (recounted [snip% snip] [any? redraw-now?])
|
||||||
|
@ -3990,30 +4003,35 @@
|
||||||
#t))))
|
#t))))
|
||||||
|
|
||||||
(define/public (refresh-box L T w h)
|
(define/public (refresh-box L T w h)
|
||||||
(let ([B (if (eq? h 'display-end) h (+ T h))]
|
;; This method can be called while updating is locked out,
|
||||||
[R (if (eq? w 'display-end) w (+ L w))])
|
;; possibly because another thread is in an edit sequence.
|
||||||
(if refresh-box-unset?
|
(call-with-semaphore
|
||||||
(begin
|
refresh-box-lock
|
||||||
(set! refresh-l L)
|
(lambda ()
|
||||||
(set! refresh-r R)
|
(let ([B (if (eq? h 'display-end) h (+ T h))]
|
||||||
(set! refresh-t T)
|
[R (if (eq? w 'display-end) w (+ L w))])
|
||||||
(set! refresh-b B)
|
(if refresh-box-unset?
|
||||||
(set! refresh-box-unset? #f))
|
(begin
|
||||||
(begin
|
(set! refresh-l L)
|
||||||
(when (L . < . refresh-l)
|
(set! refresh-r R)
|
||||||
(set! refresh-l L))
|
(set! refresh-t T)
|
||||||
(unless (eq? refresh-r 'display-end)
|
(set! refresh-b B)
|
||||||
(when (or (eq? R 'display-end)
|
(set! refresh-box-unset? #f))
|
||||||
(R . > . refresh-r))
|
(begin
|
||||||
(set! refresh-r R)))
|
(when (L . < . refresh-l)
|
||||||
(when (T . < . refresh-t)
|
(set! refresh-l L))
|
||||||
(set! refresh-t T))
|
(unless (eq? refresh-r 'display-end)
|
||||||
(unless (eq? refresh-b 'display-end)
|
(when (or (eq? R 'display-end)
|
||||||
(when (or (eq? B 'display-end)
|
(R . > . refresh-r))
|
||||||
(B . > . refresh-b))
|
(set! refresh-r R)))
|
||||||
(set! refresh-b B)))))
|
(when (T . < . refresh-t)
|
||||||
|
(set! refresh-t T))
|
||||||
(set! draw-cached-in-bitmap? #f)))
|
(unless (eq? refresh-b 'display-end)
|
||||||
|
(when (or (eq? B 'display-end)
|
||||||
|
(B . > . refresh-b))
|
||||||
|
(set! refresh-b B)))))
|
||||||
|
|
||||||
|
(set! draw-cached-in-bitmap? #f)))))
|
||||||
|
|
||||||
(def/override (needs-update [snip% snip]
|
(def/override (needs-update [snip% snip]
|
||||||
[real? localx] [real? localy]
|
[real? localx] [real? localy]
|
||||||
|
@ -4024,7 +4042,7 @@
|
||||||
(set-box! ok? (get-snip-location snip x y))
|
(set-box! ok? (get-snip-location snip x y))
|
||||||
(when ok?
|
(when ok?
|
||||||
(refresh-box (+ x localx) (+ y localy) w h)
|
(refresh-box (+ x localx) (+ y localy) w h)
|
||||||
(when (zero? delay-refresh)
|
(unless (in-edit-sequence?)
|
||||||
(redraw)))))
|
(redraw)))))
|
||||||
|
|
||||||
(def/override (invalidate-bitmap-cache [real? [x 0.0]]
|
(def/override (invalidate-bitmap-cache [real? [x 0.0]]
|
||||||
|
@ -4035,7 +4053,7 @@
|
||||||
[h (if (eq? h 'end) (- (+ total-height padding-t padding-b) y) h)])
|
[h (if (eq? h 'end) (- (+ total-height padding-t padding-b) y) h)])
|
||||||
|
|
||||||
(refresh-box x y w h)
|
(refresh-box x y w h)
|
||||||
(when (zero? delay-refresh)
|
(unless (in-edit-sequence?)
|
||||||
(redraw))))
|
(redraw))))
|
||||||
|
|
||||||
(def/public (hide-caret [any? hide?])
|
(def/public (hide-caret [any? hide?])
|
||||||
|
@ -4522,7 +4540,7 @@
|
||||||
(define/override (setting-admin admin) (void))
|
(define/override (setting-admin admin) (void))
|
||||||
|
|
||||||
(define/override (init-new-admin)
|
(define/override (init-new-admin)
|
||||||
(when (and (zero? delay-refresh)
|
(when (and (not (in-edit-sequence?))
|
||||||
(or (not s-admin) (not (send s-admin refresh-delayed?))))
|
(or (not s-admin) (not (send s-admin refresh-delayed?))))
|
||||||
(redraw)))
|
(redraw)))
|
||||||
|
|
||||||
|
@ -4897,20 +4915,24 @@
|
||||||
[left x]
|
[left x]
|
||||||
[right (+ x w)])
|
[right (+ x w)])
|
||||||
(let-values ([(left right top bottom)
|
(let-values ([(left right top bottom)
|
||||||
(if refresh-all?
|
(call-with-semaphore
|
||||||
(values left right top bottom)
|
refresh-box-lock
|
||||||
(values
|
(lambda ()
|
||||||
(max refresh-l left)
|
(begin0
|
||||||
(if (eq? refresh-r 'display-end)
|
(if refresh-all?
|
||||||
right
|
(values left right top bottom)
|
||||||
(min refresh-r right))
|
(values
|
||||||
(max refresh-t top)
|
(max refresh-l left)
|
||||||
(if (eq? refresh-b 'display-end)
|
(if (eq? refresh-r 'display-end)
|
||||||
bottom
|
right
|
||||||
(min refresh-b bottom))))])
|
(min refresh-r right))
|
||||||
(set! refresh-unset? #t)
|
(max refresh-t top)
|
||||||
(set! refresh-box-unset? #t)
|
(if (eq? refresh-b 'display-end)
|
||||||
(set! refresh-all? #f)
|
bottom
|
||||||
|
(min refresh-b bottom))))
|
||||||
|
(set! refresh-unset? #t)
|
||||||
|
(set! refresh-box-unset? #t)
|
||||||
|
(set! refresh-all? #f))))])
|
||||||
(let ([height (- bottom top)]
|
(let ([height (- bottom top)]
|
||||||
[width (- right left)])
|
[width (- right left)])
|
||||||
(when (and (width . > . 0) (height . > . 0))
|
(when (and (width . > . 0) (height . > . 0))
|
||||||
|
@ -4958,42 +4980,45 @@
|
||||||
;; both; if neither is specified, we have to assume that everything
|
;; both; if neither is specified, we have to assume that everything
|
||||||
;; needs to be refreshed
|
;; needs to be refreshed
|
||||||
(let-values ([(left top right bottom needs-update?)
|
(let-values ([(left top right bottom needs-update?)
|
||||||
(if (and (not refresh-all?)
|
(call-with-semaphore
|
||||||
(or (not refresh-unset?) (not refresh-box-unset?)))
|
refresh-box-lock
|
||||||
(if (not refresh-unset?)
|
(lambda ()
|
||||||
(let ([top (if (refresh-start . > . -1)
|
(begin0
|
||||||
(let-boxes ([fy 0.0])
|
(if (and (not refresh-all?)
|
||||||
(position-location refresh-start #f fy #t #t #t)
|
(or (not refresh-unset?) (not refresh-box-unset?)))
|
||||||
(max top fy))
|
(if (not refresh-unset?)
|
||||||
top)]
|
(let ([top (if (refresh-start . > . -1)
|
||||||
[bottom (if (refresh-end . > . -1)
|
(let-boxes ([fy 0.0])
|
||||||
(let-boxes ([fy 0.0])
|
(position-location refresh-start #f fy #t #t #t)
|
||||||
(position-location refresh-end #f fy #f #f #t)
|
(max top fy))
|
||||||
(min bottom fy))
|
top)]
|
||||||
bottom)])
|
[bottom (if (refresh-end . > . -1)
|
||||||
(values left (if (not refresh-box-unset?)
|
(let-boxes ([fy 0.0])
|
||||||
(min refresh-t top)
|
(position-location refresh-end #f fy #f #f #t)
|
||||||
top)
|
(min bottom fy))
|
||||||
right (if (not refresh-box-unset?)
|
bottom)])
|
||||||
(if (eq? refresh-b 'display-end)
|
(values left (if (not refresh-box-unset?)
|
||||||
bottom
|
(min refresh-t top)
|
||||||
(max bottom refresh-b))
|
top)
|
||||||
bottom)
|
right (if (not refresh-box-unset?)
|
||||||
#t))
|
(if (eq? refresh-b 'display-end)
|
||||||
(values (max refresh-l left)
|
bottom
|
||||||
(max top refresh-t)
|
(max bottom refresh-b))
|
||||||
(if (eq? refresh-r 'display-end)
|
bottom)
|
||||||
right
|
#t))
|
||||||
(min right refresh-r))
|
(values (max refresh-l left)
|
||||||
(if (eq? refresh-b 'display-end)
|
(max top refresh-t)
|
||||||
bottom
|
(if (eq? refresh-r 'display-end)
|
||||||
(min bottom refresh-b))
|
right
|
||||||
#t))
|
(min right refresh-r))
|
||||||
(values left top right bottom refresh-all?))])
|
(if (eq? refresh-b 'display-end)
|
||||||
|
bottom
|
||||||
(set! refresh-unset? #t)
|
(min bottom refresh-b))
|
||||||
(set! refresh-box-unset? #t)
|
#t))
|
||||||
(set! refresh-all? #f)
|
(values left top right bottom refresh-all?))
|
||||||
|
(set! refresh-unset? #t)
|
||||||
|
(set! refresh-box-unset? #t)
|
||||||
|
(set! refresh-all? #f))))])
|
||||||
|
|
||||||
(let ([height (- bottom top)]
|
(let ([height (- bottom top)]
|
||||||
[width (- right left)])
|
[width (- right left)])
|
||||||
|
@ -5017,7 +5042,7 @@
|
||||||
(define/private (too-busy-to-refresh?)
|
(define/private (too-busy-to-refresh?)
|
||||||
(or graphic-maybe-invalid?
|
(or graphic-maybe-invalid?
|
||||||
flow-locked?
|
flow-locked?
|
||||||
(positive? delay-refresh)))
|
(in-edit-sequence?)))
|
||||||
|
|
||||||
;; called by the administrator to trigger a redraw
|
;; called by the administrator to trigger a redraw
|
||||||
(def/override (refresh [real? left] [real? top] [nonnegative-real? width] [nonnegative-real? height]
|
(def/override (refresh [real? left] [real? top] [nonnegative-real? width] [nonnegative-real? height]
|
||||||
|
@ -5030,7 +5055,10 @@
|
||||||
;; (probably in the middle of a begin-/end-edit-sequnce);
|
;; (probably in the middle of a begin-/end-edit-sequnce);
|
||||||
;; add the given region to our own invalid-region tracking, and
|
;; add the given region to our own invalid-region tracking, and
|
||||||
;; we'll get back to it when we're done with whatever
|
;; we'll get back to it when we're done with whatever
|
||||||
(refresh-box left top width height)]
|
(refresh-box left top width height)
|
||||||
|
;; Double-check that we didn't finish being busy while
|
||||||
|
;; setting the box:
|
||||||
|
(unless (too-busy-to-refresh?) (redraw))]
|
||||||
[(not s-admin)
|
[(not s-admin)
|
||||||
(void)]
|
(void)]
|
||||||
[else
|
[else
|
||||||
|
@ -5483,12 +5511,12 @@
|
||||||
(continue-refresh))
|
(continue-refresh))
|
||||||
|
|
||||||
(define/private (continue-refresh)
|
(define/private (continue-refresh)
|
||||||
(if (and (zero? delay-refresh)
|
(if (and (not (in-edit-sequence?))
|
||||||
(not (super is-printing?))
|
(not (super is-printing?))
|
||||||
(or (not s-admin) (not (send s-admin refresh-delayed?))))
|
(or (not s-admin) (not (send s-admin refresh-delayed?))))
|
||||||
(redraw)
|
(redraw)
|
||||||
(begin
|
(begin
|
||||||
(when (and (zero? delay-refresh)
|
(when (and (not (in-edit-sequence?))
|
||||||
(or (= delayedscroll -1)
|
(or (= delayedscroll -1)
|
||||||
delayedscrollbox?))
|
delayedscrollbox?))
|
||||||
(if (and (not (super is-printing?)) s-admin)
|
(if (and (not (super is-printing?)) s-admin)
|
||||||
|
|
|
@ -719,8 +719,8 @@ Methods that report @techlink{location}-independent information about an
|
||||||
|
|
||||||
An editor is not tied to any particular thread or eventspace, except
|
An editor is not tied to any particular thread or eventspace, except
|
||||||
to the degree that it is displayed in a canvas (which has an
|
to the degree that it is displayed in a canvas (which has an
|
||||||
eventspace). Concurrent access of an editor is always safe, in the
|
eventspace). Concurrent access of an editor is always safe in the
|
||||||
sense that the editor will not become corrupted. However, because
|
weak sense that the editor will not become corrupted. However, because
|
||||||
editor access can trigger locks, concurrent access can produce
|
editor access can trigger locks, concurrent access can produce
|
||||||
contract failures or unexpected results.
|
contract failures or unexpected results.
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue
Block a user