PR 10406

svn: r15748

original commit: 02e4426d069e50646386b75698a8379c19e68319

collects/framework/main.ss

@@ -1302,7 +1302,8 @@
   ((text)
    ((start 0) (end #f)))
   @{Determines if the range in the editor from @scheme[start] to
-               @scheme[end] in @scheme[text] is a matched set of parenthesis.  If
+               @scheme[end] in @scheme[text] has at least one complete s-expression and
+               there are no incomplete s-expressions.  If
                @scheme[end] is @scheme[#f], it defaults to the last position of the
                @scheme[text].
                

collects/framework/private/scheme.ss

@@ -43,11 +43,13 @@
     (let* ([end (or in-end (send text last-position))]
            [port (open-input-text-editor text start end)])
       (with-handlers ([exn:fail:read:eof? (λ (x) #f)]
-                      [exn:fail:read? (λ (x) #t)])
+                      [exn:fail:read? (λ (x) #f)])
+        (let ([first (read port)])
+          (and (not (eof-object? first))
                (let loop ()
                  (let ([s (read port)])
                    (or (eof-object? s)
-                (loop))))))))
+                       (loop))))))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;                                                                  ;;

collects/tests/framework/README

@@ -71,6 +71,12 @@ signal failures when there aren't any.
   | These tests will make sure that the usual checks against a user
   | losing their work are in place.
 
+- scheme tests:
+
+  | Tests the scheme: section
+
+  |# scheme.ss #|
+
 - |# (interactive #| tests
 
   | these tests require intervention by people. Clicking and whatnot

collects/tests/framework/scheme.ss

@@ -0,0 +1,30 @@
+#lang scheme
+
+(require "test-suite-utils.ss")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; testing highlight-range method
+;;
+
+
+(define (test-text-balanced? number str start end expected)
+  (test
+   (string->symbol (format "scheme:text-balanced?-~a" number))
+   (lambda (x) 
+     (equal? x expected))
+   (λ ()
+     (send-sexp-to-mred
+      `(let ([t (new scheme:text%)])
+         (send t insert ,str)
+         (scheme:text-balanced? t ,start ,end))))))
+
+(test-text-balanced? 0 "" 0 #f #f)
+(test-text-balanced? 1 "  \n " 0 #f #f)
+(test-text-balanced? 2 "foo)" 0 #f #f)
+(test-text-balanced? 3 "(foo" 0 #f #f)
+(test-text-balanced? 4 "(foo)" 0 #f #t)
+(test-text-balanced? 5 "(foo 'bar))" 0 #f #f)
+(test-text-balanced? 6 "(foo) bar ([buz])" 0 #f #t)
+(test-text-balanced? 7 "(foo]" 0 #f #f)
+(test-text-balanced? 8 "{foo} ((bar) [5.9])" 0 #f #t)