suzanne.soy/gui
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

reindent the implementation of open-input-text-editor

Browse Source 
Apologies for the gratuitious reindent, but I was having
a lot of trouble reading this file; it appears to have
last been worked on in an Emacs that used tabs for indentation
and doesn't use the same tab width as drracket.

original commit: 6c760b086fc87163bf3c7086c16efbe845a9b08b
This commit is contained in:
Robby Findler 2012-11-02 08:16:08 -05:00
parent 6cce05a331
commit b801edee42
1 changed files with 110 additions and 110 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

220
collects/mred/private/snipfile.rkt
View File

@ -25,126 +25,126 @@
#:lock-while-reading? [lock-while-reading? #f]) #:lock-while-reading? [lock-while-reading? #f])
;; Check arguments: ;; Check arguments:
(unless (text . is-a? . text%) (unless (text . is-a? . text%)
(raise-argument-error 'open-input-text-editor "(is-a?/c text%)" text)) (raise-argument-error 'open-input-text-editor "(is-a?/c text%)" text))
(check-non-negative-integer 'open-input-text-editor start) (check-non-negative-integer 'open-input-text-editor start)
(unless (or (eq? end 'end) (unless (or (eq? end 'end)
(and (integer? end) (exact? end) (not (negative? end)))) (and (integer? end) (exact? end) (not (negative? end))))
(raise-argument-error 'open-input-text-editor "(or/c exact-nonnegative-integer? 'end)" end)) (raise-argument-error 'open-input-text-editor "(or/c exact-nonnegative-integer? 'end)" end))
(let ([last (send text last-position)]) (let ([last (send text last-position)])
(when (start . > . last) (when (start . > . last)
(raise-range-error 'open-input-text-editor "editor" "starting " (raise-range-error 'open-input-text-editor "editor" "starting "
start text 0 last #f)) start text 0 last #f))
(unless (eq? end 'end) (unless (eq? end 'end)
(unless (<= start end last) (unless (<= start end last)
(raise-range-error 'open-input-text-editor "editor" "ending " (raise-range-error 'open-input-text-editor "editor" "ending "
end text start last 0)))) end text start last 0))))
(let ([end (if (eq? end 'end) (send text last-position) end)] (let ([end (if (eq? end 'end) (send text last-position) end)]
[snip (send text find-snip start 'after-or-none)]) [snip (send text find-snip start 'after-or-none)])
;; If the region is small enough, and if the editor contains ;; If the region is small enough, and if the editor contains
;; only string snips, then it's probably better to move ;; only string snips, then it's probably better to move
;; all of the text into a string port: ;; all of the text into a string port:
(if (or (not snip) (if (or (not snip)
(and (is-a? snip wx:string-snip%) (and (is-a? snip wx:string-snip%)
(let ([s (send text find-next-non-string-snip snip)]) (let ([s (send text find-next-non-string-snip snip)])
(or (not s) (or (not s)
((send text get-snip-position s) . >= . end))))) ((send text get-snip-position s) . >= . end)))))
(if (or expect-to-read-all? (if (or expect-to-read-all?
((- end start) . < . 4096)) ((- end start) . < . 4096))
;; It's all text, and it's short enough: just read it into a string ;; 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) (open-input-string (send text get-text start end) port-name)
;; It's all text, so the reading process is simple: ;; It's all text, so the reading process is simple:
(let ([start start]) (let ([start start])
(when lock-while-reading? (when lock-while-reading?
(send text begin-edit-sequence) (send text begin-edit-sequence)
(send text lock #t)) (send text lock #t))
(let-values ([(pipe-r pipe-w) (make-pipe)]) (let-values ([(pipe-r pipe-w) (make-pipe)])
(make-input-port/read-to-peek (make-input-port/read-to-peek
port-name port-name
(lambda (s) (lambda (s)
(let ([v (read-bytes-avail!* s pipe-r)]) (let ([v (read-bytes-avail!* s pipe-r)])
(if (eq? v 0) (if (eq? v 0)
(let ([n (min 4096 (- end start))]) (let ([n (min 4096 (- end start))])
(if (zero? n) (if (zero? n)
(begin (begin
(close-output-port pipe-w) (close-output-port pipe-w)
(when lock-while-reading? (when lock-while-reading?
(set! lock-while-reading? #f) (set! lock-while-reading? #f)
(send text lock #f) (send text lock #f)
(send text end-edit-sequence)) (send text end-edit-sequence))
eof) eof)
(begin (begin
(write-string (send text get-text start (+ start n)) pipe-w) (write-string (send text get-text start (+ start n)) pipe-w)
(set! start (+ start n)) (set! start (+ start n))
(let ([ans (read-bytes-avail!* s pipe-r)]) (let ([ans (read-bytes-avail!* s pipe-r)])
(when lock-while-reading? (when lock-while-reading?
(when (eof-object? ans) (when (eof-object? ans)
(set! lock-while-reading? #f) (set! lock-while-reading? #f)
(send text lock #f) (send text lock #f)
(send text edit-edit-sequence))) (send text edit-edit-sequence)))
ans)))) ans))))
v))) v)))
(lambda (s skip general-peek) (lambda (s skip general-peek)
(let ([v (peek-bytes-avail!* s skip #f pipe-r)]) (let ([v (peek-bytes-avail!* s skip #f pipe-r)])
(if (eq? v 0) (if (eq? v 0)
(general-peek s skip) (general-peek s skip)
v))) v)))
void)))) void))))
;; General case, which handles non-text context: ;; General case, which handles non-text context:
(with-method ([gsp (text get-snip-position)] (with-method ([gsp (text get-snip-position)]
[grn (text get-revision-number)]) [grn (text get-revision-number)])
(let-values ([(pipe-r pipe-w) (make-pipe)]) (let-values ([(pipe-r pipe-w) (make-pipe)])
(let* ([get-text-generic (generic wx:snip% get-text)] (let* ([get-text-generic (generic wx:snip% get-text)]
[get-count-generic (generic wx:snip% get-count)] [get-count-generic (generic wx:snip% get-count)]
[next-generic (generic wx:snip% next)] [next-generic (generic wx:snip% next)]
[revision (grn)] [revision (grn)]
[next? #f] [next? #f]
[update-str-to-snip [update-str-to-snip
(lambda (to-str) (lambda (to-str)
(if snip (if snip
(let ([snip-start (gsp snip)]) (let ([snip-start (gsp snip)])
(cond (cond
[(snip-start . >= . end) [(snip-start . >= . end)
(set! snip #f) (set! snip #f)
(set! next? #f) (set! next? #f)
0] 0]
[(is-a? snip wx:string-snip%) [(is-a? snip wx:string-snip%)
(set! next? #t) (set! next? #t)
(let ([c (min (send-generic snip get-count-generic) (- end snip-start))]) (let ([c (min (send-generic snip get-count-generic) (- end snip-start))])
(write-string (send-generic snip get-text-generic 0 c) pipe-w) (write-string (send-generic snip get-text-generic 0 c) pipe-w)
(read-bytes-avail!* to-str pipe-r))] (read-bytes-avail!* to-str pipe-r))]
[else [else
(set! next? #f) (set! next? #f)
0])) 0]))
(begin (begin
(set! next? #f) (set! next? #f)
0)))] 0)))]
[next-snip [next-snip
(lambda (to-str) (lambda (to-str)
(unless (= revision (grn)) (unless (= revision (grn))
(raise-arguments-error (raise-arguments-error
'text-input-port 'text-input-port
"editor has changed since port was opened" "editor has changed since port was opened"
"editor" text)) "editor" text))
(set! snip (send-generic snip next-generic)) (set! snip (send-generic snip next-generic))
(update-str-to-snip to-str))] (update-str-to-snip to-str))]
[read-chars (lambda (to-str) [read-chars (lambda (to-str)
(cond (cond
[next? [next?
(next-snip to-str)] (next-snip to-str)]
[snip [snip
(let ([the-snip (snip-filter snip)]) (let ([the-snip (snip-filter snip)])
(next-snip empty-string) (next-snip empty-string)
(lambda (file line col ppos) (lambda (file line col ppos)
(if (is-a? the-snip wx:snip%) (if (is-a? the-snip wx:snip%)
(if (is-a? the-snip wx:readable-snip<%>) (if (is-a? the-snip wx:readable-snip<%>)
(send the-snip read-special file line col ppos) (send the-snip read-special file line col ppos)
(send the-snip copy)) (send the-snip copy))
the-snip)))] the-snip)))]
[else eof]))] [else eof]))]
[close (lambda () (void))] [close (lambda () (void))]
[port (make-input-port/read-to-peek [port (make-input-port/read-to-peek
port-name port-name
(lambda (s) (lambda (s)
(let* ([v (read-bytes-avail!* s pipe-r)] (let* ([v (read-bytes-avail!* s pipe-r)]
[res (if (eq? v 0) (read-chars s) v)]) [res (if (eq? v 0) (read-chars s) v)])
(when (eof-object? res) (when (eof-object? res)
@ -154,25 +154,25 @@
(send text end-edit-sequence))) (send text end-edit-sequence)))
res)) res))
(lambda (s skip general-peek) (lambda (s skip general-peek)
(let ([v (peek-bytes-avail!* s skip #f pipe-r)]) (let ([v (peek-bytes-avail!* s skip #f pipe-r)])
(if (eq? v 0) (if (eq? v 0)
(general-peek s skip) (general-peek s skip)
v))) v)))
close)]) close)])
(when lock-while-reading? (when lock-while-reading?
(send text begin-edit-sequence) (send text begin-edit-sequence)
(send text lock #t)) (send text lock #t))
(if (is-a? snip wx:string-snip%) (if (is-a? snip wx:string-snip%)
;; Special handling for initial snip string in ;; Special handling for initial snip string in
;; case it starts too early: ;; case it starts too early:
(let* ([snip-start (gsp snip)] (let* ([snip-start (gsp snip)]
[skip (- start snip-start)] [skip (- start snip-start)]
[c (min (- (send-generic snip get-count-generic) skip) [c (min (- (send-generic snip get-count-generic) skip)
(- end snip-start))]) (- end snip-start))])
(set! next? #t) (set! next? #t)
(display (send-generic snip get-text-generic skip c) pipe-w)) (display (send-generic snip get-text-generic skip c) pipe-w))
(update-str-to-snip empty-string)) (update-str-to-snip empty-string))
port))))))) port)))))))
(define (jump-to-submodule in-port expected-module k) (define (jump-to-submodule in-port expected-module k)
(let ([header (bytes-append #"^#~" (let ([header (bytes-append #"^#~"