diff --git a/collects/mred/private/wxme/pasteboard.ss b/collects/mred/private/wxme/pasteboard.ss index 80b023d942..9402788f45 100644 --- a/collects/mred/private/wxme/pasteboard.ss +++ b/collects/mred/private/wxme/pasteboard.ss @@ -1913,7 +1913,7 @@ (do-write-headers-footers f #f))) (def/override (read-from-file [editor-stream-in% f] - [bool? [overwritestyle? #t]]) + [bool? [overwritestyle? #f]]) (if (or s-user-locked? (not (zero? write-locked))) #f diff --git a/collects/mred/private/wxme/text.ss b/collects/mred/private/wxme/text.ss index 2b297eaa49..7a188effa0 100644 --- a/collects/mred/private/wxme/text.ss +++ b/collects/mred/private/wxme/text.ss @@ -2581,9 +2581,9 @@ (define/override (read-from-file . args) (case-args args - [([editor-stream-in% f] [exact-nonnegative-integer? start] [any? [overwritestyle? #t]]) + [([editor-stream-in% f] [exact-nonnegative-integer? start] [any? [overwritestyle? #f]]) (do-read-from-file f start overwritestyle?)] - [([editor-stream-in% f] [any? [overwritestyle? #t]]) + [([editor-stream-in% f] [any? [overwritestyle? #f]]) (do-read-from-file f 'start overwritestyle?)] (method-name 'text% 'read-from-file))) diff --git a/collects/scheme/package.ss b/collects/scheme/package.ss index ebaeb4b778..469ce825f5 100644 --- a/collects/scheme/package.ss +++ b/collects/scheme/package.ss @@ -2,7 +2,8 @@ (require (for-syntax scheme/base syntax/kerncase syntax/boundmap - syntax/define)) + syntax/define + syntax/flatten-begin)) (provide define-package package-begin @@ -93,6 +94,12 @@ hidden) id))) +(define-for-syntax (move-props orig new) + (datum->syntax new + (syntax-e new) + orig + orig)) + (define-for-syntax (do-define-package stx exp-stx) (syntax-case exp-stx () [(_ pack-id mode exports form ...) @@ -293,7 +300,7 @@ (car def-ctxes)))]) (syntax-case expr (begin) [(begin . rest) - (loop (append (syntax->list #'rest) (cdr exprs)) + (loop (append (flatten-begin expr) (cdr exprs)) rev-forms def-ctxes)] [(def (id ...) rhs) @@ -315,7 +322,7 @@ (syntax-local-bind-syntaxes ids #'rhs def-ctx) (register-bindings! ids) (loop (cdr exprs) - (cons #`(define-syntaxes #,ids rhs) + (cons (move-props expr #`(define-syntaxes #,ids rhs)) rev-forms) (if star? (cons def-ctx def-ctxes) def-ctxes)))))] [(def (id ...) rhs) @@ -333,7 +340,7 @@ (syntax-local-bind-syntaxes ids #f def-ctx) (register-bindings! ids) (loop (cdr exprs) - (cons #`(define-values #,ids rhs) rev-forms) + (cons (move-props expr #`(define-values #,ids rhs)) rev-forms) (if star? (cons def-ctx def-ctxes) def-ctxes))))] [else (loop (cdr exprs) diff --git a/collects/scheme/private/class-internal.ss b/collects/scheme/private/class-internal.ss index 62e702db81..289dd7ff8e 100644 --- a/collects/scheme/private/class-internal.ss +++ b/collects/scheme/private/class-internal.ss @@ -11,6 +11,7 @@ syntax/name syntax/context syntax/define + syntax/flatten-begin syntax/private/boundmap mzlib/stxparam "classidmap.ss")) @@ -245,9 +246,9 @@ null (let ([e (expand (car l))]) (syntax-case e (begin define-syntaxes define-values) - [(begin expr ...) + [(begin . _) (loop (append - (syntax->list (syntax (expr ...))) + (flatten-begin e) (cdr l)))] [(define-syntaxes (id ...) rhs) (andmap identifier? (syntax->list #'(id ...))) diff --git a/collects/scribblings/gui/editor-intf.scrbl b/collects/scribblings/gui/editor-intf.scrbl index 2184550f83..99dc7b6fe3 100644 --- a/collects/scribblings/gui/editor-intf.scrbl +++ b/collects/scribblings/gui/editor-intf.scrbl @@ -1826,7 +1826,7 @@ See @method[editor<%> read-header-from-file]. @defmethod[(read-from-file [stream (is-a?/c editor-stream-in%)] - [overwrite-styles? any/c #t]) + [overwrite-styles? any/c #f]) boolean?]{ Reads new contents for the editor from a stream. The return value is diff --git a/collects/scribblings/gui/text-class.scrbl b/collects/scribblings/gui/text-class.scrbl index 3635683ed6..d0af7be3fd 100644 --- a/collects/scribblings/gui/text-class.scrbl +++ b/collects/scribblings/gui/text-class.scrbl @@ -1698,7 +1698,7 @@ Returns the paragraph number of the paragraph containing a given @techlink{posit @defmethod[#:mode extend (read-from-file [stream (is-a?/c editor-stream-in%)] [start (or/c exact-nonnegative-integer? (one/of 'start))] - [overwrite-styles? any/c #t]) + [overwrite-styles? any/c #f]) boolean?]{ New data is inserted at the @techlink{position} indicated by @scheme[start], or at diff --git a/collects/scribblings/reference/stx-props.scrbl b/collects/scribblings/reference/stx-props.scrbl index 8dd07e630d..d2dbc68450 100644 --- a/collects/scribblings/reference/stx-props.scrbl +++ b/collects/scribblings/reference/stx-props.scrbl @@ -54,17 +54,17 @@ MzScheme adds properties to expanded syntax (often using @item{When an internal @scheme[define-values] or @scheme[define-syntaxes] form is converted into a - @scheme[letrec-values+syntaxes] form (see @secref["intdef-body"]), + @scheme[letrec-syntaxes+values] form (see @secref["intdef-body"]), @scheme[syntax-track-origin] is applied to each generated binding clause. The second argument to @scheme[syntax-track-origin] is the converted form, and the third argument is the @scheme[define-values] or @scheme[define-syntaxes] keyword form the converted form.} - @item{When a @scheme[letrec-values+syntaxes] expression is fully + @item{When a @scheme[letrec-syntaxes+values] expression is fully expanded, syntax bindings disappear, and the result is either a @scheme[letrec-values] form (if the unexpanded form contained non-syntax bindings), or only the body of the - @scheme[letrec-values+syntaxes] form (wrapped with @scheme[begin] if + @scheme[letrec-syntaxes+values] form (wrapped with @scheme[begin] if the body contained multiple expressions). To record the disappeared syntax bindings, a property is added to the expansion result: an immutable list of identifiers from the disappeared bindings, as a diff --git a/collects/syntax/flatten-begin.ss b/collects/syntax/flatten-begin.ss new file mode 100644 index 0000000000..5cb4b0e5b5 --- /dev/null +++ b/collects/syntax/flatten-begin.ss @@ -0,0 +1,13 @@ +#lang scheme/base +(provide flatten-begin) + +(define (flatten-begin stx) + (let ([l (syntax->list stx)]) + (if l + (map (lambda (e) + (syntax-track-origin e stx (car l))) + (cdr l)) + (raise-syntax-error + #f + "bad syntax" + stx)))) diff --git a/collects/syntax/scribblings/flatten-begin.scrbl b/collects/syntax/scribblings/flatten-begin.scrbl new file mode 100644 index 0000000000..c3f93313b8 --- /dev/null +++ b/collects/syntax/scribblings/flatten-begin.scrbl @@ -0,0 +1,14 @@ +#lang scribble/doc +@(require "common.ss" + (for-label syntax/flatten-begin)) + +@title[#:tag "flatten-begin"]{Flattening @scheme[begin] Forms} + +@defmodule[syntax/flatten-begin] + +@defproc[(flatten-begin [stx syntax?]) (listof syntax?)]{ + +Extracts the sub-expressions from a @scheme[begin]-like form, +reporting an error if @scheme[stx] does not have the right shape +(i.e., a syntax list). The resulting syntax objects have annotations +transferred from @scheme[stx] using @scheme[syntax-track-origin].} diff --git a/collects/syntax/scribblings/transformer-helpers.scrbl b/collects/syntax/scribblings/transformer-helpers.scrbl index 6f8aa521cb..951c202743 100644 --- a/collects/syntax/scribblings/transformer-helpers.scrbl +++ b/collects/syntax/scribblings/transformer-helpers.scrbl @@ -6,6 +6,6 @@ @include-section["name.scrbl"] @include-section["context.scrbl"] @include-section["define.scrbl"] +@include-section["flatten-begin.scrbl"] @include-section["struct.scrbl"] @include-section["path-spec.scrbl"] -