From afd8b0c2fde96c3df429d59edd67383042b3c983 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Fri, 24 Apr 2009 21:49:16 +0000 Subject: [PATCH 01/18] fix scrollbars for >16-bit values under Windows svn: r14603 --- src/wxwindow/src/msw/wx_win.cxx | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/src/wxwindow/src/msw/wx_win.cxx b/src/wxwindow/src/msw/wx_win.cxx index 7f2a7790f7..cf75d77250 100644 --- a/src/wxwindow/src/msw/wx_win.cxx +++ b/src/wxwindow/src/msw/wx_win.cxx @@ -2404,6 +2404,18 @@ void wxSubWnd::OnHScroll( WORD wParam, WORD pos, HWND control) case SB_THUMBTRACK: event->moveType = wxEVENT_TYPE_SCROLL_THUMBTRACK; + { + /* Work-around for 16-bit limit on incoming `pos' */ + SCROLLINFO si; + ZeroMemory(&si, sizeof(si)); + si.cbSize = sizeof(si); + si.fMask = SIF_TRACKPOS; + if (GetScrollInfo(hwnd, SB_HORZ, &si)) { + pos = si.nTrackPos; + event->pos = pos; + } + } + break; default: From 333ecffe3e83904d18d61ef034e8ca06fadf39ff Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Fri, 24 Apr 2009 21:52:05 +0000 Subject: [PATCH 02/18] fix typo in windows scroll change svn: r14604 --- src/wxwindow/src/msw/wx_win.cxx | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/wxwindow/src/msw/wx_win.cxx b/src/wxwindow/src/msw/wx_win.cxx index cf75d77250..a4fb69650a 100644 --- a/src/wxwindow/src/msw/wx_win.cxx +++ b/src/wxwindow/src/msw/wx_win.cxx @@ -2410,7 +2410,7 @@ void wxSubWnd::OnHScroll( WORD wParam, WORD pos, HWND control) ZeroMemory(&si, sizeof(si)); si.cbSize = sizeof(si); si.fMask = SIF_TRACKPOS; - if (GetScrollInfo(hwnd, SB_HORZ, &si)) { + if (GetScrollInfo(handle, SB_HORZ, &si)) { pos = si.nTrackPos; event->pos = pos; } From a542660087b7598511392eb83444954eef872f09 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Fri, 24 Apr 2009 21:54:28 +0000 Subject: [PATCH 03/18] raise canvas scroll limits to 1B instead of 10k svn: r14605 --- collects/scribblings/gui/canvas-class.scrbl | 28 ++++++++++----------- collects/scribblings/reference/read.scrbl | 6 ++--- src/mred/wxs/wxs_cnvs.cxx | 22 ++++++++-------- src/mred/wxs/wxs_cnvs.xc | 8 +++--- 4 files changed, 32 insertions(+), 32 deletions(-) diff --git a/collects/scribblings/gui/canvas-class.scrbl b/collects/scribblings/gui/canvas-class.scrbl index e64cfb9645..1c05ac8df4 100644 --- a/collects/scribblings/gui/canvas-class.scrbl +++ b/collects/scribblings/gui/canvas-class.scrbl @@ -111,7 +111,7 @@ When tab-focus is enabled for a canvas, Tab, arrow, and Enter keyboard @defmethod[(get-scroll-page [which (one-of/c 'horizontal 'vertical)]) - (integer-in 1 10000)]{ + (integer-in 1 1000000000)]{ Get the current page step size of a manual scrollbar. The result is @scheme[0] if the scrollbar is not active or it is automatic. @@ -126,7 +126,7 @@ See also @defmethod[(get-scroll-pos [which (one-of/c 'horizontal 'vertical)]) - (integer-in 0 10000)]{ + (integer-in 0 1000000000)]{ Gets the current value of a manual scrollbar. The result is always @scheme[0] if the scrollbar is not active or it is automatic. @@ -141,7 +141,7 @@ See also @defmethod[(get-scroll-range [which (one-of/c 'horizontal 'vertical)]) - (integer-in 0 10000)]{ + (integer-in 0 1000000000)]{ Gets the current maximum value of a manual scrollbar. The result is always @scheme[0] if the scrollbar is not active or it is automatic. @@ -183,8 +183,8 @@ Gets the size in device units of the scrollable canvas area (as } -@defmethod[(init-auto-scrollbars [horiz-pixels (or/c (integer-in 1 10000) false/c)] - [vert-pixels (or/c (integer-in 1 10000) false/c)] +@defmethod[(init-auto-scrollbars [horiz-pixels (or/c (integer-in 1 1000000000) false/c)] + [vert-pixels (or/c (integer-in 1 1000000000) false/c)] [h-value (real-in 0.0 1.0)] [v-value (real-in 0.0 1.0)]) void?]{ @@ -222,12 +222,12 @@ See also } -@defmethod[(init-manual-scrollbars [h-length (or/c (integer-in 0 10000) false/c)] - [v-length (or/c (integer-in 0 10000) false/c)] - [h-page (integer-in 1 10000)] - [v-page (integer-in 1 10000)] - [h-value (integer-in 0 10000)] - [v-value (integer-in 0 10000)]) +@defmethod[(init-manual-scrollbars [h-length (or/c (integer-in 0 1000000000) false/c)] + [v-length (or/c (integer-in 0 1000000000) false/c)] + [h-page (integer-in 1 1000000000)] + [v-page (integer-in 1 1000000000)] + [h-value (integer-in 0 1000000000)] + [v-value (integer-in 0 1000000000)]) void?]{ Enables and initializes manual scrollbars for the canvas. A @@ -319,7 +319,7 @@ See also @defmethod[(set-scroll-page [which (one-of/c 'horizontal 'vertical)] - [value (integer-in 1 10000)]) + [value (integer-in 1 1000000000)]) void?]{ Set the current page step size of a manual scrollbar. (This method has @@ -336,7 +336,7 @@ See also @defmethod[(set-scroll-pos [which (one-of/c 'horizontal 'vertical)] - [value (integer-in 0 10000)]) + [value (integer-in 0 1000000000)]) void?]{ Sets the current value of a manual scrollbar. (This method has no @@ -356,7 +356,7 @@ See also @defmethod[(set-scroll-range [which (one-of/c 'horizontal 'vertical)] - [value (integer-in 0 10000)]) + [value (integer-in 0 1000000000)]) void?]{ Sets the current maximum value of a manual scrollbar. (This method has diff --git a/collects/scribblings/reference/read.scrbl b/collects/scribblings/reference/read.scrbl index 28631f41bf..ed8ef1c56e 100644 --- a/collects/scribblings/reference/read.scrbl +++ b/collects/scribblings/reference/read.scrbl @@ -29,7 +29,7 @@ See @secref["reader"] for information on the default reader in @defproc[(read/recursive [in input-port? (current-input-port)] [start (or/c char? #f) #f] [readtable (or/c readtable? #f) (current-readtable)] - [graph? any/c #f]) + [graph? any/c #t]) any]{ Similar to calling @scheme[read], but normally used during the dynamic @@ -77,7 +77,7 @@ See @secref["readtables"] for an extended example that uses [in input-port? (current-input-port)] [start (or/c char? #f) #f] [readtable (or/c readtable? #f) (current-readtable)] - [graph? any/c #f]) + [graph? any/c #t]) any]{ Analogous to calling @scheme[read/recursive], but the resulting value @@ -317,7 +317,7 @@ Like @scheme[read-syntax], but for Honu mode (see @defproc[(read-honu/recursive [in input-port? (current-input-port)] [start (or/c char? #f) #f] [readtable (or/c readtable? #f) (current-readtable)] - [graph? any/c #f]) + [graph? any/c #t]) any]{ Like @scheme[read/recursive], but for Honu mode (see diff --git a/src/mred/wxs/wxs_cnvs.cxx b/src/mred/wxs/wxs_cnvs.cxx index ceb6de052a..7011405390 100644 --- a/src/mred/wxs/wxs_cnvs.cxx +++ b/src/mred/wxs/wxs_cnvs.cxx @@ -874,7 +874,7 @@ static Scheme_Object *os_wxCanvasSetScrollPage(int n, Scheme_Object *p[]) x0 = WITH_VAR_STACK(unbundle_symset_orientation(p[POFFSET+0], "set-scroll-page in canvas%")); - x1 = WITH_VAR_STACK(objscheme_unbundle_integer_in(p[POFFSET+1], 1, 10000, "set-scroll-page in canvas%")); + x1 = WITH_VAR_STACK(objscheme_unbundle_integer_in(p[POFFSET+1], 1, 1000000000, "set-scroll-page in canvas%")); WITH_VAR_STACK(((wxCanvas *)((Scheme_Class_Object *)p[0])->primdata)->SetScrollPage(x0, x1)); @@ -898,7 +898,7 @@ static Scheme_Object *os_wxCanvasSetScrollRange(int n, Scheme_Object *p[]) x0 = WITH_VAR_STACK(unbundle_symset_orientation(p[POFFSET+0], "set-scroll-range in canvas%")); - x1 = WITH_VAR_STACK(objscheme_unbundle_integer_in(p[POFFSET+1], 0, 10000, "set-scroll-range in canvas%")); + x1 = WITH_VAR_STACK(objscheme_unbundle_integer_in(p[POFFSET+1], 0, 1000000000, "set-scroll-range in canvas%")); WITH_VAR_STACK(((wxCanvas *)((Scheme_Class_Object *)p[0])->primdata)->SetScrollRange(x0, x1)); @@ -922,7 +922,7 @@ static Scheme_Object *os_wxCanvasSetScrollPos(int n, Scheme_Object *p[]) x0 = WITH_VAR_STACK(unbundle_symset_orientation(p[POFFSET+0], "set-scroll-pos in canvas%")); - x1 = WITH_VAR_STACK(objscheme_unbundle_integer_in(p[POFFSET+1], 0, 10000, "set-scroll-pos in canvas%")); + x1 = WITH_VAR_STACK(objscheme_unbundle_integer_in(p[POFFSET+1], 0, 1000000000, "set-scroll-pos in canvas%")); WITH_VAR_STACK(((wxCanvas *)((Scheme_Class_Object *)p[0])->primdata)->SetScrollPos(x0, x1)); @@ -1146,18 +1146,18 @@ static Scheme_Object *os_wxCanvasSetScrollbars(int n, Scheme_Object *p[]) VAR_STACK_PUSH(0, p); - x0 = WITH_VAR_STACK(objscheme_unbundle_integer_in(p[POFFSET+0], 0, 10000, "set-scrollbars in canvas%")); - x1 = WITH_VAR_STACK(objscheme_unbundle_integer_in(p[POFFSET+1], 0, 10000, "set-scrollbars in canvas%")); - x2 = WITH_VAR_STACK(objscheme_unbundle_integer_in(p[POFFSET+2], 0, 10000, "set-scrollbars in canvas%")); - x3 = WITH_VAR_STACK(objscheme_unbundle_integer_in(p[POFFSET+3], 0, 10000, "set-scrollbars in canvas%")); - x4 = WITH_VAR_STACK(objscheme_unbundle_integer_in(p[POFFSET+4], 1, 10000, "set-scrollbars in canvas%")); - x5 = WITH_VAR_STACK(objscheme_unbundle_integer_in(p[POFFSET+5], 1, 10000, "set-scrollbars in canvas%")); + x0 = WITH_VAR_STACK(objscheme_unbundle_integer_in(p[POFFSET+0], 0, 1000000000, "set-scrollbars in canvas%")); + x1 = WITH_VAR_STACK(objscheme_unbundle_integer_in(p[POFFSET+1], 0, 1000000000, "set-scrollbars in canvas%")); + x2 = WITH_VAR_STACK(objscheme_unbundle_integer_in(p[POFFSET+2], 0, 1000000000, "set-scrollbars in canvas%")); + x3 = WITH_VAR_STACK(objscheme_unbundle_integer_in(p[POFFSET+3], 0, 1000000000, "set-scrollbars in canvas%")); + x4 = WITH_VAR_STACK(objscheme_unbundle_integer_in(p[POFFSET+4], 1, 1000000000, "set-scrollbars in canvas%")); + x5 = WITH_VAR_STACK(objscheme_unbundle_integer_in(p[POFFSET+5], 1, 1000000000, "set-scrollbars in canvas%")); if (n > (POFFSET+6)) { - x6 = WITH_VAR_STACK(objscheme_unbundle_integer_in(p[POFFSET+6], 0, 10000, "set-scrollbars in canvas%")); + x6 = WITH_VAR_STACK(objscheme_unbundle_integer_in(p[POFFSET+6], 0, 1000000000, "set-scrollbars in canvas%")); } else x6 = 0; if (n > (POFFSET+7)) { - x7 = WITH_VAR_STACK(objscheme_unbundle_integer_in(p[POFFSET+7], 0, 10000, "set-scrollbars in canvas%")); + x7 = WITH_VAR_STACK(objscheme_unbundle_integer_in(p[POFFSET+7], 0, 1000000000, "set-scrollbars in canvas%")); } else x7 = 0; if (n > (POFFSET+8)) { diff --git a/src/mred/wxs/wxs_cnvs.xc b/src/mred/wxs/wxs_cnvs.xc index c82e6b5dd6..4b2e29e6e2 100644 --- a/src/mred/wxs/wxs_cnvs.xc +++ b/src/mred/wxs/wxs_cnvs.xc @@ -80,7 +80,7 @@ static void wxSetResizeCorner(wxCanvas *c, Bool v) // @ "get-scroll-units" : void GetScrollUnitsPerPage(int*,int*); : : / PANELREDIRECT[ FillZero(x0,x1); READY_TO_RETURN; return scheme_void] @ "get-virtual-size" : void GetVirtualSize(int*,int*); : : / PANELREDIRECT[FillZero(x0,x1); READY_TO_RETURN; return scheme_void] -@ "set-scrollbars" : void SetScrollbars(rint[0|10000],rint[0|10000],rint[0|10000],rint[0|10000],rint[1|10000],rint[1|10000],rint[0|10000]=0,rint[0|10000]=0,bool=TRUE); : : / PANELREDIRECT[READY_TO_RETURN; return scheme_void] +@ "set-scrollbars" : void SetScrollbars(rint[0|1000000000],rint[0|1000000000],rint[0|1000000000],rint[0|1000000000],rint[1|1000000000],rint[1|1000000000],rint[0|1000000000]=0,rint[0|1000000000]=0,bool=TRUE); : : / PANELREDIRECT[READY_TO_RETURN; return scheme_void] @ "show-scrollbars" : void EnableScrolling(bool,bool) @ m "set-resize-corner" : void wxSetResizeCorner(bool) @ "view-start" : void ViewStart(int*,int*); : : / PANELREDIRECT[FillZero(x0,x1); READY_TO_RETURN; return scheme_void] @@ -91,9 +91,9 @@ static void wxSetResizeCorner(wxCanvas *c, Bool v) @ "get-scroll-range" : int GetScrollRange(SYM[orientation]); @ "get-scroll-page" : int GetScrollPage(SYM[orientation]); -@ "set-scroll-pos" : void SetScrollPos(SYM[orientation], rint[0|10000]); -@ "set-scroll-range" : void SetScrollRange(SYM[orientation], rint[0|10000]); -@ "set-scroll-page" : void SetScrollPage(SYM[orientation], rint[1|10000]); +@ "set-scroll-pos" : void SetScrollPos(SYM[orientation], rint[0|1000000000]); +@ "set-scroll-range" : void SetScrollRange(SYM[orientation], rint[0|1000000000]); +@ "set-scroll-page" : void SetScrollPage(SYM[orientation], rint[1|1000000000]); @ v "on-scroll" : void OnScroll(wxScrollEvent!); : JMPDECL/SETJMP/RESETJMP : / PANELREDIRECT[READY_TO_RETURN; return scheme_void] From 97cb7802acdc6cd9a06e904bdf9c5f58a2d840be Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Sat, 25 Apr 2009 07:50:17 +0000 Subject: [PATCH 04/18] Welcome to a new PLT day. svn: r14606 --- collects/repos-time-stamp/stamp.ss | 2 +- src/worksp/mred/mred.manifest | 2 +- src/worksp/mred/mred.rc | 8 ++++---- src/worksp/mzcom/mzcom.rc | 8 ++++---- src/worksp/mzcom/mzobj.rgs | 6 +++--- src/worksp/mzscheme/mzscheme.rc | 8 ++++---- src/worksp/starters/start.rc | 8 ++++---- 7 files changed, 21 insertions(+), 21 deletions(-) diff --git a/collects/repos-time-stamp/stamp.ss b/collects/repos-time-stamp/stamp.ss index 54124f6f93..705e13c09c 100644 --- a/collects/repos-time-stamp/stamp.ss +++ b/collects/repos-time-stamp/stamp.ss @@ -1 +1 @@ -#lang scheme/base (provide stamp) (define stamp "24apr2009") +#lang scheme/base (provide stamp) (define stamp "25apr2009") diff --git a/src/worksp/mred/mred.manifest b/src/worksp/mred/mred.manifest index 34e929ee8f..3fa6665bec 100644 --- a/src/worksp/mred/mred.manifest +++ b/src/worksp/mred/mred.manifest @@ -1,7 +1,7 @@ Date: Sat, 25 Apr 2009 13:21:50 +0000 Subject: [PATCH 05/18] svn: r14607 --- collects/scribblings/gui/snip-class.scrbl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/collects/scribblings/gui/snip-class.scrbl b/collects/scribblings/gui/snip-class.scrbl index 2a9faf1888..02cfdf6890 100644 --- a/collects/scribblings/gui/snip-class.scrbl +++ b/collects/scribblings/gui/snip-class.scrbl @@ -834,7 +834,7 @@ The snip's editor is usually internally locked for reading when this @methimpl{ -Creates a new @scheme[snip%] instance while @scheme[position] +Creates a new @scheme[snip%] instance with @scheme[position] elements, and modifies @this-obj[] to decrement its count by @scheme[position]. The nest snip is installed into @scheme[first] and @this-obj[] is installed into @scheme[second]. From 22864b594d11e027b7162fa82b30e207f91d7e1f Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sat, 25 Apr 2009 13:46:54 +0000 Subject: [PATCH 06/18] fix Scribble rendering of links when tag-prefixed sub-sections appear in the same output anchor scope svn: r14608 --- collects/scribble/base-render.ss | 75 ++++++++++++++-------- collects/scribble/html-render.ss | 35 ++++++---- collects/scribble/latex-render.ss | 3 +- collects/scribble/struct.ss | 37 +++++++---- collects/scribblings/scribble/struct.scrbl | 2 +- 5 files changed, 100 insertions(+), 52 deletions(-) diff --git a/collects/scribble/base-render.ss b/collects/scribble/base-render.ss index d5fbe71cfc..7240773419 100644 --- a/collects/scribble/base-render.ss +++ b/collects/scribble/base-render.ss @@ -109,6 +109,22 @@ (and (pair? p) (mobile-root? (car p)))) + ;; ---------------------------------------- + + (define/public (fresh-tag-collect-context? d ci) + #f) + (define/public (fresh-tag-resolve-context? d ri) + #f) + (define/public (fresh-tag-render-context? d ri) + #f) + + (define/private (extend-prefix d fresh?) + (cond + [fresh? null] + [(part-tag-prefix d) + (cons (part-tag-prefix d) (current-tag-prefixes))] + [else (current-tag-prefixes)])) + ;; ---------------------------------------- ;; marshal info @@ -174,26 +190,28 @@ (make-collected-info number parent (collect-info-ht p-ci))) - (when (part-title-content d) - (collect-content (part-title-content d) p-ci)) - (collect-part-tags d p-ci number) - (collect-content (part-to-collect d) p-ci) - (collect-flow (part-flow d) p-ci) - (let loop ([parts (part-parts d)] - [pos 1]) - (unless (null? parts) - (let ([s (car parts)]) - (collect-part s d p-ci - (cons (if (or (unnumbered-part? s) - (part-style? s 'unnumbered)) - #f - pos) - number)) - (loop (cdr parts) - (if (or (unnumbered-part? s) - (part-style? s 'unnumbered)) - pos - (add1 pos)))))) + (parameterize ([current-tag-prefixes + (extend-prefix d (fresh-tag-collect-context? d p-ci))]) + (when (part-title-content d) + (collect-content (part-title-content d) p-ci)) + (collect-part-tags d p-ci number) + (collect-content (part-to-collect d) p-ci) + (collect-flow (part-flow d) p-ci) + (let loop ([parts (part-parts d)] + [pos 1]) + (unless (null? parts) + (let ([s (car parts)]) + (collect-part s d p-ci + (cons (if (or (unnumbered-part? s) + (part-style? s 'unnumbered)) + #f + pos) + number)) + (loop (cdr parts) + (if (or (unnumbered-part? s) + (part-style? s 'unnumbered)) + pos + (add1 pos))))))) (let ([prefix (part-tag-prefix d)]) (for ([(k v) (collect-info-ht p-ci)]) (when (cadr k) @@ -284,11 +302,13 @@ (map (lambda (d) (resolve-part d ri)) ds)) (define/public (resolve-part d ri) - (when (part-title-content d) - (resolve-content (part-title-content d) d ri)) - (resolve-flow (part-flow d) d ri) - (for ([p (part-parts d)]) - (resolve-part p ri))) + (parameterize ([current-tag-prefixes + (extend-prefix d (fresh-tag-resolve-context? d ri))]) + (when (part-title-content d) + (resolve-content (part-title-content d) d ri)) + (resolve-flow (part-flow d) d ri) + (for ([p (part-parts d)]) + (resolve-part p ri)))) (define/public (resolve-content c d ri) (for ([i c]) @@ -373,6 +393,11 @@ (render-part d ri)) (define/public (render-part d ri) + (parameterize ([current-tag-prefixes + (extend-prefix d (fresh-tag-render-context? d ri))]) + (render-part-content d ri))) + + (define/public (render-part-content d ri) (list (when (part-title-content d) (render-content (part-title-content d) d ri)) diff --git a/collects/scribble/html-render.ss b/collects/scribble/html-render.ss index 6be22c6091..0cba736f78 100644 --- a/collects/scribble/html-render.ss +++ b/collects/scribble/html-render.ss @@ -230,6 +230,7 @@ (class % (inherit render-content render-block + render-part collect-part install-file get-dest-directory @@ -295,6 +296,13 @@ (define/public (current-part-whole-page? d) (eq? d (current-top-part))) + (define/override (fresh-tag-collect-context? d ci) + (current-part-whole-page? d)) + (define/override (fresh-tag-resolve-context? d ri) + (part-whole-page? d ri)) + (define/override (fresh-tag-render-context? d ri) + (part-whole-page? d ri)) + (define/override (collect-part-tags d ci number) (for ([t (part-tags d)]) (let ([key (generate-tag t ci)]) @@ -303,7 +311,7 @@ (path->relative (current-output-file))) (or (part-title-content d) '("???")) (current-part-whole-page? d) - key))))) + (add-current-tag-prefix key)))))) (define/override (collect-target-element i ci) (let ([key (generate-tag (target-element-tag i) ci)]) @@ -320,7 +328,7 @@ (if (redirect-target-element? i) (make-literal-anchor (redirect-target-element-alt-anchor i)) - key))))) + (add-current-tag-prefix key)))))) (define (dest-path dest) (if (vector? dest) ; temporary @@ -556,10 +564,11 @@ ,(format "#~a" (anchor-name - (tag-key (if (part? p) - (car (part-tags p)) - (target-element-tag p)) - ri)))] + (add-current-tag-prefix + (tag-key (if (part? p) + (car (part-tags p)) + (target-element-tag p)) + ri))))] [class ,(cond [(part? p) "tocsubseclink"] @@ -795,13 +804,15 @@ d ri)))))) - (define/override (render-part d ri) + (define/override (render-part-content d ri) (let ([number (collected-info-number (part-collected-info d ri))]) `(,@(cond [(and (not (part-title-content d)) (null? number)) null] [(part-style? d 'hidden) (map (lambda (t) - `(a ((name ,(format "~a" (anchor-name (tag-key t ri))))))) + `(a ((name ,(format "~a" (anchor-name + (add-current-tag-prefix + (tag-key t ri)))))))) (part-tags d))] [else `((,(case (length number) [(0) 'h2] @@ -811,7 +822,8 @@ ,@(format-number number '((tt nbsp))) ,@(map (lambda (t) `(a ([name ,(format "~a" (anchor-name - (tag-key t ri)))]))) + (add-current-tag-prefix + (tag-key t ri))))]))) (part-tags d)) ,@(if (part-title-content d) (render-content (part-title-content d) d ri) @@ -875,8 +887,9 @@ ;; (commented) hack in scribble-common.js) `(noscript ,@(render-plain-element e part ri))))] [(target-element? e) - `((a ([name ,(format "~a" (anchor-name (tag-key (target-element-tag e) - ri)))])) + `((a ([name ,(format "~a" (anchor-name (add-current-tag-prefix + (tag-key (target-element-tag e) + ri))))])) ,@(render-plain-element e part ri))] [(and (link-element? e) (not (current-no-links))) (parameterize ([current-no-links #t]) diff --git a/collects/scribble/latex-render.ss b/collects/scribble/latex-render.ss index 35dc6155b8..490956d31d 100644 --- a/collects/scribble/latex-render.ss +++ b/collects/scribble/latex-render.ss @@ -33,6 +33,7 @@ (inherit render-block render-content + render-part install-file format-number extract-part-style-files) @@ -69,7 +70,7 @@ (render-part d ri) (printf "\n\n\\postDoc\n\\end{document}\n"))) - (define/override (render-part d ri) + (define/override (render-part-content d ri) (let ([number (collected-info-number (part-collected-info d ri))]) (when (and (part-title-content d) (pair? number)) (when (part-style? d 'index) diff --git a/collects/scribble/struct.ss b/collects/scribble/struct.ss index f1cefbd1a7..1db2d6547a 100644 --- a/collects/scribble/struct.ss +++ b/collects/scribble/struct.ss @@ -376,26 +376,35 @@ (define deserialize-generated-tag (make-deserialize-info values values)) -(provide generate-tag tag-key) +(provide generate-tag tag-key + current-tag-prefixes + add-current-tag-prefix) (define (generate-tag tg ci) (if (generated-tag? (cadr tg)) - (let ([t (cadr tg)]) - (list (car tg) - (let ([tags (collect-info-tags ci)]) - (or (hash-ref tags t #f) - (let ([key (list* 'gentag - (hash-count tags) - (collect-info-gen-prefix ci))]) - (hash-set! tags t key) - key))))) - tg)) + (let ([t (cadr tg)]) + (list (car tg) + (let ([tags (collect-info-tags ci)]) + (or (hash-ref tags t #f) + (let ([key (list* 'gentag + (hash-count tags) + (collect-info-gen-prefix ci))]) + (hash-set! tags t key) + key))))) + tg)) (define (tag-key tg ri) (if (generated-tag? (cadr tg)) - (list (car tg) - (hash-ref (collect-info-tags (resolve-info-ci ri)) (cadr tg))) - tg)) + (list (car tg) + (hash-ref (collect-info-tags (resolve-info-ci ri)) (cadr tg))) + tg)) + +(define current-tag-prefixes (make-parameter null)) +(define (add-current-tag-prefix t) + (let ([l (current-tag-prefixes)]) + (if (null? l) + t + (cons (car t) (append l (cdr t)))))) ;; ---------------------------------------- diff --git a/collects/scribblings/scribble/struct.scrbl b/collects/scribblings/scribble/struct.scrbl index bc0a15666a..6a147e3287 100644 --- a/collects/scribblings/scribble/struct.scrbl +++ b/collects/scribblings/scribble/struct.scrbl @@ -189,7 +189,7 @@ added to a list value using @scheme[cons]; a prefix is not added to a outside the part, including the use of tags in the part's @scheme[tags] field. Typically, a document's main part has a tag prefix that applies to the whole document; references to sections and -defined terms within the document from other documents must include, +defined terms within the document from other documents must include the prefix, while references within the same document omit the prefix. Part prefixes can be used within a document as well, to help disambiguate references within the document. From bdd86751eef796b58c383116fdac24c7f2da287c Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sat, 25 Apr 2009 14:11:17 +0000 Subject: [PATCH 07/18] fix bug in handling re-export inspectors svn: r14609 --- src/mzscheme/src/module.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/mzscheme/src/module.c b/src/mzscheme/src/module.c index b0c90a7843..baebdfb46f 100644 --- a/src/mzscheme/src/module.c +++ b/src/mzscheme/src/module.c @@ -2227,7 +2227,7 @@ static int do_add_simple_require_renames(Scheme_Object *rn, SCHEME_VEC_ELS(vec)[6] = mark_src; SCHEME_VEC_ELS(vec)[7] = (can_override ? scheme_true : scheme_false); SCHEME_VEC_ELS(vec)[8] = exets ? scheme_make_integer(exets[i]) : scheme_false; - SCHEME_VEC_ELS(vec)[9] = exets ? exinsps[i] : scheme_false; + SCHEME_VEC_ELS(vec)[9] = exinsps ? exinsps[i] : scheme_false; scheme_hash_set(required, exs[i], vec); } } From f6c389d0ec6e928f2350a21943a3b90508591870 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sat, 25 Apr 2009 15:19:58 +0000 Subject: [PATCH 08/18] fix Scribble Latex rendering of prefixed tags; add #:tag-prefixes argument to secref and tech svn: r14610 --- collects/scribble/base-render.ss | 12 ++++++--- collects/scribble/latex-render.ss | 9 ++++--- collects/scribble/private/manual-style.ss | 12 ++++----- collects/scribble/private/manual-tech.ss | 14 +++++----- collects/scribble/private/manual-utils.ss | 12 +++++++-- collects/scribblings/scribble/manual.scrbl | 31 ++++++++++++++++------ 6 files changed, 59 insertions(+), 31 deletions(-) diff --git a/collects/scribble/base-render.ss b/collects/scribble/base-render.ss index 7240773419..6219d8dac7 100644 --- a/collects/scribble/base-render.ss +++ b/collects/scribble/base-render.ss @@ -234,9 +234,12 @@ (define/public (collect-part-tags d ci number) (for ([t (part-tags d)]) - (hash-set! (collect-info-ht ci) - (generate-tag t ci) - (list (or (part-title-content d) '("???")) number)))) + (let ([t (generate-tag t ci)]) + (hash-set! (collect-info-ht ci) + t + (list (or (part-title-content d) '("???")) + number + (add-current-tag-prefix t)))))) (define/public (collect-content c ci) (for ([i c]) (collect-element i ci))) @@ -281,7 +284,8 @@ (for ([e (element-content i)]) (collect-element e ci)))))) (define/public (collect-target-element i ci) - (collect-put! ci (generate-tag (target-element-tag i) ci) (list i))) + (let ([t (generate-tag (target-element-tag i) ci)]) + (collect-put! ci t (list i (add-current-tag-prefix t))))) (define/public (collect-index-element i ci) (collect-put! ci diff --git a/collects/scribble/latex-render.ss b/collects/scribble/latex-render.ss index 490956d31d..9602765980 100644 --- a/collects/scribble/latex-render.ss +++ b/collects/scribble/latex-render.ss @@ -6,6 +6,7 @@ scheme/port scheme/path scheme/string + scheme/list setup/main-collects) (provide render-mixin) @@ -97,7 +98,7 @@ (printf "}") (when (part-style? d 'index) (printf "\n\n"))) (for ([t (part-tags d)]) - (printf "\\label{t:~a}\n\n" (t-encode (tag-key t ri)))) + (printf "\\label{t:~a}\n\n" (t-encode (add-current-tag-prefix (tag-key t ri))))) (render-flow (part-flow d) d ri #f) (for ([sec (part-parts d)]) (render-part sec ri)) (when (part-style? d 'index) (printf "\\onecolumn\n\n")) @@ -140,7 +141,7 @@ (link-element? e))]) (when (target-element? e) (printf "\\label{t:~a}" - (t-encode (tag-key (target-element-tag e) ri)))) + (t-encode (add-current-tag-prefix (tag-key (target-element-tag e) ri))))) (when part-label? (printf "\\SecRef{") (render-content @@ -217,7 +218,9 @@ (show-link-page-numbers) (not (done-link-page-numbers))) (printf ", \\pageref{t:~a}" - (t-encode (tag-key (link-element-tag e) ri)))) + (t-encode + (let ([v (resolve-get part ri (link-element-tag e))]) + (and v (last v)))))) null)) (define/private (t-encode s) diff --git a/collects/scribble/private/manual-style.ss b/collects/scribble/private/manual-style.ss index 9f49153f4c..e337e44f09 100644 --- a/collects/scribble/private/manual-style.ss +++ b/collects/scribble/private/manual-style.ss @@ -2,6 +2,7 @@ (require "../decode.ss" "../struct.ss" "../basic.ss" + "manual-utils.ss" scheme/list scheme/string) @@ -175,14 +176,11 @@ (define (elemref #:underline? [u? #t] t . body) (make-link-element (if u? #f "plainlink") (decode-content body) `(elem ,t))) -(define (doc-prefix doc s) - (if doc (list (module-path-prefix->string doc) s) s)) - -(define (secref s #:underline? [u? #t] #:doc [doc #f]) - (make-link-element (if u? #f "plainlink") null `(part ,(doc-prefix doc s)))) -(define (seclink tag #:underline? [u? #t] #:doc [doc #f] . s) +(define (secref s #:underline? [u? #t] #:doc [doc #f] #:tag-prefixes [prefix #f]) + (make-link-element (if u? #f "plainlink") null `(part ,(doc-prefix doc prefix s)))) +(define (seclink tag #:underline? [u? #t] #:doc [doc #f] #:tag-prefixes [prefix #f] . s) (make-link-element (if u? #f "plainlink") (decode-content s) - `(part ,(doc-prefix doc tag)))) + `(part ,(doc-prefix doc prefix tag)))) (define (other-manual #:underline? [u? #t] doc) (secref #:doc doc #:underline? u? "top")) diff --git a/collects/scribble/private/manual-tech.ss b/collects/scribble/private/manual-tech.ss index 5cb7d417b2..f9a13bcecd 100644 --- a/collects/scribble/private/manual-tech.ss +++ b/collects/scribble/private/manual-tech.ss @@ -7,19 +7,19 @@ (provide deftech tech techlink) -(define (*tech make-elem style doc s) +(define (*tech make-elem style doc prefix s) (let* ([c (decode-content s)] [s (string-foldcase (content->string c))] [s (regexp-replace #rx"ies$" s "y")] [s (regexp-replace #rx"s$" s "")] [s (regexp-replace* #px"[-\\s]+" s " ")]) - (make-elem style c (list 'tech (doc-prefix doc s))))) + (make-elem style c (list 'tech (doc-prefix doc prefix s))))) (define (deftech #:style? [style? #t] . s) (let* ([e (if style? (apply defterm s) (make-element #f (decode-content s)))] - [t (*tech make-target-element #f #f (list e))]) + [t (*tech make-target-element #f #f #f (list e))]) (make-index-element #f (list t) (target-element-tag t) @@ -27,14 +27,14 @@ (list e) 'tech))) -(define (tech #:doc [doc #f] . s) +(define (tech #:doc [doc #f] #:tag-prefixes [prefix #f] . s) (*tech (lambda (style c tag) (make-link-element style (list (make-element "techinside" c)) tag)) "techoutside" - doc s)) + doc prefix s)) -(define (techlink #:doc [doc #f] . s) - (*tech make-link-element #f doc s)) +(define (techlink #:doc [doc #f] #:tag-prefixes [prefix #f] . s) + (*tech make-link-element #f doc prefix s)) diff --git a/collects/scribble/private/manual-utils.ss b/collects/scribble/private/manual-utils.ss index 310322870e..a8e9a75961 100644 --- a/collects/scribble/private/manual-utils.ss +++ b/collects/scribble/private/manual-utils.ss @@ -12,8 +12,16 @@ (define spacer (hspace 1)) -(define (doc-prefix doc s) - (if doc (list (module-path-prefix->string doc) s) s)) +(define doc-prefix + (case-lambda + [(doc s) + (if doc + (list (module-path-prefix->string doc) s) + s)] + [(doc prefix s) + (doc-prefix doc (if prefix + (append prefix (list s)) + s))])) (define (to-flow e) (make-flow (list (make-omitable-paragraph (list e))))) diff --git a/collects/scribblings/scribble/manual.scrbl b/collects/scribblings/scribble/manual.scrbl index 6057726ee4..32e28287c1 100644 --- a/collects/scribblings/scribble/manual.scrbl +++ b/collects/scribblings/scribble/manual.scrbl @@ -872,6 +872,7 @@ and @litchar{^} for subscripts and superscripts.} @defproc[(secref [tag string?] [#:doc module-path (or/c module-path? false/c) #f] + [#:tag-prefixes prefixes (or/c (listof string?) false/c) #f] [#:underline? underline? any/c #t]) element?]{ @@ -879,20 +880,29 @@ Inserts the hyperlinked title of the section tagged @scheme[tag], but @schemeidfont{aux-element} items in the title content are omitted in the hyperlink label. -If @scheme[module-path] is provided, the @scheme[tag] refers to a tag -with a prefix determined by @scheme[module-path]. When +If @scheme[#:doc module-path] is provided, the @scheme[tag] refers to +a tag with a prefix determined by @scheme[module-path]. When @exec{setup-plt} renders documentation, it automatically adds a tag prefix to the document based on the source module. Thus, for example, to refer to a section of the PLT Scheme reference, @scheme[module-path] would be @scheme['(lib "scribblings/reference/reference.scrbl")]. +The @scheme[#:tag-prefixes prefixes] argument similarly supports +selecting a particular section as determined by a path of tag +prefixes. When a @scheme[#:doc] argument is provided, then +@scheme[prefixes] should trace a path of tag-prefixed subsections to +reach the @scheme[tag] section. When @scheme[#:doc] is not provided, +the @scheme[prefixes] path is relative to any enclosing section (i.e., +the youngest ancestor that produces a match). + If @scheme[underline?] is @scheme[#f], then the hyperlink is rendered in HTML without an underline.} @defproc[(seclink [tag string?] [#:doc module-path (or/c module-path? false/c) #f] + [#:tag-prefixes prefixes (or/c (listof string?) false/c) #f] [#:underline? underline? any/c #t] [pre-content any/c] ...) element?]{ @@ -968,17 +978,21 @@ If @scheme[style?] is true, then @scheme[defterm] is used on @scheme[pre-content].} @defproc[(tech [pre-content any/c] ... - [#:doc module-path (or/c module-path? false/c) #f]) + [#:doc module-path (or/c module-path? false/c) #f] + [#:tag-prefixes prefixes (or/c (listof string?) false/c) #f]) element?]{ Produces an element for the @tech{decode}d @scheme[pre-content], and hyperlinks it to the definition of the content as established by @scheme[deftech]. The content's string form is normalized in the same -way as for @scheme[deftech]. The @scheme[#:doc] argument supports -cross-document references, like in @scheme[secref]. +way as for @scheme[deftech]. The @scheme[#:doc] and +@scheme[#:tag-prefixes] arguments support cross-document and +section-specific references, like in @scheme[secref]. -The hyperlink is relatively quiet, in that underlining in HTML output -appears only when the mouse is moved over the term. +With the default style files, the hyperlink created by @scheme[tech] +is somewhat quieter than most hyperlinks: the underline in HTML output +is gray, instead of blue, and the term and underline turn blue only +when the mouse is moved over the term. In some cases, combining both natural-language uses of a term and proper linking can require some creativity, even with the @@ -987,7 +1001,8 @@ defined, but a sentence uses the term ``binding,'' the latter can be linked to the former using @schemefont["@tech{bind}ing"].} @defproc[(techlink [pre-content any/c] ... - [#:doc module-path (or/c module-path? false/c) #f]) + [#:doc module-path (or/c module-path? false/c) #f] + [#:tag-prefixes prefixes (or/c (listof string?) false/c) #f]) element?]{ Like @scheme[tech], but the link is not a quiet. For example, in HTML From 511c2b13b0aef38bbd3ee1a7308bfc54c1a04cac Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sat, 25 Apr 2009 16:15:16 +0000 Subject: [PATCH 09/18] fix syntax-error message for misuse of identifier bound as code-typesetting variable or element transformer svn: r14611 --- collects/scribble/scheme.ss | 20 ++++++++++++++++++-- 1 file changed, 18 insertions(+), 2 deletions(-) diff --git a/collects/scribble/scheme.ss b/collects/scribble/scheme.ss index af05f467d2..ad95b2bcaa 100644 --- a/collects/scribble/scheme.ss +++ b/collects/scribble/scheme.ss @@ -606,8 +606,24 @@ (typeset c #t pfx1 pfx sfx #t)) (begin-for-syntax - (define-struct variable-id (sym) #:omit-define-syntaxes) - (define-struct element-id-transformer (proc) #:omit-define-syntaxes)) + (define-struct variable-id (sym) + #:omit-define-syntaxes + #:property prop:procedure (lambda (self stx) + (raise-syntax-error + #f + (string-append + "misuse of an identifier (not in `scheme', etc.) that is" + " bound as a code-typesetting variable") + stx))) + (define-struct element-id-transformer (proc) + #:omit-define-syntaxes + #:property prop:procedure (lambda (self stx) + (raise-syntax-error + #f + (string-append + "misuse of an identifier (not in `scheme', etc.) that is" + " bound as an code-typesetting element transformer") + stx)))) (define-syntax (define-code stx) (syntax-case stx () From 3dcd7182ab5dd1d1a8bb8bf64f52d662d7fb2618 Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Sun, 26 Apr 2009 07:50:35 +0000 Subject: [PATCH 10/18] Welcome to a new PLT day. svn: r14612 --- 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 705e13c09c..2afd4fd18d 100644 --- a/collects/repos-time-stamp/stamp.ss +++ b/collects/repos-time-stamp/stamp.ss @@ -1 +1 @@ -#lang scheme/base (provide stamp) (define stamp "25apr2009") +#lang scheme/base (provide stamp) (define stamp "26apr2009") From 6aef52d46c5b289a74d3974830e8f80b3c2b1139 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sun, 26 Apr 2009 13:21:31 +0000 Subject: [PATCH 11/18] fix syntax-local-lift-require when in the expression-expansion phase svn: r14613 --- src/mzscheme/src/module.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/mzscheme/src/module.c b/src/mzscheme/src/module.c index baebdfb46f..c5d0d05dab 100644 --- a/src/mzscheme/src/module.c +++ b/src/mzscheme/src/module.c @@ -6478,7 +6478,7 @@ static Scheme_Object *do_module_begin(Scheme_Object *form, Scheme_Comp_Env *env, e = scheme_expand_expr(e, nenv, &erec1, 0); } - lifted_reqs = scheme_append(scheme_frame_get_require_lifts(xenv), lifted_reqs); + lifted_reqs = scheme_append(scheme_frame_get_require_lifts(cenv), lifted_reqs); l = scheme_frame_get_lifts(cenv); if (SCHEME_NULLP(l)) { From 4141389b847687df4dc0d9d9141575f55c368338 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sun, 26 Apr 2009 15:24:50 +0000 Subject: [PATCH 12/18] fix some editor lock tracking svn: r14614 --- collects/mred/private/wxme/text.ss | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/collects/mred/private/wxme/text.ss b/collects/mred/private/wxme/text.ss index eb78bee857..34ed113112 100644 --- a/collects/mred/private/wxme/text.ss +++ b/collects/mred/private/wxme/text.ss @@ -4187,16 +4187,16 @@ (let ([at-start? (eq? (mline-snip line) snip1)] [at-end? (eq? (mline-last-snip line) snip2)] [wl? write-locked?] - [fl flow-locked?]) + [fl? flow-locked?]) (set! read-locked? #t) (set! write-locked? #t) (set! flow-locked? #t) (set-snip-flags! snip2 (add-flag (snip->flags snip2) CAN-SPLIT)) (let ([naya (send snip2 merge-with snip1)]) - (set! read-locked? #t) + (set! read-locked? #f) (set! write-locked? wl?) - (set! flow-locked? wl?) + (set! flow-locked? fl?) (if naya (begin From 119fd5bc95aa637fdee27c30223ccb63f80fdd25 Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Sun, 26 Apr 2009 17:55:02 +0000 Subject: [PATCH 13/18] Clarify docs. svn: r14615 --- collects/typed-scheme/ts-reference.scrbl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/collects/typed-scheme/ts-reference.scrbl b/collects/typed-scheme/ts-reference.scrbl index d2911b682b..14e73bdb6e 100644 --- a/collects/typed-scheme/ts-reference.scrbl +++ b/collects/typed-scheme/ts-reference.scrbl @@ -40,7 +40,7 @@ @defidform[Namespace] @defidform[EOF] @defidform[Char])]{ -These types represent primitive Scheme data.} +These types represent primitive Scheme data. Note that @scheme[Integer] represents exact integers.} @defidform[Any]{Any Scheme value. All other types are subtypes of @scheme[Any].} From 610b5c738801fce9081c4fcfbe1c0549b5933e48 Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Sun, 26 Apr 2009 20:04:42 +0000 Subject: [PATCH 14/18] typo svn: r14616 --- collects/scribblings/reference/cont-marks.scrbl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/collects/scribblings/reference/cont-marks.scrbl b/collects/scribblings/reference/cont-marks.scrbl index 145993b56e..512c7f409d 100644 --- a/collects/scribblings/reference/cont-marks.scrbl +++ b/collects/scribblings/reference/cont-marks.scrbl @@ -166,7 +166,7 @@ for programmatic use. A stack trace is extracted from an exception and displayed by the default error display handler (see -@scheme[current-error-display-handler]) for exceptions other than +@scheme[error-display-handler]) for exceptions other than @scheme[exn:fail:user] (see @scheme[raise-user-error] in @secref["errorproc"]).} From 308afeabf4fde74b3cde71dec1ae604a10f941ab Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sun, 26 Apr 2009 22:52:58 +0000 Subject: [PATCH 15/18] fix combo-field popdown arrow svn: r14617 --- collects/mred/private/wxme/editor-canvas.ss | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/collects/mred/private/wxme/editor-canvas.ss b/collects/mred/private/wxme/editor-canvas.ss index 7dab3fd130..a6f092d2b5 100644 --- a/collects/mred/private/wxme/editor-canvas.ss +++ b/collects/mred/private/wxme/editor-canvas.ss @@ -204,7 +204,7 @@ '(transparent) '(no-autoclear)) (keep-style style 'control-border) - (keep-style style 'combo-side) + (keep-style style 'combo) (keep-style style 'resize-corner)) name gl-config) From 3bc54919452f2544cdb28847a6811abf2de54d6e Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Mon, 27 Apr 2009 07:50:11 +0000 Subject: [PATCH 16/18] Welcome to a new PLT day. svn: r14622 --- 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 2afd4fd18d..c5fad359cb 100644 --- a/collects/repos-time-stamp/stamp.ss +++ b/collects/repos-time-stamp/stamp.ss @@ -1 +1 @@ -#lang scheme/base (provide stamp) (define stamp "26apr2009") +#lang scheme/base (provide stamp) (define stamp "27apr2009") From 30a3e8ced8ecf84790db87db1265086ed829c96f Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Mon, 27 Apr 2009 13:02:49 +0000 Subject: [PATCH 17/18] fix undo of delete implied by insert over a selection svn: r14623 --- collects/mred/private/wxme/text.ss | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/collects/mred/private/wxme/text.ss b/collects/mred/private/wxme/text.ss index 34ed113112..388e30bf0b 100644 --- a/collects/mred/private/wxme/text.ss +++ b/collects/mred/private/wxme/text.ss @@ -1700,9 +1700,7 @@ (set! write-locked? #t) (if (not (can-delete? start (- end start))) - (begin - (set! write-locked? #f) - (set! flow-locked? #f)) + (set! write-locked? #f) (begin (on-delete start (- end start)) @@ -1917,11 +1915,11 @@ [([(make-alts exact-nonnegative-integer? (symbol-in start)) start] [(make-alts exact-nonnegative-integer? (symbol-in back)) [end 'back]] [any? [scroll-ok? #t]]) - (do-delete (if (symbol? start) startpos start) end scroll-ok?)] + (do-delete (if (symbol? start) startpos start) end #t scroll-ok?)] (method-name 'text% 'delete))) (def/public (erase) - (do-delete 0 len #t)) + (do-delete 0 len #t #t)) (def/override (clear) (delete startpos endpos #t)) From 955f99fe4176d843fc9c49b645e7aaac37b83066 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Mon, 27 Apr 2009 14:32:30 +0000 Subject: [PATCH 18/18] svn: r14624 --- collects/framework/private/main.ss | 1 + 1 file changed, 1 insertion(+) diff --git a/collects/framework/private/main.ss b/collects/framework/private/main.ss index 97a074b8a7..fc55c8ef47 100644 --- a/collects/framework/private/main.ss +++ b/collects/framework/private/main.ss @@ -58,6 +58,7 @@ ("cond" 0) ("field" 0) ("provide/contract" 0) + ("match" 1) ("new" 1) ("case" 1) ("syntax-rules" 1)