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

.

Browse Source 
original commit: d5c78e174e9e299210e330a3fa98ba3ce4d71233
This commit is contained in:
Matthew Flatt 2003-11-24 23:07:13 +00:00
parent e37ae09c1b
commit 641c2ea2e5
2 changed files with 40 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
collects/mred/mred.ss
View File

@ -7481,22 +7481,22 @@
(next-snip to-str)]
[snip
(let ([the-snip snip])
;; Increment the snip now, because the
;; system promises to use the procedure
;; below before another read
(next-snip empty-string)
(lambda (file line col ppos)
(if (is-a? the-snip readable-snip<%>)
(with-handlers ([exn:special-comment?
(lambda (exn)
;; implies "done"
(next-snip empty-string)
(raise exn))])
(let-values ([(val size done?)
(send the-snip read-one-special pos file line col ppos)])
(if done?
(next-snip empty-string)
(set! pos (add1 pos)))
(unless done?
(set! pos (add1 pos)))
(values val size)))
(begin
(next-snip empty-string)
(values (send the-snip copy) 1)))))]
(values (send the-snip copy) 1))))]
[else eof]))]
[close (lambda () (void))]
[port (make-custom-input-port

33
collects/tests/mred/editor.ss
View File

@ -62,4 +62,37 @@
(test #t 'undone? undone?)
(st "Hello" e get-text)
;; Editor ports
(let ([e (make-object text%)])
(stv e insert "hello")
(let ([p (open-input-text-editor e)])
(test 'hello 'read (read p))
(test eof 'read (read p)))
(stv e insert " there")
(let ([p (open-input-text-editor e)])
(test 'hello 'read (read p))
(test 'there 'read (read p))
(test eof 'read (read p)))
(stv e insert (make-object
(class* snip%
(readable-snip<%>)
(define/public (read-one-special idx src line col pos)
(error 'ack))
(super-new))))
(let ([p (open-input-text-editor e)])
(port-count-lines! p)
(test '(1 0 1) 'pos (call-with-values (lambda () (port-next-location p)) list))
(test 'hello 'read (read p))
(test '(1 5 6) 'pos (call-with-values (lambda () (port-next-location p)) list))
(test 'there 'read (read p))
(test '(1 11 12) 'pos (call-with-values (lambda () (port-next-location p)) list))
(test 'got-ack 'read (with-handlers ([not-break-exn? (lambda (x)
'got-ack)])
(read p)))
(test '(1 12 13) 'pos (call-with-values (lambda () (port-next-location p)) list))
(test eof 'read (read p))))
(report-errs)