added an argument to open-input-text-editor so that it can lock (and unlock) the editor when editing would not be allowed.
This commit is contained in:
parent
fc22d10b49
commit
3e9858b001
|
@ -1,11 +1,10 @@
|
|||
(module snipfile mzscheme
|
||||
(require mzlib/class
|
||||
mzlib/etc
|
||||
mzlib/port
|
||||
(module snipfile racket/base
|
||||
(require racket/class
|
||||
racket/port
|
||||
syntax/moddep
|
||||
(prefix wx: "kernel.ss")
|
||||
(prefix wx: "wxme/snip.ss")
|
||||
(prefix wx: "wxme/cycle.ss")
|
||||
(prefix-in wx: "kernel.ss")
|
||||
(prefix-in wx: "wxme/snip.ss")
|
||||
(prefix-in wx: "wxme/cycle.ss")
|
||||
"check.ss"
|
||||
"editor.ss")
|
||||
|
||||
|
@ -72,7 +71,8 @@
|
|||
;; starting at position `start-in'
|
||||
;; and ending at position `end'.
|
||||
(define open-input-text-editor
|
||||
(opt-lambda (text [start 0] [end 'end] [snip-filter values] [port-name text] [expect-to-read-all? #f])
|
||||
(lambda (text [start 0] [end 'end] [snip-filter values] [port-name text] [expect-to-read-all? #f]
|
||||
#:lock-while-reading? [lock-while-reading? #f])
|
||||
;; Check arguments:
|
||||
(unless (text . is-a? . text%)
|
||||
(raise-type-error 'open-input-text-editor "text% object" text))
|
||||
|
@ -105,24 +105,33 @@
|
|||
;; It's all text, and it's short enough: just read it into a string
|
||||
(open-input-string (send text get-text start end) port-name)
|
||||
;; It's all text, so the reading process is simple:
|
||||
(let ([start start])
|
||||
(let-values ([(pipe-r pipe-w) (make-pipe)])
|
||||
(let ([start start])
|
||||
(when lock-while-reading? (send text lock #t))
|
||||
(let-values ([(pipe-r pipe-w) (make-pipe)])
|
||||
(make-input-port/read-to-peek
|
||||
port-name
|
||||
port-name
|
||||
(lambda (s)
|
||||
(let ([v (read-bytes-avail!* s pipe-r)])
|
||||
(if (eq? v 0)
|
||||
(let ([n (min 4096 (- end start))])
|
||||
(if (zero? n)
|
||||
(begin
|
||||
(close-output-port pipe-w)
|
||||
eof)
|
||||
(close-output-port pipe-w)
|
||||
(when lock-while-reading?
|
||||
(set! lock-while-reading? #f)
|
||||
(send text lock #f))
|
||||
eof)
|
||||
(begin
|
||||
(write-string (send text get-text start (+ start n)) pipe-w)
|
||||
(set! start (+ start n))
|
||||
(read-bytes-avail!* s pipe-r))))
|
||||
(let ([ans (read-bytes-avail!* s pipe-r)])
|
||||
(when lock-while-reading?
|
||||
(when (eof-object? ans)
|
||||
(set! lock-while-reading? #f)
|
||||
(send text lock #f)))
|
||||
ans))))
|
||||
v)))
|
||||
(lambda (s skip general-peek)
|
||||
(lambda (s skip general-peek)
|
||||
(let ([v (peek-bytes-avail!* s skip #f pipe-r)])
|
||||
(if (eq? v 0)
|
||||
(general-peek s skip)
|
||||
|
@ -184,17 +193,21 @@
|
|||
[port (make-input-port/read-to-peek
|
||||
port-name
|
||||
(lambda (s)
|
||||
(let ([v (read-bytes-avail!* s pipe-r)])
|
||||
(if (eq? v 0)
|
||||
(read-chars s)
|
||||
v)))
|
||||
(lambda (s skip general-peek)
|
||||
(let* ([v (read-bytes-avail!* s pipe-r)]
|
||||
[res (if (eq? v 0) (read-chars s) v)])
|
||||
(when (eof-object? res)
|
||||
(when lock-while-reading?
|
||||
(set! lock-while-reading? #f)
|
||||
(send text lock #f)))
|
||||
res))
|
||||
(lambda (s skip general-peek)
|
||||
(let ([v (peek-bytes-avail!* s skip #f pipe-r)])
|
||||
(if (eq? v 0)
|
||||
(general-peek s skip)
|
||||
v)))
|
||||
close)])
|
||||
(if (is-a? snip wx:string-snip%)
|
||||
(when lock-while-reading? (send text lock #t))
|
||||
(if (is-a? snip wx:string-snip%)
|
||||
;; Special handling for initial snip string in
|
||||
;; case it starts too early:
|
||||
(let* ([snip-start (gsp snip)]
|
||||
|
@ -235,7 +248,7 @@
|
|||
(apply values last-time-values)
|
||||
(call-with-values (lambda () (call-with-continuation-prompt
|
||||
(lambda () (eval
|
||||
(datum->syntax-object
|
||||
(datum->syntax
|
||||
#f
|
||||
(cons '#%top-interaction exp)
|
||||
exp)))
|
||||
|
@ -271,7 +284,7 @@
|
|||
p))
|
||||
|
||||
(define open-output-text-editor
|
||||
(opt-lambda (text [start 'end] [special-filter values] [port-name text])
|
||||
(lambda (text [start 'end] [special-filter values] [port-name text])
|
||||
(define pos (if (eq? start 'end)
|
||||
(send text last-position)
|
||||
(min start
|
||||
|
|
|
@ -213,7 +213,8 @@ Opens @racket[filename] (in @racket['binary] mode) and checks whether it looks
|
|||
[end-position (or/c exact-nonnegative-integer? (one/of 'end)) 'end]
|
||||
[snip-filter ((is-a?/c snip%) . -> . any/c) (lambda (s) s)]
|
||||
[port-name any/c text-editor]
|
||||
[expect-to-read-all? any/c #f])
|
||||
[expect-to-read-all? any/c #f]
|
||||
[#:lock-while-reading? lock-while-reading? any/c #f])
|
||||
input-port]{
|
||||
|
||||
Creates an input port that draws its content from @racket[text-editor].
|
||||
|
@ -252,7 +253,10 @@ The result port must not be used if @racket[text-editor] changes in any
|
|||
@method[snip-admin% recounted]). The
|
||||
@method[text% get-revision-number] method can be used to detect any of these changes.
|
||||
|
||||
|
||||
To help guard against such uses, if @racket[lock-while-reading?] argument is
|
||||
a true value, then @racket[open-input-text-editor] will lock the @racket[text-editor]
|
||||
before it returns and unlock it after it is safe to use the above methods. (In some
|
||||
cases, it will not lock the editor at all, if using those methods are always safe.)
|
||||
|
||||
}
|
||||
|
||||
|
|
|
@ -259,7 +259,32 @@
|
|||
(test 'hello 'read (read p))
|
||||
(test 'there 'read (read p))
|
||||
(test 'res 'read (read p))
|
||||
(test #t 'read (is-a? (read p) image-snip%))))
|
||||
(test #t 'read (is-a? (read p) image-snip%)))
|
||||
|
||||
|
||||
(let ()
|
||||
(define t (new text%))
|
||||
(send t insert (make-string 5000 #\a))
|
||||
(define p (open-input-text-editor t #:lock-while-reading? #t))
|
||||
(define locked-first (send t is-locked?))
|
||||
(void (read p)) ;; read the (big) symbol
|
||||
(void (read p)) ;; read eof
|
||||
(define locked-last (send t is-locked?))
|
||||
(test #t 'lock-while-reading?1 (and locked-first (not locked-last))))
|
||||
|
||||
(let ()
|
||||
(define t (new text%))
|
||||
(send t insert (make-string 5000 #\a))
|
||||
(send t insert (make-object image-snip%))
|
||||
(define p (open-input-text-editor t #:lock-while-reading? #t))
|
||||
(define locked-first (send t is-locked?))
|
||||
(void (read p)) ;; read the (big) symbol
|
||||
(void (read p)) ;; read the image
|
||||
(void (read p)) ;; read eof
|
||||
(define locked-last (send t is-locked?))
|
||||
(test #t 'lock-while-reading?2
|
||||
(and locked-first
|
||||
(not locked-last)))))
|
||||
|
||||
(let ()
|
||||
(define x (new text%))
|
||||
|
|
Loading…
Reference in New Issue
Block a user