.

original commit: 5c0fc3a6d713f41815a1a8397476e0c9422ef0ee

collects/mred/mred.ss

@@ -7402,78 +7402,72 @@
 				(format "end index outside the range [~a,~a]: " start last)
 				end))))
     ;; Create the port:
-    (let* ([end (if (eq? end 'end) (send text last-position) end)]
+    (let-values ([(pipe-r pipe-w) (make-pipe)])
-	   [snip (send text find-snip start 'after-or-none)]
+      (let* ([end (if (eq? end 'end) (send text last-position) end)]
-	   [str #f]
+	     [snip (send text find-snip start 'after-or-none)]
-	   [pos 0]
+	     [next? #f]
-	   [lock-semaphore (make-semaphore 1)]
+	     [pos 0]
-	   [update-str-to-snip
+	     [lock-semaphore (make-semaphore 1)]
-	    (lambda ()
+	     [update-str-to-snip
-	      (if (not snip)
+	      (lambda ()
-		  (set! str #f)
+		(if snip
-		  (let ([snip-start (send text get-snip-position snip)])
+		    (let ([snip-start (send text get-snip-position snip)])
-		    (cond
+		      (cond
-		     [(snip-start . >= . end)
+		       [(snip-start . >= . end)
-		      (set! str #f)]
+			(set! snip #f)
-		     [(is-a? snip wx:string-snip%)
+			(set! next? #f)]
-		      (set! str (send snip get-text 0 (min (send snip get-count)
+		       [(is-a? snip wx:string-snip%)
-							   (- end snip-start))))]
+			(display (send snip get-text 0 (send snip get-count)) pipe-w)
-		     [else
+			(set! next? #t)]
-		      (set! str 'snip)]))))]
+		       [else
-	   [next-snip
+			(set! next? #f)]))
-	    (lambda ()
+		    (set! next? #f)))]
-	      (set! snip (send snip next))
+	     [next-snip
-	      (set! pos 0)
+	      (lambda ()
-	      (update-str-to-snip))]
+		(set! snip (send snip next))
-	   [read-chars (lambda (to-str)
+		(set! pos 0)
-			 (cond
+		(update-str-to-snip))]
-			  [(not str) eof]
+	     [read-chars (lambda (to-str)
-			  [(string? str)
+			   (cond
-			   (let* ([sl (string-length str)]
+			    [next?
-				  [n (min (- sl pos) (string-length to-str))])
+			     (next-snip)
-			     (let loop ([i 0])
+			     0]
-			       (unless (= i n)
+			    [snip
-				 (string-set! to-str i (string-ref str (+ i pos)))
+			     (let ([the-snip snip])
-				 (loop (add1 i))))
+			       (lambda (file line col ppos)
-			     (set! pos (+ pos n))
+				 (if (is-a? the-snip readable-snip<%>)
-			     (when (sl . <= . pos)
+				     (with-handlers ([exn:special-comment?
-			       (next-snip))
+						      (lambda (exn)
-			     n)]
+							;; implies "done"
-			  [(eq? str 'snip)
+							(next-snip)
-			   (let ([the-snip snip])
+							(raise exn))])
-			     (lambda (file line col ppos)
+				       (let-values ([(val size done?)
-			       (if (is-a? the-snip readable-snip<%>)
+						     (send the-snip read-one-special pos file line col ppos)])
-				   (with-handlers ([exn:special-comment?
+					 (if done?
-						    (lambda (exn)
+					     (next-snip)
-						      ;; implies "done"
+					     (set! pos (add1 pos)))
-						      (next-snip)
+					 (values val size)))
-						      (raise exn))])
+				     (begin
-				     (let-values ([(val size done?)
+				       (next-snip)
-						   (send the-snip read-one-special pos file line col ppos)])
+				       (values (send the-snip copy) 1)))))]
-				       (if done?
+			    [else eof]))]
-					   (next-snip)
+	     [close (lambda () (void))]
-					   (set! pos (add1 pos)))
+	     [port (make-custom-input-port 
-				       (values val size)))
+		    (lambda (s)
-				   (begin
+		      (if (char-ready? pipe-r)
-				     (next-snip)
+			  (read-string-avail!* s pipe-r)
-				     (values (send the-snip copy) 1)))))]))]
+			  (parameterize ([break-enabled #f])
-	   [close (lambda () (void))]
+			    (if (semaphore-try-wait? lock-semaphore)
-	   ;; We create a slow port for now; in the future, try
+				(dynamic-wind
-	   ;; grabbing more characters:
+				    void
-	   [port (make-custom-input-port 
+				    (lambda () (read-chars s))
-		  (lambda (s)
+				    (lambda () (semaphore-post lock-semaphore)))
-		    (parameterize ([break-enabled #f])
+				(make-semaphore-peek lock-semaphore)))))
-		      (if (semaphore-try-wait? lock-semaphore)
+		    #f ; no peek
-			  (dynamic-wind
+		    close)])
-			      void
+	(update-str-to-snip)
-			      (lambda () (read-chars s))
+	(port-count-lines! port)
-			      (lambda () (semaphore-post lock-semaphore)))
+	port))]
-			  (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)]))
 

collects/mred/private/kernel.ss

@@ -203,6 +203,7 @@
     num-scroll-lines
     scroll-line-location
     get-snip-location
+    locations-computed?
     in-edit-sequence?
     refresh-delayed?
     end-edit-sequence
@@ -1144,6 +1145,7 @@
     on-event
     size-cache-invalid
     copy
+    get-text!
     get-text
     merge-with
     split
@@ -1181,6 +1183,7 @@
     on-event
     size-cache-invalid
     copy
+    get-text!
     get-text
     merge-with
     split
@@ -1205,6 +1208,7 @@
     on-event
     size-cache-invalid
     copy
+    get-text!
     get-text
     merge-with
     split
@@ -1234,6 +1238,7 @@
     on-event
     size-cache-invalid
     copy
+    get-text!
     get-text
     merge-with
     split
@@ -1276,6 +1281,7 @@
     on-event
     size-cache-invalid
     copy
+    get-text!
     get-text
     merge-with
     split