From 3d4c42a44223e3dfd8f5d245d5912b0319752ca2 Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Sun, 14 Sep 2008 07:50:32 +0000 Subject: [PATCH 1/5] Welcome to a new PLT day. svn: r11746 --- collects/repos-time-stamp/stamp.ss | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/collects/repos-time-stamp/stamp.ss b/collects/repos-time-stamp/stamp.ss index fffd12ecae..0af452cfdc 100644 --- a/collects/repos-time-stamp/stamp.ss +++ b/collects/repos-time-stamp/stamp.ss @@ -1 +1 @@ -#lang scheme/base (provide stamp) (define stamp "13sep2008") +#lang scheme/base (provide stamp) (define stamp "14sep2008") From 18176568c7574833addf125116d400cab84b012b Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sun, 14 Sep 2008 14:15:49 +0000 Subject: [PATCH 2/5] exit status clarifications in reference doc svn: r11747 --- collects/scribblings/reference/startup.scrbl | 21 ++++++++++++++------ 1 file changed, 15 insertions(+), 6 deletions(-) diff --git a/collects/scribblings/reference/startup.scrbl b/collects/scribblings/reference/startup.scrbl index fdc5561c4c..a7cd4531bd 100644 --- a/collects/scribblings/reference/startup.scrbl +++ b/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, -the exit status is @scheme[0] or determined by a call to -@scheme[exit]. +@; ---------------------------------------------------------------------- + +@section[#:tag "exit-status"]{Exit Status} + +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. @; ---------------------------------------------------------------------- From afd3cd372943346fc9e7e0e983ded33c6dd0c9ae Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sun, 14 Sep 2008 14:48:08 +0000 Subject: [PATCH 3/5] release mred internal lock during canvas set-editor super call svn: r11748 --- collects/mred/private/mrcanvas.ss | 1 - collects/mred/private/wxcanvas.ss | 5 ++++- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/collects/mred/private/mrcanvas.ss b/collects/mred/private/mrcanvas.ss index 0d339c66f2..e8e82e196e 100644 --- a/collects/mred/private/mrcanvas.ss +++ b/collects/mred/private/mrcanvas.ss @@ -350,4 +350,3 @@ (vi vertical-inset)) (unless (or (eq? horizontal-inset 5)) (hi horizontal-inset)))))) - diff --git a/collects/mred/private/wxcanvas.ss b/collects/mred/private/wxcanvas.ss index 67889f1357..2f1831ee1d 100644 --- a/collects/mred/private/wxcanvas.ss +++ b/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 From c870eadf03a4edd431674c928df55dd9266b9fff Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Sun, 14 Sep 2008 22:15:20 +0000 Subject: [PATCH 4/5] a nested (test ...) expression is implicitly in a 'do' block for convenicnce svn: r11749 --- collects/tests/lazy/testing.ss | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/collects/tests/lazy/testing.ss b/collects/tests/lazy/testing.ss index 4e93377ad2..1be7f1696b 100644 --- a/collects/tests/lazy/testing.ss +++ b/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 ' Date: Sun, 14 Sep 2008 23:19:42 +0000 Subject: [PATCH 5/5] fixed some bugs in the yellow highlighting svn: r11750 --- collects/framework/private/text.ss | 55 ++++++++++++++++++------------ 1 file changed, 33 insertions(+), 22 deletions(-) diff --git a/collects/framework/private/text.ss b/collects/framework/private/text.ss index db918e29cc..fc8102db33 100644 --- a/collects/framework/private/text.ss +++ b/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? - (send f set-text-to-search this) - (clear-yellow) - (set! clear-yellow void)) - (set! do-yellow? - (and (not on?) - (eq? (send f get-text-to-search) this))) - (update-yellow))) + (set! has-focus? on?) + (cond + [on? + ;; this triggers a call to update-yellow + (send f set-text-to-search this)] + [else + (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? - (let ([start (get-start-position)] - [end (get-end-position)]) - (unless (= start end) - (begin-edit-sequence) - (clear-yellow) - (set! clear-yellow void) - (when searching-str - (when (do-search searching-str start end) - (set! clear-yellow (highlight-range start end "khaki" #f 'low 'ellipse)))) - (end-edit-sequence))))) + (cond + [has-focus? + (unless (eq? clear-yellow void) + (clear-yellow) + (set! clear-yellow void))] + [searching-str + (let ([start (get-start-position)] + [end (get-end-position)]) + (cond + [(= start end) + (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*