Ain't noone going to be saying, "Brady who?", but the Cassel era has

definitely gotten off to a good start, eh?

svn: r11751

collects/framework/private/text.ss

@@ -986,7 +986,6 @@ WARNING: printf is rebound in the body of the unit to always
     (define/augment (on-insert start len)
       (begin-edit-sequence)
       (clear-all-regions) 
-      (update-yellow)
       (inner (void) on-insert start len))
     (define/augment (after-insert start len)
       (unless updating-search?
@@ -1001,7 +1000,6 @@ WARNING: printf is rebound in the body of the unit to always
     (define/augment (after-delete start len)
       (unless updating-search?
         (content-changed))
-      (update-yellow)
       (inner (void) after-delete start len)
       (end-edit-sequence))
     
@@ -1033,17 +1031,16 @@ WARNING: printf is rebound in the body of the unit to always
     (define/override (on-focus on?)
       (let ([f (get-top-level-window)])
         (when (is-a? f frame:searchable<%>)
-          (when on?
+          (set! has-focus? on?)
-            (send f set-text-to-search this)
+          (cond
-            (clear-yellow)
+            [on?
-            (set! clear-yellow void))
+             ;; this triggers a call to update-yellow
-          (set! do-yellow? 
+             (send f set-text-to-search this)]
-                (and (not on?)
+            [else
-                     (eq? (send f get-text-to-search) this)))
+             (update-yellow)])))
-          (update-yellow)))
       (super on-focus on?))
     
-    (define do-yellow? #f)
+    (define has-focus? #f)
     (define clear-yellow void)
     (define/augment (after-set-position)
       (update-yellow)
@@ -1077,17 +1074,29 @@ WARNING: printf is rebound in the body of the unit to always
             (send tlw search-hits-changed)))))
     
     (define/private (update-yellow)
-      (when do-yellow?
+      (cond
-        (let ([start (get-start-position)]
+        [has-focus?
-              [end (get-end-position)])
+         (unless (eq? clear-yellow void)
-          (unless (= start end)
+           (clear-yellow)
-            (begin-edit-sequence)
+           (set! clear-yellow void))]
-            (clear-yellow)
+        [searching-str
-            (set! clear-yellow void)
+         (let ([start (get-start-position)]
-            (when searching-str
+               [end (get-end-position)])
-              (when (do-search searching-str start end)
+           (cond
-                (set! clear-yellow (highlight-range start end "khaki" #f 'low 'ellipse))))
+             [(= start end)
-            (end-edit-sequence)))))
+              (clear-yellow)
+              (set! clear-yellow void)]
+             [else
+              (begin-edit-sequence)
+              (clear-yellow)
+              (set! clear-yellow void)
+              (when (and searching-str (= (string-length searching-str) (- end start)))
+                (when (do-search searching-str start end)
+                  (set! clear-yellow (highlight-range start end "khaki" #f 'low 'ellipse))))
+              (end-edit-sequence)]))]
+        [else
+         (clear-yellow)
+         (set! clear-yellow void)]))
 
     (define/public (get-search-bubbles)
       (sort (hash-map search-bubble-table
@@ -1161,6 +1170,8 @@ WARNING: printf is rebound in the body of the unit to always
                                   'hollow-ellipse)))))]
         [else
          (invalidate-bitmap-cache)])
+      
+      (update-yellow) 
       (end-edit-sequence)
       
       ;; stopping the timer ensures that when there is both an edit to the buffer *and*

collects/mred/private/mrcanvas.ss

@@ -350,4 +350,3 @@
 	  (vi vertical-inset))
 	(unless (or (eq? horizontal-inset 5))
 	  (hi horizontal-inset))))))
-

collects/mred/private/wxcanvas.ss

@@ -117,7 +117,10 @@
 		      [(edit) (l edit #t)]
 		      [(edit redraw?)
 		       (let ([old-edit (get-editor)])
-			 (super set-editor edit redraw?)
+                         ;; An exception here means we end up in a bad state:
+			 (as-exit (lambda () 
+                                    ;; set-editor can invoke callbacks:
+                                    (super set-editor edit redraw?)))
 			 
 			 (let ([mred (wx->mred this)])
 			   (when mred

collects/repos-time-stamp/stamp.ss

@@ -1 +1 @@
-#lang scheme/base (provide stamp) (define stamp "13sep2008")
+#lang scheme/base (provide stamp) (define stamp "14sep2008")

collects/scribblings/reference/startup.scrbl

@@ -14,7 +14,7 @@
 @(define eventspace
    @tech[#:doc '(lib "scribblings/gui/gui.scrbl")]{eventspace})
 
-@title[#:tag "running-sa"]{Starting MzScheme or MrEd}
+@title[#:tag "running-sa"]{Running MzScheme or MrEd}
 
 The core PLT Scheme run-time system is available in two main variants:
 
@@ -90,11 +90,20 @@ timers to stop, @|etc| in the main @|eventspace| by evaluating
 @scheme[(scheme 'yield)]. This waiting step can be suppressed with the
 @Flag{V}/@DFlag{no-yield} command-line flag.
 
-The exit status for the MzScheme or MrEd process indicates an error if
+@; ----------------------------------------------------------------------
-an error occurs during a command-line @scheme[eval], @scheme[load], or
+
-@scheme[require] when no read-eval-print loop is started. Otherwise,
+@section[#:tag "exit-status"]{Exit Status}
-the exit status is @scheme[0] or determined by a call to
+
-@scheme[exit].
+The default exit status for a MzScheme or MrEd process is non-zero if
+an error occurs during a command-line @scheme[eval] (via @Flag{e},
+etc.), @scheme[load] (via @Flag{f}, @Flag{r}, etc.), or
+@scheme[require] (via @Flag{-l}, @Flag{t}, etc.), but only when no
+read-eval-print loop is started. Otherwise, the default exit status is
+@scheme[0].
+
+In all cases, a call to @scheme[exit] (when the default @tech{exit
+handler} is in place) can end the process with a specific status
+value.
 
 @; ----------------------------------------------------------------------
 

collects/tests/lazy/testing.ss

@@ -81,7 +81,10 @@
                [(list* y '<= x r)      (cons (try t2 x y) r)]
                [(list* x '=error> y r) (cons (try te x y) r)]
                [(list* y '<error= x r) (cons (try te x y) r)]
-               [(list* x r)            (cons (try t1 x) r)]
+               [(list* x r) ; if x = (test ...), then it's implicitly in a `do'
+                (syntax-case x (test)
+                  [(test x0 x1 ...) (cons (tb x) r)]
+                  [_ (cons (try t1 x) r)])]
                [(list) '()])])
       (if (pair? t)
         (loop (cdr t) (cons (car t) r))