From 7f2097e2bb5a3fb79da05888ceb625637b1d5b52 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Mon, 11 Oct 2010 16:00:03 -0500 Subject: [PATCH] added an argument to open-input-text-editor so that it can lock (and unlock) the editor when editing would not be allowed. original commit: 3e9858b001699d9ef66d016a2ee691dacc5a8503 --- collects/mred/private/snipfile.rkt | 59 +++++++++++++-------- collects/scribblings/gui/editor-funcs.scrbl | 8 ++- collects/tests/gracket/editor.rktl | 27 +++++++++- 3 files changed, 68 insertions(+), 26 deletions(-) diff --git a/collects/mred/private/snipfile.rkt b/collects/mred/private/snipfile.rkt index bd8ba41f..9da20e4c 100644 --- a/collects/mred/private/snipfile.rkt +++ b/collects/mred/private/snipfile.rkt @@ -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 diff --git a/collects/scribblings/gui/editor-funcs.scrbl b/collects/scribblings/gui/editor-funcs.scrbl index d378d873..24dd7864 100644 --- a/collects/scribblings/gui/editor-funcs.scrbl +++ b/collects/scribblings/gui/editor-funcs.scrbl @@ -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.) } diff --git a/collects/tests/gracket/editor.rktl b/collects/tests/gracket/editor.rktl index a40b8ba9..7551cca2 100644 --- a/collects/tests/gracket/editor.rktl +++ b/collects/tests/gracket/editor.rktl @@ -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%))