From 92f4a9262707ac2fe632157cb05395d7bf4705be Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Tue, 25 Nov 2003 22:06:44 +0000
Subject: [PATCH] .

original commit: 4f61528231f3ad50b37d76b5895013a3922c719d
---
 collects/mred/mred.ss         | 42 +++++++++++++++++++++--------------
 collects/tests/mred/editor.ss | 19 +++++++++++++---
 2 files changed, 41 insertions(+), 20 deletions(-)

diff --git a/collects/mred/mred.ss b/collects/mred/mred.ss
index 452029d5..4d150158 100644
--- a/collects/mred/mred.ss
+++ b/collects/mred/mred.ss
@@ -7421,7 +7421,7 @@
 ;; and ending at position `end'.
 (define open-input-text-editor 
   (case-lambda
-   [(text start end)
+   [(text start end snip-filter)
     ;; Check arguments:
     (unless (text . is-a? . text%)
       (raise-type-error 'open-input-text-editor "text% object" text))
@@ -7480,23 +7480,30 @@
 			      [next?
 			       (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)
+			       (let-values ([(the-snip alt-size) (snip-filter snip)])
 				 (lambda (file line col ppos)
-				   (if (is-a? the-snip readable-snip<%>)
-				       (with-handlers ([exn:special-comment?
-							(lambda (exn)
-							  ;; implies "done"
-							  (raise exn))])
-					 (let-values ([(val size done?)
-						       (send the-snip read-one-special pos file line col ppos)])
-					   (unless done?
-					     (set! pos (add1 pos)))
-					   (values val size)))
-				       (values (send the-snip copy) 1))))]
+				   (if (is-a? the-snip wx:snip%)
+				       (if (is-a? the-snip readable-snip<%>)
+					   (with-handlers ([exn:special-comment?
+							    (lambda (exn)
+							      ;; implies "done"
+							      (next-snip empty-string)
+							      (raise exn))]
+							   [not-break-exn?
+							    (lambda (exn)
+							      ;; Give up after an exception
+							      (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)))
+					       (values val size)))
+					   (values (send the-snip copy) alt-size))
+				       (begin
+					 (next-snip empty-string)
+					 (values the-snip alt-size)))))]
 			      [else eof]))]
 	       [close (lambda () (void))]
 	       [port (make-custom-input-port 
@@ -7525,6 +7532,7 @@
 	      (update-str-to-snip empty-string))
 	  (port-count-lines! port)
 	  port)))]
+   [(text start end) (open-input-text-editor text start end (lambda (x) (values x 1)))]
    [(text start) (open-input-text-editor text start 'end)]
    [(text) (open-input-text-editor text 0 'end)]))
 
diff --git a/collects/tests/mred/editor.ss b/collects/tests/mred/editor.ss
index 9a4bb61a..3cc8d659 100644
--- a/collects/tests/mred/editor.ss
+++ b/collects/tests/mred/editor.ss
@@ -64,7 +64,8 @@
 
 ;; Editor ports
 
-(let ([e (make-object text%)])
+(let ([e (make-object text%)]
+      [multi-mode? #f])
   (stv e insert "hello")
   (let ([p (open-input-text-editor e)])
     (test 'hello 'read (read p))
@@ -77,8 +78,10 @@
   (stv e insert (make-object
 		 (class* snip% 
 		   (readable-snip<%>)
-		   (define/public (read-one-special idx src line col pos)
-		     (error 'ack))
+		   (define/public (read-one-special index src line col pos)
+		     (if multi-mode?
+			 (values 'multi 1 (= index 1))
+			 (error 'ack)))
 		   (super-new))))
   (let ([p (open-input-text-editor e)])
     (port-count-lines! p)
@@ -91,6 +94,16 @@
 							   'got-ack)])
 			   (read p)))
     (test '(1 12 13) 'pos (call-with-values (lambda () (port-next-location p)) list))
+    (test eof 'read (read p)))
+  (set! multi-mode? #t)
+  (let ([p (open-input-text-editor e)])
+    (port-count-lines! p)
+    (test 'hello 'read (read p))
+    (test 'there 'read (read p))
+    (test 'multi 'read (read p))
+    (test '(1 12 13) 'pos (call-with-values (lambda () (port-next-location p)) list))
+    (test 'multi 'read (read p))
+    (test '(1 13 14) 'pos (call-with-values (lambda () (port-next-location p)) list))
     (test eof 'read (read p))))