diff --git a/collects/compiler/commands/make.rkt b/collects/compiler/commands/make.rkt index 03dd574409..74f2b85ae7 100644 --- a/collects/compiler/commands/make.rkt +++ b/collects/compiler/commands/make.rkt @@ -16,6 +16,8 @@ (define assume-primitives (make-parameter #t)) (define worker-count (make-parameter 1)) +(define mzc-symbol (string->symbol (short-program+command-name))) + (define source-files (command-line #:program (short-program+command-name) @@ -67,9 +69,9 @@ (printf " making ~s\n" (path->string p))))]) (for ([file source-files]) (unless (file-exists? file) - (error 'mzc "file does not exist: ~a" file)) + (error mzc-symbol "file does not exist: ~a" file)) (set! did-one? #f) - (let ([name (extract-base-filename/ss file 'mzc)]) + (let ([name (extract-base-filename/ss file mzc-symbol)]) (when (verbose) (printf "\"~a\":\n" file)) (parameterize ([compile-context-preservation-enabled diff --git a/collects/compiler/commands/pack.rkt b/collects/compiler/commands/pack.rkt index 8a2fa32a50..db68d62889 100644 --- a/collects/compiler/commands/pack.rkt +++ b/collects/compiler/commands/pack.rkt @@ -19,6 +19,8 @@ (define plt-setup-collections (make-parameter null)) (define plt-include-compiled (make-parameter #f)) +(define mzc-symbol (string->symbol (short-program+command-name))) + (define-values (plt-output source-files) (command-line #:program (short-program+command-name) @@ -53,7 +55,7 @@ (begin (for ([fd source-files]) (unless (relative-path? fd) - (error 'mzc + (error mzc-symbol "file/directory is not relative to the current directory: \"~a\"" fd))) (pack-plt plt-output diff --git a/collects/drracket/drracket.rkt b/collects/drracket/drracket.rkt index 1515019ece..80639a1d0e 100644 --- a/collects/drracket/drracket.rkt +++ b/collects/drracket/drracket.rkt @@ -36,14 +36,12 @@ [debugging? (flprintf "PLTDRDEBUG: loading CM to load/create errortrace zos\n") (let-values ([(zo-compile - make-compilation-manager-load/use-compiled-handler - manager-trace-handler) + make-compilation-manager-load/use-compiled-handler) (parameterize ([current-namespace (make-base-empty-namespace)] [use-compiled-file-paths '()]) (values (dynamic-require 'errortrace/zo-compile 'zo-compile) - (dynamic-require 'compiler/cm 'make-compilation-manager-load/use-compiled-handler) - (dynamic-require 'compiler/cm 'manager-trace-handler)))]) + (dynamic-require 'compiler/cm 'make-compilation-manager-load/use-compiled-handler)))]) (flprintf "PLTDRDEBUG: installing CM to load/create errortrace zos\n") (current-compile zo-compile) (use-compiled-file-paths (list (build-path "compiled" "errortrace"))) @@ -55,12 +53,9 @@ (run-trace-thread)))] [install-cm? (flprintf "PLTDRCM: loading compilation manager\n") - (let-values ([(make-compilation-manager-load/use-compiled-handler - manager-trace-handler) - (parameterize ([current-namespace (make-base-empty-namespace)]) - (values - (dynamic-require 'compiler/cm 'make-compilation-manager-load/use-compiled-handler) - (dynamic-require 'compiler/cm 'manager-trace-handler)))]) + (let ([make-compilation-manager-load/use-compiled-handler + (parameterize ([current-namespace (make-base-empty-namespace)]) + (dynamic-require 'compiler/cm 'make-compilation-manager-load/use-compiled-handler))]) (flprintf "PLTDRCM: installing compilation manager\n") (current-load/use-compiled (make-compilation-manager-load/use-compiled-handler)) (when cm-trace? @@ -74,11 +69,9 @@ (filter (λ (x) (regexp-match #rx"rkt$" (path->string x))) (directory-list dir)))) - (define-values (make-compilation-manager-load/use-compiled-handler manager-trace-handler) + (define make-compilation-manager-load/use-compiled-handler (parameterize ([current-namespace (make-base-empty-namespace)]) - (values - (dynamic-require 'compiler/cm 'make-compilation-manager-load/use-compiled-handler) - (dynamic-require 'compiler/cm 'manager-trace-handler)))) + (dynamic-require 'compiler/cm 'make-compilation-manager-load/use-compiled-handler))) (when cm-trace? (flprintf "PLTDRPAR: enabling CM tracing\n") (run-trace-thread)) @@ -93,7 +86,7 @@ (case handler-type [(done) (void)] [else - (printf "msg: ~s\n" msg) + (printf "~a\n" msg) (printf "stdout from compiling ~a:\n~a\n" path out) (flush-output) (fprintf (current-error-port) "stderr from compiling ~a:\n~a\n" path err)]))) diff --git a/collects/framework/private/color.rkt b/collects/framework/private/color.rkt index 1ade5b4ece..4120e3aa3b 100644 --- a/collects/framework/private/color.rkt +++ b/collects/framework/private/color.rkt @@ -320,7 +320,7 @@ added get-regions (sp (+ in-start-pos (sub1 new-token-start))) (ep (+ in-start-pos (sub1 new-token-end)))) (λ () - (change-style color sp ep #f))) + (change-style color sp ep #f))) colors))) ;; Using the non-spec version takes 3 times as long as the spec ;; version. In other words, the new greatly outweighs the tree diff --git a/collects/framework/private/keymap.rkt b/collects/framework/private/keymap.rkt index ab94d1bdfa..54fca114a7 100644 --- a/collects/framework/private/keymap.rkt +++ b/collects/framework/private/keymap.rkt @@ -1127,7 +1127,7 @@ (add "make-read-only" make-read-only) (add "beginning-of-line" beginning-of-line) - (add "selec-to-beginning-of-line" select-to-beginning-of-line) + (add "select-to-beginning-of-line" select-to-beginning-of-line) ; Map keys to functions diff --git a/collects/framework/private/text.rkt b/collects/framework/private/text.rkt index db9e3001b2..9ea667bfc2 100644 --- a/collects/framework/private/text.rkt +++ b/collects/framework/private/text.rkt @@ -3720,7 +3720,7 @@ designates the character that triggers autocompletion ;; draws line numbers on the left hand side of a text% object (define line-numbers-mixin - (mixin ((class->interface text%)) (line-numbers<%>) + (mixin ((class->interface text%) editor:standard-style-list<%>) (line-numbers<%>) (inherit get-visible-line-range get-visible-position-range last-line @@ -3732,7 +3732,7 @@ designates the character that triggers autocompletion set-padding get-padding) - (init-field [line-numbers-color "black"]) + (init-field [line-numbers-color #f]) (init-field [show-line-numbers? #t]) ;; whether the numbers are aligned on the left or right ;; only two values should be 'left or 'right @@ -3774,9 +3774,12 @@ designates the character that triggers autocompletion (define style-change-notify (lambda (style) (unless style (setup-padding)))) - (define/private (get-style-font) - (let* ([style-list (send this get-style-list)] - [std (or (send style-list find-named-style "Standard") + (define/private (get-style) + (let* ([style-list (editor:get-standard-style-list)] + [std (or (send style-list + find-named-style + (editor:get-default-color-style-name)) + (send style-list find-named-style "Standard") (send style-list basic-style))]) ;; If the style changes, we should re-check the width of ;; drawn line numbers: @@ -3785,8 +3788,13 @@ designates the character that triggers autocompletion (send style-list notify-on-change style-change-notify) ;; Avoid registering multiple notifications: (set! notify-registered-in-list style-list)) - ;; Extract the font from the style: - (send std get-font))) + std)) + + (define/private (get-style-foreground) + (send (get-style) get-foreground)) + + (define/private (get-style-font) + (send (get-style) get-font)) (define-struct saved-dc-state (pen font foreground-color)) (define/private (save-dc-state dc) @@ -3799,11 +3807,16 @@ designates the character that triggers autocompletion (send dc set-font (saved-dc-state-font dc-state)) (send dc set-text-foreground (saved-dc-state-foreground-color dc-state))) + (define/private (get-foreground) + (if line-numbers-color + (make-object color% line-numbers-color) + (get-style-foreground))) + ;; set the dc stuff to values we want (define/private (setup-dc dc) (send dc set-pen "black" 1 'solid) (send dc set-font (get-style-font)) - (send dc set-text-foreground (make-object color% line-numbers-color))) + (send dc set-text-foreground (get-foreground))) (define/private (lighter-color color) (define (integer number) @@ -3914,7 +3927,7 @@ designates the character that triggers autocompletion (begin (send dc set-text-foreground (lighter-color (send dc get-text-foreground))) (draw-text view final-x final-y) - (send dc set-text-foreground (make-object color% line-numbers-color))) + (send dc set-text-foreground (get-foreground))) (draw-text view final-x final-y))) (set! last-paragraph (line-paragraph line)))) diff --git a/collects/mred/private/wx/cocoa/frame.rkt b/collects/mred/private/wx/cocoa/frame.rkt index c70d89d277..c6d31f78f9 100644 --- a/collects/mred/private/wx/cocoa/frame.rkt +++ b/collects/mred/private/wx/cocoa/frame.rkt @@ -549,7 +549,7 @@ (define/public (on-activate on?) (void)) - (define/public (set-icon bm1 bm2 [mode 'both]) (void)) ;; FIXME + (define/public (set-icon bm1 [bm2 #f] [mode 'both]) (void)) ;; FIXME (define/override (call-pre-on-event w e) (pre-on-event w e)) diff --git a/collects/mred/private/wx/gtk/clipboard.rkt b/collects/mred/private/wx/gtk/clipboard.rkt index 22264bdf3b..c049a012b1 100644 --- a/collects/mred/private/wx/gtk/clipboard.rkt +++ b/collects/mred/private/wx/gtk/clipboard.rkt @@ -25,7 +25,6 @@ (define _GtkClipboard (_cpointer 'GtkClipboard)) (define _GtkDisplay _pointer) -(define _GtkSelectionData (_cpointer 'GtkSelectionData)) ;; Recent versions of Gtk provide function calls to ;; access data, but use structure when the functions are @@ -38,6 +37,7 @@ [length _int] [display _GtkDisplay])) +(define _GtkSelectionData _GtkSelectionDataT-pointer) (define-gdk gdk_atom_intern (_fun _string _gboolean -> _GdkAtom)) diff --git a/collects/mred/private/wx/gtk/frame.rkt b/collects/mred/private/wx/gtk/frame.rkt index 7db96daf3b..aa334ace6e 100644 --- a/collects/mred/private/wx/gtk/frame.rkt +++ b/collects/mred/private/wx/gtk/frame.rkt @@ -334,7 +334,7 @@ (define big-icon #f) (define small-icon #f) - (define/public (set-icon bm mask [mode 'both]) + (define/public (set-icon bm [mask #f] [mode 'both]) (let ([bm (if mask (let* ([nbm (make-object bitmap% (send bm get-width) diff --git a/collects/mred/private/wx/win32/canvas.rkt b/collects/mred/private/wx/win32/canvas.rkt index 0c5ddba9e9..a6723720ab 100644 --- a/collects/mred/private/wx/win32/canvas.rkt +++ b/collects/mred/private/wx/win32/canvas.rkt @@ -116,7 +116,7 @@ (if hscroll? WS_HSCROLL 0) (if vscroll? WS_VSCROLL 0)) 0 0 w h - (or panel-hwnd (send parent get-hwnd)) + (or panel-hwnd (send parent get-client-hwnd)) #f hInstance #f)) diff --git a/collects/mred/private/wx/win32/frame.rkt b/collects/mred/private/wx/win32/frame.rkt index 712f5ffd4a..8a32696d8f 100644 --- a/collects/mred/private/wx/win32/frame.rkt +++ b/collects/mred/private/wx/win32/frame.rkt @@ -527,7 +527,7 @@ (define small-hicon #f) (define big-hicon #f) - (define/public (set-icon bm mask [mode 'both]) + (define/public (set-icon bm [mask #f] [mode 'both]) (let* ([bg-hbitmap (let* ([bm (make-object bitmap% (send bm get-width) (send bm get-height))] [dc (make-object bitmap-dc% bm)]) diff --git a/collects/racket/contract/private/guts.rkt b/collects/racket/contract/private/guts.rkt index 5ad8a521f3..13177dc58c 100644 --- a/collects/racket/contract/private/guts.rkt +++ b/collects/racket/contract/private/guts.rkt @@ -322,6 +322,24 @@ ([p (in-list (cdr projs))]) (λ (v) (p (proj v)))))))) +(define (first-order-and-proj ctc) + (λ (blame) + (λ (val) + (let loop ([predicates (first-order-and/c-predicates ctc)] + [ctcs (base-and/c-ctcs ctc)]) + (cond + [(null? predicates) val] + [else + (if ((car predicates) val) + (loop (cdr predicates) (cdr ctcs)) + (raise-blame-error + blame + val + "expected <~s>, given ~a, which isn't ~s" + (contract-name ctc) + val + (contract-name (car ctcs))))]))))) + (define (and-stronger? this that) (and (base-and/c? that) (let ([this-ctcs (base-and/c-ctcs this)] @@ -332,6 +350,13 @@ that-ctcs))))) (define-struct base-and/c (ctcs)) +(define-struct (first-order-and/c base-and/c) (predicates) + #:property prop:flat-contract + (build-flat-contract-property + #:projection first-order-and-proj + #:name and-name + #:first-order and-first-order + #:stronger and-stronger?)) (define-struct (chaperone-and/c base-and/c) () #:property prop:chaperone-contract (build-chaperone-contract-property @@ -347,15 +372,14 @@ #:first-order and-first-order #:stronger and-stronger?)) + (define/subexpression-pos-prop (and/c . raw-fs) (let ([contracts (coerce-contracts 'and/c raw-fs)]) (cond [(null? contracts) any/c] [(andmap flat-contract? contracts) (let ([preds (map flat-contract-predicate contracts)]) - (flat-named-contract - (apply build-compound-type-name 'and/c contracts) - (λ (x) (for/and ([pred (in-list preds)]) (pred x)))))] + (make-first-order-and/c contracts preds))] [(andmap chaperone-contract? contracts) (make-chaperone-and/c contracts)] [else (make-impersonator-and/c contracts)]))) diff --git a/collects/racket/private/misc.rkt b/collects/racket/private/misc.rkt index 916c07620d..26aba931c1 100644 --- a/collects/racket/private/misc.rkt +++ b/collects/racket/private/misc.rkt @@ -22,10 +22,17 @@ (lambda (user-stx) (syntax-case** dr #t user-stx () free-identifier=? [(_ . pattern) (syntax/loc user-stx template)] - [_ (let*-values ([(sexpr) (syntax->datum user-stx)] - [(msg) (format - "~.s did not match pattern ~.s" - sexpr (cons (car sexpr) 'pattern))]) + [_ (let*-values + ([(sexpr) (syntax->datum user-stx)] + [(msg) + (if (pair? sexpr) + (format "~.s did not match pattern ~.s" + sexpr (cons (car sexpr) 'pattern)) + (if (symbol? sexpr) + (format "must be used in a pattern ~.s" + (cons sexpr 'pattern)) + (error 'internal-error + "something bad happened")))]) (raise-syntax-error #f msg user-stx))]))))] [(_ (name . ptrn) tmpl) (err "expected an identifier" #'name)] [(_ (name . ptrn)) (err "missing template")] diff --git a/collects/scribblings/drracket/extending.scrbl b/collects/scribblings/drracket/extending.scrbl index f203e69456..43ed019985 100644 --- a/collects/scribblings/drracket/extending.scrbl +++ b/collects/scribblings/drracket/extending.scrbl @@ -1,6 +1,7 @@ #lang scribble/doc @(require "common.ss" (for-label compiler/cm + setup/parallel-build racket/promise)) @title[#:tag "extending-drracket"]{Extending DrRacket} @@ -125,11 +126,20 @@ Several environment variables can affect DrRacket's behavior: @item{@indexed-envvar{PLTDRCM} : When this environment variable is set, DrRacket installs the compilation manager before starting up, which means that the @filepath{.zo} files are automatically - kept up to date, as DrRacket's (or a tools) source is modified. + kept up to date, as DrRacket's (or a tool's) source is modified. - If the variable is set to @litchar{trace} then the compilation - manager's output is traced, using the - @racket[manager-trace-handler] procedure.} + If the variable is set to @litchar{trace} then the files that are + actually recompiled are shown.} + + @item{@indexed-envvar{PLTDRPAR} : When this environment variable is + set, DrRacket uses @racket[parallel-compile-files] to compile + the framework and the drracket collections in parallel and then + installs the compilation manager before starting + up, which means that the @filepath{.zo} files are automatically + kept up to date, as DrRacket's (or a tool's) source is modified. + + If the variable is set to @litchar{trace} then the files that are + actually recompiled are shown.} @item{@indexed-envvar{PLTDRDEBUG} : When this environment variable is set, DrRacket starts up with errortrace enabled. If the diff --git a/collects/scribblings/reference/port-lib.scrbl b/collects/scribblings/reference/port-lib.scrbl index 7582c76faa..0ebcd079bf 100644 --- a/collects/scribblings/reference/port-lib.scrbl +++ b/collects/scribblings/reference/port-lib.scrbl @@ -14,8 +14,8 @@ @defproc[(port->list [r (input-port? . -> . any/c) read] [in input-port? (current-input-port)]) (listof any/c)]{ -Returns a list whose elements are produced by calling @scheme[r] -on @scheme[in] until it produces @scheme[eof]. +Returns a list whose elements are produced by calling @racket[r] +on @racket[in] until it produces @racket[eof]. @examples[#:eval port-eval (define (read-number input-port) @@ -28,14 +28,14 @@ on @scheme[in] until it produces @scheme[eof]. @defproc[(port->string [in input-port? (current-input-port)]) string?]{ -Reads all characters from @scheme[in] and returns them as a string. +Reads all characters from @racket[in] and returns them as a string. @examples[#:eval port-eval (port->string (open-input-string "hello world")) ]} @defproc[(port->bytes [in input-port? (current-input-port)]) bytes?]{ -Reads all bytes from @scheme[in] and returns them as a @tech{byte string}. +Reads all bytes from @racket[in] and returns them as a @tech{byte string}. @examples[#:eval port-eval (port->bytes (open-input-string "hello world")) @@ -45,10 +45,10 @@ Reads all bytes from @scheme[in] and returns them as a @tech{byte string}. [#:line-mode line-mode (or/c 'linefeed 'return 'return-linefeed 'any 'any-one) 'any]) (listof string?)]{ -Read all characters from @scheme[in], breaking them into lines. The -@scheme[line-mode] argument is the same as the second argument to -@scheme[read-line], but the default is @scheme['any] instead of -@scheme['linefeed]. +Read all characters from @racket[in], breaking them into lines. The +@racket[line-mode] argument is the same as the second argument to +@racket[read-line], but the default is @racket['any] instead of +@racket['linefeed]. @examples[#:eval port-eval (port->lines @@ -59,8 +59,8 @@ Read all characters from @scheme[in], breaking them into lines. The [#:line-mode line-mode (or/c 'linefeed 'return 'return-linefeed 'any 'any-one) 'any]) (listof bytes?)]{ -Like @scheme[port->lines], but reading bytes and collecting them into -lines like @scheme[read-bytes-line]. +Like @racket[port->lines], but reading bytes and collecting them into +lines like @racket[read-bytes-line]. @examples[#:eval port-eval (port->bytes-lines @@ -72,35 +72,35 @@ lines like @scheme[read-bytes-line]. [#:separator separator any/c #"\n"]) void?]{ -Use @scheme[display] to each each element of @scheme[lst] to @scheme[out], adding -@scheme[separator] after each element.} +Use @racket[display] to each each element of @racket[lst] to @racket[out], adding +@racket[separator] after each element.} @defproc[(call-with-output-string [proc (output-port? . -> . any)]) string?]{ -Calls @scheme[proc] with an output port that accumulates all output +Calls @racket[proc] with an output port that accumulates all output into a string, and returns the string. -The port passed to @scheme[proc] is like the one created by -@scheme[open-output-string], except that it is wrapped via -@scheme[dup-output-port], so that @scheme[proc] cannot access the -port's content using @scheme[get-output-string]. If control jumps back -into @scheme[proc], the port continues to accumulate new data, and -@scheme[call-with-output-string] returns both the old data and newly +The port passed to @racket[proc] is like the one created by +@racket[open-output-string], except that it is wrapped via +@racket[dup-output-port], so that @racket[proc] cannot access the +port's content using @racket[get-output-string]. If control jumps back +into @racket[proc], the port continues to accumulate new data, and +@racket[call-with-output-string] returns both the old data and newly accumulated data.} @defproc[(call-with-output-bytes [proc (output-port? . -> . any)]) bytes?]{ -Like @scheme[call-with-output-string], but returns accumulated results +Like @racket[call-with-output-string], but returns accumulated results in a @tech{byte string} instead of a string. Furthermore, the port's -content is emptied when @scheme[call-with-output-bytes] returns, so -that if control jumps back into @scheme[proc] and returns a second +content is emptied when @racket[call-with-output-bytes] returns, so +that if control jumps back into @racket[proc] and returns a second time, only the newly accumulated bytes are returned.} @defproc[(with-output-to-string [proc (-> any)]) string?]{ Equivalent to -@schemeblock[(call-with-output-string +@racketblock[(call-with-output-string (lambda (p) (parameterize ([current-output-port p]) (proc))))]} @@ -108,30 +108,30 @@ Equivalent to Equivalent to -@schemeblock[(call-with-output-bytes +@racketblock[(call-with-output-bytes (lambda (p) (parameterize ([current-output-port p]) (proc))))]} @defproc[(call-with-input-string [str string?] [proc (input-port? . -> . any)]) any]{ -Equivalent to @scheme[(proc (open-input-string str))].} +Equivalent to @racket[(proc (open-input-string str))].} @defproc[(call-with-input-bytes [bstr bytes?] [proc (input-port? . -> . any)]) any]{ -Equivalent to @scheme[(proc (open-input-bytes bstr))].} +Equivalent to @racket[(proc (open-input-bytes bstr))].} @defproc[(with-input-from-string [str string?] [proc (-> any)]) any]{ Equivalent to -@schemeblock[(parameterize ([current-input-port (open-input-string str)]) +@racketblock[(parameterize ([current-input-port (open-input-string str)]) (proc))]} @defproc[(with-input-from-bytes [bstr bytes?] [proc (-> any)]) any]{ Equivalent to -@schemeblock[(parameterize ([current-input-port (open-input-bytes str)]) +@racketblock[(parameterize ([current-input-port (open-input-bytes str)]) (proc))]} @@ -143,13 +143,13 @@ Equivalent to Takes any number of input ports and returns an input port. Reading from the input port draws bytes (and special non-byte values) from the -given input ports in order. If @scheme[close-at-eof?] is true, then +given input ports in order. If @racket[close-at-eof?] is true, then each port is closed when an end-of-file is encountered from the port, or when the result input port is closed. Otherwise, data not read from the returned input port remains available for reading in its original input port. -See also @scheme[merge-input], which interleaves data from multiple +See also @racket[merge-input], which interleaves data from multiple input ports as it becomes available.} @@ -196,39 +196,39 @@ input ports as it becomes available.} #f]) input-port?]{ -Similar to @scheme[make-input-port], but if the given @scheme[read-in] -returns an event, the event's value must be @scheme[0]. The resulting +Similar to @racket[make-input-port], but if the given @racket[read-in] +returns an event, the event's value must be @racket[0]. The resulting port's peek operation is implemented automatically (in terms of -@scheme[read-in]) in a way that can handle special non-byte +@racket[read-in]) in a way that can handle special non-byte values. The progress-event and commit operations are also implemented automatically. The resulting port is thread-safe, but not kill-safe (i.e., if a thread is terminated or suspended while using the port, the port may become damaged). -The @scheme[read-in], @scheme[close], @scheme[get-location], -@scheme[count-lines!], @scheme[init-position], and -@scheme[buffer-mode] procedures are the same as for -@scheme[make-input-port]. +The @racket[read-in], @racket[close], @racket[get-location], +@racket[count-lines!], @racket[init-position], and +@racket[buffer-mode] procedures are the same as for +@racket[make-input-port]. -The @scheme[fast-peek] argument can be either @scheme[#f] or a +The @racket[fast-peek] argument can be either @racket[#f] or a procedure of three arguments: a byte string to receive a peek, a skip -count, and a procedure of two arguments. The @scheme[fast-peek] +count, and a procedure of two arguments. The @racket[fast-peek] procedure can either implement the requested peek, or it can dispatch -to its third argument to implement the peek. The @scheme[fast-peek] is +to its third argument to implement the peek. The @racket[fast-peek] is not used when a peek request has an associated progress event. -The @scheme[buffering?] argument determines whether @scheme[read-in] +The @racket[buffering?] argument determines whether @racket[read-in] can be called to read more characters than are immediately demanded by -the user of the new port. If @scheme[buffer-mode] is not @scheme[#f], -then @scheme[buffering?] determines the initial buffer mode, and -@scheme[buffering?] is enabled after a buffering change only if the -new mode is @scheme['block]. +the user of the new port. If @racket[buffer-mode] is not @racket[#f], +then @racket[buffering?] determines the initial buffer mode, and +@racket[buffering?] is enabled after a buffering change only if the +new mode is @racket['block]. -If @scheme[on-consumed] is not @scheme[#f], it is called when data is +If @racket[on-consumed] is not @racket[#f], it is called when data is read from the port, as opposed to merely peeked. The argument to -@scheme[on-consumed] is the result value of the port's reading +@racket[on-consumed] is the result value of the port's reading procedure, so it can be an integer or any result from -@scheme[read-in].} +@racket[read-in].} @defproc[(make-limited-input-port [in input-port?] @@ -236,17 +236,17 @@ procedure, so it can be an integer or any result from [close-orig? any/c #t]) input-port?]{ -Returns a port whose content is drawn from @scheme[in], but where an -end-of-file is reported after @scheme[limit] bytes (and non-byte -special values) are read. If @scheme[close-orig?] is true, then the +Returns a port whose content is drawn from @racket[in], but where an +end-of-file is reported after @racket[limit] bytes (and non-byte +special values) are read. If @racket[close-orig?] is true, then the original port is closed if the returned port is closed. -Bytes are consumed from @scheme[in] only when they are consumed from +Bytes are consumed from @racket[in] only when they are consumed from the returned port. In particular, peeking into the returned port peeks into the original port. -If @scheme[in] is used directly while the resulting port is also used, -then the @scheme[limit] bytes provided by the port need not be +If @racket[in] is used directly while the resulting port is also used, +then the @racket[limit] bytes provided by the port need not be contiguous parts of the original port's stream.} @@ -257,17 +257,17 @@ contiguous parts of the original port's stream.} (values input-port? output-port?)]{ Returns two ports: an input port and an output port. The ports behave -like those returned by @scheme[make-pipe], except that the ports +like those returned by @racket[make-pipe], except that the ports support non-byte values written with procedures such as -@scheme[write-special] and read with procedures such as -@scheme[get-byte-or-special]. +@racket[write-special] and read with procedures such as +@racket[get-byte-or-special]. -The @scheme[limit] argument determines the maximum capacity of the +The @racket[limit] argument determines the maximum capacity of the pipe in bytes, but this limit is disabled if special values are -written to the pipe before @scheme[limit] is reached. The limit is +written to the pipe before @racket[limit] is reached. The limit is re-enabled after the special value is read from the pipe. -The optional @scheme[in-name] and @scheme[out-name] arguments +The optional @racket[in-name] and @racket[out-name] arguments determine the names of the result ports.} @@ -285,15 +285,15 @@ new port. After an end-of-file has been read from both original ports, the new port returns end-of-file. Closing the merged port does not close the original ports. -The optional @scheme[buffer-limit] argument limits the number of bytes -to be buffered from @scheme[a-in] and @scheme[b-in], so that the merge +The optional @racket[buffer-limit] argument limits the number of bytes +to be buffered from @racket[a-in] and @racket[b-in], so that the merge process does not advance arbitrarily beyond the rate of consumption of -the merged data. A @scheme[#f] value disables the limit. As for -@scheme[make-pipe-with-specials], @scheme[buffer-limit] does not apply +the merged data. A @racket[#f] value disables the limit. As for +@racket[make-pipe-with-specials], @racket[buffer-limit] does not apply when a special value is produced by one of the input ports before the limit is reached. -See also @scheme[input-port-append], which concatenates input streams +See also @racket[input-port-append], which concatenates input streams instead of interleaving them.} @@ -304,9 +304,9 @@ instead of interleaving them.} '("Opening a null output port")]{ Creates} and returns an output port that discards all output sent to it -(without blocking). The @scheme[name] argument is used as the port's -name. If the @scheme[special-ok?] argument is true, then the -resulting port supports @scheme[write-special], otherwise it does not.} +(without blocking). The @racket[name] argument is used as the port's +name. If the @racket[special-ok?] argument is true, then the +resulting port supports @racket[write-special], otherwise it does not.} @defproc[(peeking-input-port [in input-port?] @@ -315,14 +315,37 @@ resulting port supports @scheme[write-special], otherwise it does not.} input-port]{ Returns an input port whose content is determined by peeking into -@scheme[in]. In other words, the resulting port contains an internal -skip count, and each read of the port peeks into @scheme[in] with the +@racket[in]. In other words, the resulting port contains an internal +skip count, and each read of the port peeks into @racket[in] with the internal skip count, and then increments the skip count according to the amount of data successfully peeked. -The optional @scheme[name] argument is the name of the resulting -port. The @scheme[skip] argument is the port initial skip count, and -it defaults to @scheme[0].} +The optional @racket[name] argument is the name of the resulting +port. The @racket[skip] argument is the port initial skip count, and +it defaults to @racket[0]. + +The resulting port's initial position is @racket[0], no matter the +position of @racket[in]. + +For example, when you read from a peeking port, you +see the same answers as when you read from the original port. + +@examples[#:eval port-eval +(define an-original-port (open-input-string "123456789")) +(define a-peeking-port (peeking-input-port an-original-port)) +(read-string 3 a-peeking-port) +(read-string 3 an-original-port)] + +But beware, the read from the original port is invisible to the peeking +port, which keeps its own separate internal counter, and thus +interleaving reads on the two ports can produce confusing results. +Continuing the example before, if we read three more characters from +the peeking port, we end up skipping over the @litchar{456} in the port. + +@examples[#:eval port-eval +(read-string 3 a-peeking-port) +] +} @@ -336,24 +359,24 @@ it defaults to @scheme[0].} (lambda (msg port) (error ...))]) input-port?]{ -Produces an input port that draws bytes from @scheme[in], but converts -the byte stream using @scheme[(bytes-open-converter encoding-str -"UTF-8")]. In addition, if @scheme[convert-newlines?] is true, then -decoded sequences that correspond to UTF-8 encodings of @scheme["\r\n"], -@scheme["\r\x85"], @scheme["\r"], @scheme["\x85"], and @scheme["\u2028"] -are all converted to the UTF-8 encoding of @scheme["\n"]. +Produces an input port that draws bytes from @racket[in], but converts +the byte stream using @racket[(bytes-open-converter encoding-str +"UTF-8")]. In addition, if @racket[convert-newlines?] is true, then +decoded sequences that correspond to UTF-8 encodings of @racket["\r\n"], +@racket["\r\x85"], @racket["\r"], @racket["\x85"], and @racket["\u2028"] +are all converted to the UTF-8 encoding of @racket["\n"]. -If @scheme[error-bytes] is provided and not @scheme[#f], then the -given byte sequence is used in place of bytes from @scheme[in] that +If @racket[error-bytes] is provided and not @racket[#f], then the +given byte sequence is used in place of bytes from @racket[in] that trigger conversion errors. Otherwise, if a conversion is encountered, -@scheme[enc-error] is called, which must raise an exception. +@racket[enc-error] is called, which must raise an exception. -If @scheme[close?] is true, then closing the result input port also -closes @scheme[in]. The @scheme[name] argument is used as the name of +If @racket[close?] is true, then closing the result input port also +closes @racket[in]. The @racket[name] argument is used as the name of the result input port. In non-buffered mode, the resulting input port attempts to draw bytes -from @scheme[in] only as needed to satisfy requests. Toward that end, +from @racket[in] only as needed to satisfy requests. Toward that end, the input port assumes that at least @math{n} bytes must be read to satisfy a request for @math{n} bytes. (This is true even if the port has already drawn some bytes, as long as those bytes form an @@ -370,30 +393,30 @@ incomplete encoding sequence.)} (lambda (msg port) (error ...))]) output-port?]{ -Produces an output port that directs bytes to @scheme[out], but -converts its byte stream using @scheme[(bytes-open-converter "UTF-8" -encoding-str)]. In addition, if @scheme[newline-bytes] is not -@scheme[#f], then byets written to the port that are the UTF-8 -encoding of @scheme["\n"] are first converted to -@scheme[newline-bytes] (before applying the convert from UTF-8 to -@scheme[encoding-str]). +Produces an output port that directs bytes to @racket[out], but +converts its byte stream using @racket[(bytes-open-converter "UTF-8" +encoding-str)]. In addition, if @racket[newline-bytes] is not +@racket[#f], then byets written to the port that are the UTF-8 +encoding of @racket["\n"] are first converted to +@racket[newline-bytes] (before applying the convert from UTF-8 to +@racket[encoding-str]). -If @scheme[error-bytes] is provided and not @scheme[#f], then the +If @racket[error-bytes] is provided and not @racket[#f], then the given byte sequence is used in place of bytes send to the output port -that trigger conversion errors. Otherwise, @scheme[enc-error] is +that trigger conversion errors. Otherwise, @racket[enc-error] is called, which must raise an exception. -If @scheme[close?] is true, then closing the result output port also -closes @scheme[out]. The @scheme[name] argument is used as the name of +If @racket[close?] is true, then closing the result output port also +closes @racket[out]. The @racket[name] argument is used as the name of the result output port. The resulting port supports buffering, and the initial buffer mode is -@scheme[(or (file-stream-buffer-mode out) 'block)]. In @scheme['block] +@racket[(or (file-stream-buffer-mode out) 'block)]. In @racket['block] mode, the port's buffer is flushed only when it is full or a flush is -requested explicitly. In @scheme['line] mode, the buffer is flushed +requested explicitly. In @racket['line] mode, the buffer is flushed whenever a newline or carriage-return byte is written to the port. In -@scheme['none] mode, the port's buffer is flushed after every write. -Implicit flushes for @scheme['line] or @scheme['none] leave bytes in +@racket['none] mode, the port's buffer is flushed after every write. +Implicit flushes for @racket['line] or @racket['none] leave bytes in the buffer when they are part of an incomplete encoding sequence. The resulting output port does not support atomic writes. An explicit @@ -405,13 +428,13 @@ recently written bytes form an incomplete encoding sequence.} [close? any/c #f]) input-port?]{ -Returns an input port that draws directly from @scheme[in]. Closing -the resulting port closes @scheme[in] only if @scheme[close?] is -@scheme[#t]. +Returns an input port that draws directly from @racket[in]. Closing +the resulting port closes @racket[in] only if @racket[close?] is +@racket[#t]. The new port is initialized with the @tech{port read handler} of -@scheme[in], but setting the handler on the result port does not -affect reading directly from @scheme[in].} +@racket[in], but setting the handler on the result port does not +affect reading directly from @racket[in].} @defproc[(dup-output-port [out output-port?] @@ -419,12 +442,12 @@ affect reading directly from @scheme[in].} output-port?]{ Returns an output port that propagates data directly to -@scheme[out]. Closing the resulting port closes @scheme[out] only if -@scheme[close?] is @scheme[#t]. +@racket[out]. Closing the resulting port closes @racket[out] only if +@racket[close?] is @racket[#t]. The new port is initialized with the @tech{port display handler} and -@tech{port write handler} of @scheme[out], but setting the handlers on -the result port does not affect writing directly to @scheme[out].} +@tech{port write handler} of @racket[out], but setting the handlers on +the result port does not affect writing directly to @racket[out].} @@ -435,27 +458,27 @@ the result port does not affect writing directly to @scheme[out].} [close? any/c #t]) input-port?]{ -Produces an input port that is equivalent to @scheme[in] except in how +Produces an input port that is equivalent to @racket[in] except in how it reports location information. The resulting port's content starts -with the remaining content of @scheme[in], and it starts at the given -line, column, and position. A @scheme[#f] for the line or column means -that the line and column will always be reported as @scheme[#f]. +with the remaining content of @racket[in], and it starts at the given +line, column, and position. A @racket[#f] for the line or column means +that the line and column will always be reported as @racket[#f]. -The @scheme[line] and @scheme[column] values are used only if line -counting is enabled for @scheme[in] and for the resulting port, -typically through @scheme[port-count-lines!]. The @scheme[column] +The @racket[line] and @racket[column] values are used only if line +counting is enabled for @racket[in] and for the resulting port, +typically through @racket[port-count-lines!]. The @racket[column] value determines the column for the first line (i.e., the one numbered -@scheme[line]), and later lines start at column @scheme[0]. The given -@scheme[position] is used even if line counting is not enabled. +@racket[line]), and later lines start at column @racket[0]. The given +@racket[position] is used even if line counting is not enabled. When line counting is on for the resulting port, reading from -@scheme[in] instead of the resulting port increments location reports +@racket[in] instead of the resulting port increments location reports from the resulting port. Otherwise, the resulting port's position does -not increment when data is read from @scheme[in]. +not increment when data is read from @racket[in]. -If @scheme[close?] is true, then closing the resulting port also -closes @scheme[in]. If @scheme[close?] is @scheme[#f], then closing -the resulting port does not close @scheme[in].} +If @racket[close?] is true, then closing the resulting port also +closes @racket[in]. If @racket[close?] is @racket[#f], then closing +the resulting port does not close @racket[in].} @defproc[(relocate-output-port [out output-port?] @@ -465,7 +488,7 @@ the resulting port does not close @scheme[in].} [close? any/c #t]) output-port?]{ -Like @scheme[relocate-input-port], but for output ports.} +Like @racket[relocate-input-port], but for output ports.} @defproc[(transplant-input-port [in input-port?] @@ -481,15 +504,15 @@ Like @scheme[relocate-input-port], but for output ports.} [count-lines! (-> any) void]) input-port?]{ -Like @scheme[relocate-input-port], except that arbitrary position +Like @racket[relocate-input-port], except that arbitrary position information can be produced (when line counting is enabled) via -@scheme[get-location], which used as for @scheme[make-input-port]. If -@scheme[get-location] is @scheme[#f], then the port counts lines in -the usual way starting from @scheme[init-pos], independent of -locations reported by @scheme[in]. +@racket[get-location], which used as for @racket[make-input-port]. If +@racket[get-location] is @racket[#f], then the port counts lines in +the usual way starting from @racket[init-pos], independent of +locations reported by @racket[in]. -If @scheme[count-lines!] is supplied, it is called when line counting -is enabled for the resulting port. The default is @scheme[void].} +If @racket[count-lines!] is supplied, it is called when line counting +is enabled for the resulting port. The default is @racket[void].} @defproc[(transplant-output-port [in input-port?] [get-location (or/c @@ -504,7 +527,7 @@ is enabled for the resulting port. The default is @scheme[void].} [count-lines! (-> any) void]) output-port?]{ -Like @scheme[transplant-input-port], but for output ports.} +Like @racket[transplant-input-port], but for output ports.} @defproc[(filter-read-input-port [in input-port?] [read-wrap (bytes? (or/c exact-nonnegative-integer? @@ -549,10 +572,10 @@ closes @racket[in].} [close? any/c #t]) input-port?]{ -Produces an input port that that is equivalent to @scheme[in], except -that when @scheme[in] produces a procedure to access a special value, -@scheme[proc] is applied to the procedure to allow the special value -to be replaced with an alternative. The @scheme[proc] is called with +Produces an input port that that is equivalent to @racket[in], except +that when @racket[in] produces a procedure to access a special value, +@racket[proc] is applied to the procedure to allow the special value +to be replaced with an alternative. The @racket[proc] is called with the special-value procedure and the byte string that was given to the port's read or peek function (see @racket[make-input-port]), and the result is used as te read or peek function's result. The @@ -560,7 +583,7 @@ result is used as te read or peek function's result. The special value, but the byte string is guaranteed only to hold at least one byte. -If @scheme[close?] is true, then closing the resulting input port also +If @racket[close?] is true, then closing the resulting input port also closes @racket[in].} @; ---------------------------------------------------------------------- @@ -571,23 +594,23 @@ closes @racket[in].} @defproc[(eof-evt [in input-port?]) evt?]{ Returns a @tech{synchronizable event} is that is ready when -@scheme[in] produces an @scheme[eof]. If @scheme[in] produces a -mid-stream @scheme[eof], the @scheme[eof] is consumed by the event +@racket[in] produces an @racket[eof]. If @racket[in] produces a +mid-stream @racket[eof], the @racket[eof] is consumed by the event only if the event is chosen in a synchronization.} @defproc[(read-bytes-evt [k exact-nonnegative-integer?] [in input-port?]) evt?]{ -Returns a @tech{synchronizable event} is that is ready when @scheme[k] -bytes can be read from @scheme[in], or when an end-of-file is -encountered in @scheme[in]. If @scheme[k] is @scheme[0], then the -event is ready immediately with @scheme[""]. For non-zero @scheme[k], +Returns a @tech{synchronizable event} is that is ready when @racket[k] +bytes can be read from @racket[in], or when an end-of-file is +encountered in @racket[in]. If @racket[k] is @racket[0], then the +event is ready immediately with @racket[""]. For non-zero @racket[k], if no bytes are available before an end-of-file, the event's result is -@scheme[eof]. Otherwise the event's result is a byte string of up to -@scheme[k] bytes, which contains as many bytes as are available (up to -@scheme[k]) before an available end-of-file. (The result is a byte -string on less than @scheme[k] bytes only when an end-of-file is +@racket[eof]. Otherwise the event's result is a byte string of up to +@racket[k] bytes, which contains as many bytes as are available (up to +@racket[k]) before an available end-of-file. (The result is a byte +string on less than @racket[k] bytes only when an end-of-file is encountered.) Bytes are read from the port if and only if the event is chosen in a @@ -598,7 +621,7 @@ The event can be synchronized multiple times---event concurrently---and each synchronization corresponds to a distinct read request. -The @scheme[in] must support progress events, and it must not produce +The @racket[in] must support progress events, and it must not produce a special non-byte value during the read attempt.} @@ -606,14 +629,14 @@ a special non-byte value during the read attempt.} [in input-port?]) evt?]{ -Like @scheme[read-bytes-evt], except that the read bytes are placed -into @scheme[bstr], and the number of bytes to read corresponds to -@scheme[(bytes-length bstr)]. The event's result is either -@scheme[eof] or the number of read bytes. +Like @racket[read-bytes-evt], except that the read bytes are placed +into @racket[bstr], and the number of bytes to read corresponds to +@racket[(bytes-length bstr)]. The event's result is either +@racket[eof] or the number of read bytes. -The @scheme[bstr] may be mutated any time after the first +The @racket[bstr] may be mutated any time after the first synchronization attempt on the event. If the event is not synchronized -multiple times concurrently, @scheme[bstr-bytes] is never mutated by +multiple times concurrently, @racket[bstr-bytes] is never mutated by the event after it is chosen in a synchronization (no matter how many synchronization attempts preceded the choice). Thus, the event may be sensibly used multiple times until a successful choice, but should not @@ -623,15 +646,15 @@ be used in multiple concurrent synchronizations.} @defproc[(read-bytes-avail!-evt [bstr (and/c bytes? (not/c immutable?))] [in input-port?]) evt?]{ -Like @scheme[read-bytes!-evt], except that the event reads only as +Like @racket[read-bytes!-evt], except that the event reads only as many bytes as are immediately available, after at least one byte or -one @scheme[eof] becomes available.} +one @racket[eof] becomes available.} @defproc[(read-string-evt [k exact-nonnegative-integer?] [in input-port?]) evt?]{ -Like @scheme[read-bytes-evt], but for character strings instead of +Like @racket[read-bytes-evt], but for character strings instead of byte strings.} @@ -639,7 +662,7 @@ byte strings.} [in input-port?]) evt?]{ -Like @scheme[read-bytes!-evt], but for a character string instead of +Like @racket[read-bytes!-evt], but for a character string instead of a byte string.} @@ -648,8 +671,8 @@ a byte string.} evt?]{ Returns a @tech{synchronizable event} that is ready when a line of -characters or end-of-file can be read from @scheme[inport]. The -meaning of @scheme[mode] is the same as for @scheme[read-line]. The +characters or end-of-file can be read from @racket[inport]. The +meaning of @racket[mode] is the same as for @racket[read-line]. The event result is the read line of characters (not including the line separator). @@ -662,7 +685,7 @@ bytes in the port's stream.} [mode (or/c 'linefeed 'return 'return-linefeed 'any 'any-one)]) evt?]{ -Like @scheme[read-line-evt], but returns a byte string instead of a +Like @racket[read-line-evt], but returns a byte string instead of a string.} @defproc*[([(peek-bytes-evt [k exact-nonnegative-integer?] [skip exact-nonnegative-integer?] @@ -674,11 +697,11 @@ string.} [(peek-string-evt [k exact-nonnegative-integer?] [in input-port?]) evt?] [(peek-string!-evt [str (and/c string? (not/c immutable?))] [in input-port?]) evt?])]{ -Like the @scheme[read-...-evt] functions, but for peeking. The -@scheme[skip] argument indicates the number of bytes to skip, and -@scheme[progress] indicates an event that effectively cancels the peek -(so that the event never becomes ready). The @scheme[progress] -argument can be @scheme[#f], in which case the event is never +Like the @racket[read-...-evt] functions, but for peeking. The +@racket[skip] argument indicates the number of bytes to skip, and +@racket[progress] indicates an event that effectively cancels the peek +(so that the event never becomes ready). The @racket[progress] +argument can be @racket[#f], in which case the event is never cancelled.} @@ -686,12 +709,12 @@ cancelled.} [in input-port?]) any]{ Returns a @tech{synchronizable event} that is ready when -@scheme[pattern] matches the stream of bytes/characters from -@scheme[in]; see also @scheme[regexp-match]. The event's value is the +@racket[pattern] matches the stream of bytes/characters from +@racket[in]; see also @racket[regexp-match]. The event's value is the result of the match, in the same form as the result of -@scheme[regexp-match]. +@racket[regexp-match]. -If @scheme[pattern] does not require a start-of-stream match, then +If @racket[pattern] does not require a start-of-stream match, then bytes skipped to complete the match are read and discarded when the event is chosen in a synchronization. @@ -699,16 +722,16 @@ Bytes are read from the port if and only if the event is chosen in a synchronization, and the returned match always represents contiguous bytes in the port's stream. If not-yet-available bytes from the port might contribute to the match, the event is not ready. Similarly, if -@scheme[pattern] begins with a start-of-stream @litchar{^} and the -@scheme[pattern] does not initially match, then the event cannot +@racket[pattern] begins with a start-of-stream @litchar{^} and the +@racket[pattern] does not initially match, then the event cannot become ready until bytes have been read from the port. The event can be synchronized multiple times---even concurrently---and each synchronization corresponds to a distinct match request. -The @scheme[in] port must support progress events. If @scheme[in] +The @racket[in] port must support progress events. If @racket[in] returns a special non-byte value during the match attempt, it is -treated like @scheme[eof].} +treated like @racket[eof].} @; ---------------------------------------------------------------------- @@ -720,35 +743,35 @@ treated like @scheme[eof].} [out output-port?]) void?]{ -Reads data from @scheme[in], converts it using -@scheme[(bytes-open-converter from-encoding-string +Reads data from @racket[in], converts it using +@racket[(bytes-open-converter from-encoding-string to-encoding-string)] and writes the converted bytes to -@scheme[out]. The @scheme[convert-stream] procedure returns after -reaching @scheme[eof] in @scheme[in]. +@racket[out]. The @racket[convert-stream] procedure returns after +reaching @racket[eof] in @racket[in]. If opening the converter fails, the @exnraise[exn:fail]. Similarly, if -a conversion error occurs at any point while reading @scheme[in], then +a conversion error occurs at any point while reading @racket[in], then @exnraise[exn:fail].} @defproc[(copy-port [in input-port?] [out output-port?] ...+) void?]{ -Reads data from @scheme[in] and writes it back out to @scheme[out], -returning when @scheme[in] produces @scheme[eof]. The copy is +Reads data from @racket[in] and writes it back out to @racket[out], +returning when @racket[in] produces @racket[eof]. The copy is efficient, and it is without significant buffer delays (i.e., a byte -that becomes available on @scheme[in] is immediately transferred to -@scheme[out], even if future reads on @scheme[in] must block). If -@scheme[in] produces a special non-byte value, it is transferred to -@scheme[out] using @scheme[write-special]. +that becomes available on @racket[in] is immediately transferred to +@racket[out], even if future reads on @racket[in] must block). If +@racket[in] produces a special non-byte value, it is transferred to +@racket[out] using @racket[write-special]. This function is often called from a ``background'' thread to continuously pump data from one stream to another. -If multiple @scheme[out]s are provided, case data from @scheme[in] is -written to every @scheme[out]. The different @scheme[out]s block -output to each other, because each block of data read from @scheme[in] -is written completely to one @scheme[out] before moving to the next -@scheme[out]. The @scheme[out]s are written in the provided order, so +If multiple @racket[out]s are provided, case data from @racket[in] is +written to every @racket[out]. The different @racket[out]s block +output to each other, because each block of data read from @racket[in] +is written completely to one @racket[out] before moving to the next +@racket[out]. The @racket[out]s are written in the provided order, so non-blocking ports (e.g., to a file) should be placed first in the argument list.} diff --git a/collects/setup/parallel-do.rkt b/collects/setup/parallel-do.rkt index 4ad3828065..180f30932c 100644 --- a/collects/setup/parallel-do.rkt +++ b/collects/setup/parallel-do.rkt @@ -23,6 +23,16 @@ wrkr/send define/class/generics) +(define-syntax-rule (mk-generic func clss method args ...) + (begin + (define g (generic clss method)) + (define (func obj args ...) + (send-generic obj g args ...)))) + +(define-syntax-rule (define/class/generics class (func method args ...) ...) + (begin + (mk-generic func class method args ...) ...)) + (define Worker% (class object% (field [id 0] [process-handle null] @@ -30,7 +40,7 @@ [in null] [err null]) - (define/public (spawn _id worker-cmdline-list initialcode initialmsg) + (define/public (spawn _id worker-cmdline-list [initialcode #f] [initialmsg #f]) (let-values ([(_process-handle _out _in _err) (apply subprocess #f #f (current-error-port) worker-cmdline-list)]) (set! id _id) (set! process-handle _process-handle) @@ -49,9 +59,17 @@ (close-output-port in) (close-input-port out) (subprocess-kill process-handle #t)) + (define/public (kill/respawn worker-cmdline-list [initialcode #f] [initialmsg #f]) + (kill) + (spawn id worker-cmdline-list [initialcode #f] [initialmsg #f])) (define/public (wait) (subprocess-wait process-handle)) (super-new))) +(define (wrkr/spawn id worker-cmdline-list [initialcode #f] [initialmsg #f]) + (define wrkr (new Worker%)) + (send wrkr spawn id worker-cmdline-list initialcode initialmsg) + wrkr) + (define WorkQueue<%> (interface () get-job work-done @@ -59,23 +77,12 @@ jobs-cnt get-results)) -(define-syntax-rule (mk-generic func clss method args ...) - (begin - (define g (generic clss method)) - (define (func obj args ...) - (send-generic obj g args ...)))) - -(define-syntax-rule (define/class/generics class (func method args ...) ...) - (begin - (mk-generic func class method args ...) ...)) - (define/class/generics Worker% (wrkr/send send/msg msg) (wrkr/kill kill) (wrkr/recv recv/msg) (wrkr/id get-id) - (wrkr/out get-out) - (wrkr/spawn spawn id worker-cmdline-list initialcode initialmsg)) + (wrkr/out get-out)) (define/class/generics WorkQueue<%> (queue/get get-job wrkrid) @@ -95,10 +102,7 @@ (find-system-path 'orig-dir)))))) (define (parallel-do-event-loop initialcode initialmsg worker-cmdline-list jobqueue nprocs stopat) - (define (spawn id) - (define wrkr (new Worker%)) - (wrkr/spawn wrkr id worker-cmdline-list initialcode initialmsg) - wrkr) + (define (spawn id) (wrkr/spawn id worker-cmdline-list initialcode initialmsg)) (define (jobs?) (queue/has jobqueue)) (define (empty?) (not (queue/has jobqueue))) (define workers #f) diff --git a/collects/syntax-color/module-lexer.rkt b/collects/syntax-color/module-lexer.rkt index 50d62272de..c4273174eb 100644 --- a/collects/syntax-color/module-lexer.rkt +++ b/collects/syntax-color/module-lexer.rkt @@ -1,52 +1,78 @@ #lang scheme/base (require scheme/port "scheme-lexer.rkt") - (provide module-lexer) +#| + +mode : (or/c #f 'before-lang-line + 'no-lang-line + (cons lexer mode) + lexer) + +the module lexer tracks any white-space and comments before +the #lang line (if any) explicitly by wrapping calls to the +scheme-lexer (in #f or 'before-lang-line mode). +Once it finds a non-white-space and non-comment +token, it checks to see if there is a #lang line and, if so +changes the mode to be the lexer that the #lang indicates, +delegating to it (the last two modes listed above). +If there is no #lang line, then it continues +to delegate to the scheme-lexer (in the 'no-lang-line mode). + +|# + + (define (module-lexer in offset mode) (cond - [(not mode) - ;; Starting out: look for #lang: - (let*-values ([(p) (peeking-input-port in)] - [(init) (file-position p)] - [(start-line start-col start-pos) (port-next-location p)]) - (let ([get-info (with-handlers ([exn:fail? (lambda (exn) 'fail)]) - (read-language p (lambda () #f)))] - [sync-ports (lambda () - (read-bytes (- (file-position p) init) in))]) + [(or (not mode) (eq? mode 'before-lang-line)) + (define lexer-port (peeking-input-port in)) + (port-count-lines! lexer-port) + (define-values (lexeme type data raw-new-token-start raw-new-token-end) (scheme-lexer lexer-port)) + (define new-token-start (and raw-new-token-start (+ raw-new-token-start (file-position in)))) + (define new-token-end (and raw-new-token-end (+ raw-new-token-end (file-position in)))) + (cond + [(or (eq? type 'comment) (eq? type 'white-space)) + (define lexer-end (file-position lexer-port)) + (read-string lexer-end in) ;; sync ports + (values lexeme type data new-token-start new-token-end 0 'before-lang-line)] + [else + ;; look for #lang: + (define p (peeking-input-port in)) + (port-count-lines! p) + (define get-info (with-handlers ([exn:fail? values]) (read-language p (λ () 'fail)))) (cond - [(procedure? get-info) - ;; Produce language as first token: - (sync-ports) - (let-values ([(end-line end-col end-pos) (port-next-location in)]) - (values - "#lang" - 'other - #f - start-pos - end-pos - 0 - (or (let ([v (get-info 'color-lexer #f)]) - (and v - (if (procedure-arity-includes? v 3) - (cons v #f) - v))) - scheme-lexer)))] - [(eq? 'fail get-info) - (sync-ports) - (let*-values ([(end-line end-col end-pos) (port-next-location in)]) - (values #f 'error #f start-pos end-pos 0 scheme-lexer))] - [else - ;; Start over using the Scheme lexer - (module-lexer in offset scheme-lexer)])))] - [(pair? mode) - ;; #lang-selected language consumes and produces a mode: - (let-values ([(lexeme type data new-token-start new-token-end backup-delta new-mode) - ((car mode) in offset (cdr mode))]) - (values lexeme type data new-token-start new-token-end backup-delta (cons (car mode) new-mode)))] - [else - ;; #lang-selected language (or default) doesn't deal with modes: - (let-values ([(lexeme type data new-token-start new-token-end) - (mode in)]) - (values lexeme type data new-token-start new-token-end 0 mode))])) + [(procedure? get-info) + (define end-pos (file-position p)) + (read-string end-pos in) ;; sync ports + ;; Produce language as first token: + (values + "#lang" + 'other + #f + 1 ;; start-pos + (+ end-pos 1) + 0 + (or (let ([v (get-info 'color-lexer #f)]) + (and v + (if (procedure-arity-includes? v 3) + (cons v #f) + v))) + scheme-lexer))] + [else + (read-string (file-position lexer-port) in) ;; sync ports + (values lexeme type data new-token-start new-token-end 0 'no-lang-line)])])] + [(eq? mode 'no-lang-line) + (let-values ([(lexeme type data new-token-start new-token-end) + (scheme-lexer in)]) + (values lexeme type data new-token-start new-token-end 0 'no-lang-line))] + [(pair? mode) + ;; #lang-selected language consumes and produces a mode: + (let-values ([(lexeme type data new-token-start new-token-end backup-delta new-mode) + ((car mode) in offset (cdr mode))]) + (values lexeme type data new-token-start new-token-end backup-delta (cons (car mode) new-mode)))] + [else + ;; #lang-selected language (or default) doesn't deal with modes: + (let-values ([(lexeme type data new-token-start new-token-end) + (mode in)]) + (values lexeme type data new-token-start new-token-end 0 mode))])) diff --git a/collects/tests/racket/contract-test.rktl b/collects/tests/racket/contract-test.rktl index d4dbef0ea0..8e66ca0861 100644 --- a/collects/tests/racket/contract-test.rktl +++ b/collects/tests/racket/contract-test.rktl @@ -3533,6 +3533,18 @@ (reverse x)) '(3 1 2 4)) + (test/spec-passed/result + 'and/c-isnt + '(and (regexp-match #rx"isn't even?" + (with-handlers ((exn:fail? exn-message)) + (contract (and/c integer? even? positive?) + -3 + 'pos + 'neg) + "not the error!")) + #t) + #t) + (test/spec-passed 'contract-flat1 '(contract not #f 'pos 'neg))