diff --git a/collects/drracket/private/rep.rkt b/collects/drracket/private/rep.rkt index 293ba2606e..c8fd16757e 100644 --- a/collects/drracket/private/rep.rkt +++ b/collects/drracket/private/rep.rkt @@ -1312,7 +1312,7 @@ TODO (let ([run-on-user-thread (lambda (t) (queue-user/wait (λ () - (with-handlers ((exn? (λ (x) (printf "~s\n" (exn-message x))))) + (with-handlers ((exn? (λ (x) (oprintf "~s\n" (exn-message x))))) (t)))))]) run-on-user-thread)) @@ -1653,10 +1653,39 @@ TODO (let ([lang (drracket:language-configuration:language-settings-language user-language-settings)] [drr-evtspace (current-eventspace)] [s (make-semaphore 0)]) + + (define-values (sp-err-other-end sp-err) (make-pipe)) + (define-values (sp-out-other-end sp-out) (make-pipe)) + (define io-chan (make-channel)) + + ;; collect the IO to replay later + (thread + (λ () + (let loop ([ports (list sp-err-other-end sp-out-other-end)] + [io '()]) + (cond + [(null? ports) (channel-put io-chan io)] + [else + (apply sync + (map (λ (port) (handle-evt + port + (λ (_) + (define byte (read-byte port)) + (if (eof-object? byte) + (loop (remq port ports) io) + (loop ports (cons (cons port byte) + io)))))) + ports))])))) + (run-in-evaluation-thread (λ () (let/ec k - (parameterize ([error-escape-handler (λ () (k (void)))]) + ;; we set the io ports here to ones that just collect the data + ;; since we're blocking the eventspace handler thread (and thus IO to + ;; the user's ports can deadlock) + (parameterize ([error-escape-handler (λ () (k (void)))] + [current-output-port sp-out] + [current-error-port sp-err]) (cond ;; this is for backwards compatibility; drracket used to ;; expect this method to be a thunk (but that was a bad decision) @@ -1667,7 +1696,21 @@ TODO ;; this is the backwards compatible case. (send lang first-opened)]))) (semaphore-post s))) - (semaphore-wait s)) + + ;; wait for the first-opened method to finish up + (semaphore-wait s) + + ;; close the output ports to get the above thread to terminate + (close-output-port sp-err) + (close-output-port sp-out) + + ;; duplicate it over to the user's ports, now that there is + ;; no danger of deadlock + (for ([i (in-list (reverse (channel-get io-chan)))]) + (write-byte (cdr i) + (if (eq? (car i) sp-err-other-end) + (get-err-port) + (get-out-port))))) (send context enable-evaluation) (end-edit-sequence) diff --git a/collects/framework/private/text.rkt b/collects/framework/private/text.rkt index 9ea667bfc2..47aa6f5203 100644 --- a/collects/framework/private/text.rkt +++ b/collects/framework/private/text.rkt @@ -1825,6 +1825,9 @@ (define-struct committer (kr commit-peeker-evt done-evt resp-chan resp-nack)) (define msec-timeout 500) + +;; this value (4096) is also mentioned in the test suite (collects/tests/framework/test.rkt) +;; so if you change it, be sure to change things over there too (define output-buffer-full 4096) (define-local-member-name @@ -1873,6 +1876,17 @@ (send value-sd set-delta-foreground (make-object color% 0 0 175)) (create-style-name value-style-name value-sd))) +;; data : any +;; to-insert-chan : (or/c #f channel) +;; if to-insert-chan is a channel, this means +;; the eventspace handler thread is the one that +;; is initiating the communication, so instead of +;; queueing a callback to do the update of the editor, +;; just send the work back directly and it will be done +;; syncronously there. If it is #f, then we queue a callback +;; to do the work +(define-struct data/chan (data to-insert-chan)) + (define ports-mixin (mixin (wide-snip<%>) (ports<%>) (inherit begin-edit-sequence @@ -2241,7 +2255,7 @@ (after-io-insertion)))) (define/public (after-io-insertion) (void)) - + (define output-buffer-thread (let ([converter (bytes-open-converter "UTF-8-permissive" "UTF-8")]) (thread @@ -2257,13 +2271,16 @@ (alarm-evt (+ last-flush msec-timeout)) (λ (_) (let-values ([(viable-bytes remaining-queue) (split-queue converter text-to-insert)]) + ;; we always queue the work here since the always event means no one waits for the callback (queue-insertion viable-bytes always-evt) (loop remaining-queue (current-inexact-milliseconds)))))) (handle-evt flush-chan - (λ (return-evt) + (λ (return-evt/to-insert-chan) (let-values ([(viable-bytes remaining-queue) (split-queue converter text-to-insert)]) - (queue-insertion viable-bytes return-evt) + (if (channel? return-evt/to-insert-chan) + (channel-put return-evt/to-insert-chan viable-bytes) + (queue-insertion viable-bytes return-evt/to-insert-chan)) (loop remaining-queue (current-inexact-milliseconds))))) (handle-evt clear-output-chan @@ -2271,16 +2288,22 @@ (loop (empty-queue) (current-inexact-milliseconds)))) (handle-evt write-chan - (λ (pr) + (λ (pr-pr) + (define return-chan (car pr-pr)) + (define pr (cdr pr-pr)) (let ([new-text-to-insert (enqueue pr text-to-insert)]) (cond [((queue-size text-to-insert) . < . output-buffer-full) + (when return-chan + (channel-put return-chan '())) (loop new-text-to-insert last-flush)] [else (let ([chan (make-channel)]) (let-values ([(viable-bytes remaining-queue) (split-queue converter new-text-to-insert)]) - (queue-insertion viable-bytes (channel-put-evt chan (void))) + (if return-chan + (channel-put return-chan viable-bytes) + (queue-insertion viable-bytes (channel-put-evt chan (void)))) (channel-get chan) (loop remaining-queue (current-inexact-milliseconds))))])))))))))) @@ -2300,16 +2323,23 @@ (λ (to-write start end block/buffer? enable-breaks?) (cond [(= start end) (flush-proc)] - [(eq? (current-thread) (eventspace-handler-thread eventspace)) - (error 'write-bytes-proc "cannot write to port on eventspace main thread")] [else - (channel-put write-chan (cons (subbytes to-write start end) style))]) + (define pair (cons (subbytes to-write start end) style)) + (cond + [(eq? (current-thread) (eventspace-handler-thread eventspace)) + (define return-channel (make-channel)) + (thread (λ () (channel-put write-chan (cons return-channel pair)))) + (do-insertion (channel-get return-channel) #f)] + [else + (channel-put write-chan (cons #f pair))])]) (- end start))) (define (flush-proc) (cond [(eq? (current-thread) (eventspace-handler-thread eventspace)) - (error 'flush-proc "cannot flush port on eventspace main thread")] + (define to-insert-channel (make-channel)) + (thread (λ () (channel-put flush-chan to-insert-channel))) + (do-insertion (channel-get to-insert-channel) #f)] [else (sync (nack-guard-evt @@ -2327,17 +2357,18 @@ (define (make-write-special-proc style) (λ (special can-buffer? enable-breaks?) + (define str/snp (cond + [(string? special) special] + [(is-a? special snip%) special] + [else (format "~s" special)])) + (define to-send (cons str/snp style)) (cond [(eq? (current-thread) (eventspace-handler-thread eventspace)) - (error 'write-bytes-proc "cannot write to port on eventspace main thread")] + (define return-chan (make-channel)) + (thread (λ () (channel-put write-chan (cons return-chan to-send)))) + (do-insertion (channel-get return-chan) #f)] [else - (let ([str/snp (cond - [(string? special) special] - [(is-a? special snip%) special] - [else (format "~s" special)])]) - (channel-put - write-chan - (cons str/snp style)))]) + (channel-put write-chan (cons #f to-send))]) #t)) (let* ([add-standard diff --git a/collects/lang/htdp-langs.rkt b/collects/lang/htdp-langs.rkt index 5dfa39c10c..719712085f 100644 --- a/collects/lang/htdp-langs.rkt +++ b/collects/lang/htdp-langs.rkt @@ -439,8 +439,7 @@ (define/override (first-opened settings) (for ([tp (in-list (htdp-lang-settings-teachpacks settings))]) - (with-handlers ((exn:fail? void)) - (namespace-require/constant tp)))) + (namespace-require/constant tp))) (inherit get-module get-transformer-module get-init-code use-namespace-require/copy?) diff --git a/collects/meta/web/download/data.rkt b/collects/meta/web/download/data.rkt index d53ebbab9b..90f3b40a5b 100644 --- a/collects/meta/web/download/data.rkt +++ b/collects/meta/web/download/data.rkt @@ -1,7 +1,8 @@ #lang racket/base (define -versions+dates- - '(["5.0.2" "November 2010"] + '(["5.1" "February 2011"] + ["5.0.2" "November 2010"] ["5.0.1" "August 2010"] ["5.0" "June 2010"] ["4.2.5" "April 2010"] diff --git a/collects/meta/web/download/installers.txt b/collects/meta/web/download/installers.txt index 51e29f1d75..9079a6ade6 100644 --- a/collects/meta/web/download/installers.txt +++ b/collects/meta/web/download/installers.txt @@ -64,3 +64,23 @@ 16M 5.0/racket/racket-5.0-src-mac.dmg 16M 5.0/racket/racket-5.0-src-unix.tgz 20M 5.0/racket/racket-5.0-src-win.zip +11M 5.1/racket-textual/racket-textual-5.1-bin-i386-linux-f12.sh +11M 5.1/racket-textual/racket-textual-5.1-bin-i386-linux-ubuntu-jaunty.sh +11M 5.1/racket-textual/racket-textual-5.1-bin-i386-osx-mac.dmg +7.6M 5.1/racket-textual/racket-textual-5.1-bin-i386-win32.exe +11M 5.1/racket-textual/racket-textual-5.1-bin-ppc-darwin.sh +11M 5.1/racket-textual/racket-textual-5.1-bin-ppc-osx-mac.dmg +11M 5.1/racket-textual/racket-textual-5.1-bin-x86_64-linux-f14.sh +5.8M 5.1/racket-textual/racket-textual-5.1-src-mac.dmg +5.7M 5.1/racket-textual/racket-textual-5.1-src-unix.tgz +5.8M 5.1/racket-textual/racket-textual-5.1-src-win.zip +50M 5.1/racket/racket-5.1-bin-i386-linux-f12.sh +50M 5.1/racket/racket-5.1-bin-i386-linux-ubuntu-jaunty.sh +51M 5.1/racket/racket-5.1-bin-i386-osx-mac.dmg +32M 5.1/racket/racket-5.1-bin-i386-win32.exe +49M 5.1/racket/racket-5.1-bin-ppc-darwin.sh +52M 5.1/racket/racket-5.1-bin-ppc-osx-mac.dmg +50M 5.1/racket/racket-5.1-bin-x86_64-linux-f14.sh +16M 5.1/racket/racket-5.1-src-mac.dmg +16M 5.1/racket/racket-5.1-src-unix.tgz +18M 5.1/racket/racket-5.1-src-win.zip diff --git a/collects/meta/web/www/index.rkt b/collects/meta/web/www/index.rkt index b9762e8840..7adf82dc0e 100644 --- a/collects/meta/web/www/index.rkt +++ b/collects/meta/web/www/index.rkt @@ -89,11 +89,11 @@ (graphical-example ; --------------------------------------------- @code{#lang racket ; A picture (require 2htdp/image) - (let sierpinski ([n 6]) + (let sierpinski ([n 8]) (if (zero? n) - (triangle 2 'solid 'red) - (let ([next (sierpinski (- n 1))]) - (above next (beside next next)))))} + (triangle 2 'solid 'red) + (let ([t (sierpinski (- n 1))]) + (freeze (above t (beside t t))))))} @desc{The @elemcode{2htdp/image} library provides easy-to-use functions for constructing images, and DrRacket can display an image result as easily as it can display a number result. In this case, a diff --git a/collects/planet/planet.scrbl b/collects/planet/planet.scrbl index b13a16b13a..1c4ec2d172 100644 --- a/collects/planet/planet.scrbl +++ b/collects/planet/planet.scrbl @@ -400,10 +400,13 @@ package specifier and the specified directory name. @subsection[#:tag "unlink"]{@exec{unlink}} Usage: -@commandline{raco planet unlink } +@commandline{raco planet unlink [