suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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

Browse Source 
definitely gotten off to a good start, eh?

svn: r11751
This commit is contained in:
Stevie Strickland 2008-09-15 02:44:49 +00:00
commit db5f291867
6 changed files with 57 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

55
collects/framework/private/text.ss
View File

@ -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*

1
collects/mred/private/mrcanvas.ss
View File

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

5
collects/mred/private/wxcanvas.ss
View File

@ -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

2
collects/repos-time-stamp/stamp.ss
View File

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

21
collects/scribblings/reference/startup.scrbl
View File

@ -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.
@; ----------------------------------------------------------------------

5
collects/tests/lazy/testing.ss
View File

@ -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))