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

.

Browse Source 
original commit: 44ec4c36633f4dcc03910abc038b7842feba9f19
This commit is contained in:
Matthew Flatt 2003-07-03 02:30:35 +00:00
parent e01d4ece1c
commit 8c150d0d86
1 changed files with 76 additions and 66 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

142
collects/mred/mred.ss
View File

@ -7402,72 +7402,82 @@
(format "end index outside the range [~a,~a]: " start last)
end))))
;; Create the port:
(let-values ([(pipe-r pipe-w) (make-pipe)])
(let* ([end (if (eq? end 'end) (send text last-position) end)]
[snip (send text find-snip start 'after-or-none)]
[next? #f]
[pos 0]
[lock-semaphore (make-semaphore 1)]
[update-str-to-snip
(lambda ()
(if snip
(let ([snip-start (send text get-snip-position snip)])
(cond
[(snip-start . >= . end)
(set! snip #f)
(set! next? #f)]
[(is-a? snip wx:string-snip%)
(display (send snip get-text 0 (send snip get-count)) pipe-w)
(set! next? #t)]
[else
(set! next? #f)]))
(set! next? #f)))]
[next-snip
(lambda ()
(set! snip (send snip next))
(set! pos 0)
(update-str-to-snip))]
[read-chars (lambda (to-str)
(cond
[next?
(next-snip)
0]
[snip
(let ([the-snip snip])
(lambda (file line col ppos)
(if (is-a? the-snip readable-snip<%>)
(with-handlers ([exn:special-comment?
(lambda (exn)
;; implies "done"
(next-snip)
(raise exn))])
(let-values ([(val size done?)
(send the-snip read-one-special pos file line col ppos)])
(if done?
(next-snip)
(set! pos (add1 pos)))
(values val size)))
(begin
(next-snip)
(values (send the-snip copy) 1)))))]
[else eof]))]
[close (lambda () (void))]
[port (make-custom-input-port
(lambda (s)
(if (char-ready? pipe-r)
(read-string-avail!* s pipe-r)
(parameterize ([break-enabled #f])
(if (semaphore-try-wait? lock-semaphore)
(dynamic-wind
void
(lambda () (read-chars s))
(lambda () (semaphore-post lock-semaphore)))
(make-semaphore-peek lock-semaphore)))))
#f ; no peek
close)])
(update-str-to-snip)
(port-count-lines! port)
port))]
(with-method ([gsp (text get-snip-position)])
(let-values ([(pipe-r pipe-w) (make-pipe)])
(let* ([get-text-generic (generic wx:snip% get-text)]
[get-count-generic (generic wx:snip% get-count)]
[next-generic (generic wx:snip% next)]
[end (if (eq? end 'end) (send text last-position) end)]
[snip (send text find-snip start 'after-or-none)]
[next? #f]
[pos 0]
[lock-semaphore (make-semaphore 1)]
[update-str-to-snip
(lambda (to-str)
(if snip
(let ([snip-start (gsp snip)])
(cond
[(snip-start . >= . end)
(set! snip #f)
(set! next? #f)
0]
[(is-a? snip wx:string-snip%)
(set! next? #t)
(let ([c (min (send-generic snip get-count-generic) (- end snip-start))])
(display (send-generic snip get-text-generic 0 c) pipe-w)
0)]
[else
(set! next? #f)
0]))
(begin
(set! next? #f)
0)))]
[next-snip
(lambda (to-str)
(set! snip (send-generic snip next-generic))
(set! pos 0)
(update-str-to-snip to-str))]
[read-chars (lambda (to-str)
(cond
[next?
(next-snip to-str)]
[snip
(let ([the-snip snip])
(lambda (file line col ppos)
(if (is-a? the-snip readable-snip<%>)
(with-handlers ([exn:special-comment?
(lambda (exn)
;; implies "done"
(next-snip "")
(raise exn))])
(let-values ([(val size done?)
(send the-snip read-one-special pos file line col ppos)])
(if done?
(next-snip "")
(set! pos (add1 pos)))
(values val size)))
(begin
(next-snip "")
(values (send the-snip copy) 1)))))]
[else eof]))]
[close (lambda () (void))]
[port (make-custom-input-port
(lambda (s)
(if (char-ready? pipe-r)
(read-string-avail!* s pipe-r)
(parameterize ([break-enabled #f])
(if (semaphore-try-wait? lock-semaphore)
;; If there's an error here, the
;; port will remain locked.
(let ([v (read-chars s)])
(semaphore-post lock-semaphore)
v)
(make-semaphore-peek lock-semaphore)))))
#f ; no peek
close)])
(update-str-to-snip "")
(port-count-lines! port)
port)))]
[(text start) (open-input-text-editor text start 'end)]
[(text) (open-input-text-editor text 0 'end)]))