diff --git a/collects/mred/private/kernel.ss b/collects/mred/private/kernel.ss index fd96e82066..04518e9d96 100644 --- a/collects/mred/private/kernel.ss +++ b/collects/mred/private/kernel.ss @@ -728,6 +728,7 @@ set-x-margin get-y-margin get-x-margin + clear-margins scroll-to set-lazy-refresh get-lazy-refresh diff --git a/collects/mred/private/wxcanvas.ss b/collects/mred/private/wxcanvas.ss index 2f1831ee1d..8f926a6b4d 100644 --- a/collects/mred/private/wxcanvas.ss +++ b/collects/mred/private/wxcanvas.ss @@ -14,12 +14,17 @@ (define (make-canvas-glue% %) ; implies make-window-glue% (class100 (make-window-glue% %) (mred proxy . args) - (inherit get-mred get-top-level) + (inherit get-mred get-top-level clear-margins) (public [do-on-char (lambda (e) (super on-char e))] [do-on-event (lambda (e) (super on-event e))] [do-on-scroll (lambda (e) (super on-scroll e))] [do-on-paint (lambda () (super on-paint))]) + (private + [clear-and-on-paint + (lambda (mred) + (clear-margins) + (send mred on-paint))]) (override [on-char (entry-point (lambda (e) @@ -54,9 +59,9 @@ ;; Windows circumvented the event queue; delay (queue-window-callback this - (lambda () (send mred on-paint))) - (as-exit (lambda () (send mred on-paint)))) - (as-exit (lambda () (super on-paint)))))))]) + (lambda () (clear-and-on-paint mred))) + (as-exit (lambda () (clear-and-on-paint mred)))) + (as-exit (lambda () (clear-margins) (super on-paint)))))))]) (sequence (apply super-init mred proxy args)))) (define wx-canvas% @@ -66,6 +71,7 @@ (private-field [tabable? #f]) (public + [clear-margins (lambda () (void))] [on-tab-in (lambda () (send (wx->mred this) on-tab-in))] [get-tab-focus (lambda () tabable?)] [set-tab-focus (lambda (v) (set! tabable? v))]) diff --git a/collects/scribblings/gui/editor-canvas-class.scrbl b/collects/scribblings/gui/editor-canvas-class.scrbl index 00946cdbfd..c9991181dd 100644 --- a/collects/scribblings/gui/editor-canvas-class.scrbl +++ b/collects/scribblings/gui/editor-canvas-class.scrbl @@ -235,7 +235,15 @@ Enables or disables the caret in the @techlink{display}'s editor, if (on-paint) void?]{ -Repaints the editor. +Repaints the editor, or clears the canvas if no editor is being +displayed. + +This method is called after clearing the margin around the editor, +unless the canvas is created with the @scheme['transparent] style, but +the editor area is not automatically cleared. In other words, +@scheme[editor-canvas%] update by default is like @scheme[canvas%] +update with the @scheme['no-autoclear] style, except that the margin +around the editor area is always cleared. } diff --git a/src/mred/wxme/wx_medad.cxx b/src/mred/wxme/wx_medad.cxx index f5c52d17a1..26917fa04c 100644 --- a/src/mred/wxme/wx_medad.cxx +++ b/src/mred/wxme/wx_medad.cxx @@ -671,42 +671,49 @@ void wxMediaCanvas::OnChar(wxKeyEvent *event) } } +void wxMediaCanvas::ClearMargins(void) +{ + /* This method is called by `on-paint' in `wx:canvas%' + before it calls the `on-paint' in `canvas%'. It's + essentially a compromise between autoclear mode and + no-autoclear mode. */ + + if (xmargin || ymargin) { + wxDC *adc; + wxColor *bg; + bg = GetCanvasBackground(); + if (bg) { + wxBrush *b, *ob; + wxPen *p, *op; + int cw, ch; + + GetClientSize(&cw, &ch); + + b = wxTheBrushList->FindOrCreateBrush(bg, wxSOLID); + p = wxThePenList->FindOrCreatePen("BLACK", 0, wxTRANSPARENT); + adc = GetDC(); + + ob = adc->GetBrush(); + op = adc->GetPen(); + adc->SetBrush(b); + adc->SetPen(p); + + adc->DrawRectangle(0, 0, xmargin, ch); + adc->DrawRectangle(cw-xmargin, 0, cw, ch); + adc->DrawRectangle(0, 0, cw, ymargin); + adc->DrawRectangle(0, ch-ymargin, cw, ch); + + adc->SetBrush(ob); + adc->SetPen(op); + } + } +} + void wxMediaCanvas::OnPaint(void) { need_refresh = FALSE; - if (media) { - /* Clear the margins */ - if (xmargin || ymargin) { - wxDC *adc; - wxColor *bg; - bg = GetCanvasBackground(); - if (bg) { - wxBrush *b, *ob; - wxPen *p, *op; - int cw, ch; - - GetClientSize(&cw, &ch); - - b = wxTheBrushList->FindOrCreateBrush(bg, wxSOLID); - p = wxThePenList->FindOrCreatePen("BLACK", 0, wxTRANSPARENT); - adc = GetDC(); - - ob = adc->GetBrush(); - op = adc->GetPen(); - adc->SetBrush(b); - adc->SetPen(p); - - adc->DrawRectangle(0, 0, xmargin, ch); - adc->DrawRectangle(cw-xmargin, 0, cw, ch); - adc->DrawRectangle(0, 0, cw, ymargin); - adc->DrawRectangle(0, ch-ymargin, cw, ch); - - adc->SetBrush(ob); - adc->SetPen(op); - } - } - + if (media) { if (!media->printing) { double w, h, x, y; GetView(&x, &y, &w, &h); diff --git a/src/mred/wxme/wx_medad.h b/src/mred/wxme/wx_medad.h index 59967cbd4c..6b3aba9263 100644 --- a/src/mred/wxme/wx_medad.h +++ b/src/mred/wxme/wx_medad.h @@ -455,6 +455,8 @@ class wxMediaCanvas : public wxCanvas virtual void Scroll(int x, int y, Bool refresh); + void ClearMargins(); + /* To block bad uses: */ virtual void Scroll(int x, int y); virtual void SetScrollbars(int h_pixels, int v_pixels, int x_len, int y_len, diff --git a/src/mred/wxs/wxs_madm.cxx b/src/mred/wxs/wxs_madm.cxx index a3cdb4a7c7..4407f955f2 100644 --- a/src/mred/wxs/wxs_madm.cxx +++ b/src/mred/wxs/wxs_madm.cxx @@ -241,6 +241,7 @@ typedef void *(*CAPOFunc)(void*); + class os_wxMediaCanvas : public wxMediaCanvas { public: @@ -1114,6 +1115,26 @@ static Scheme_Object *os_wxMediaCanvasGetXMargin(int n, Scheme_Object *p[]) return scheme_make_integer(r); } +static Scheme_Object *os_wxMediaCanvasClearMargins(int n, Scheme_Object *p[]) +{ + WXS_USE_ARGUMENT(n) WXS_USE_ARGUMENT(p) + REMEMBER_VAR_STACK(); + objscheme_check_valid(os_wxMediaCanvas_class, "clear-margins in editor-canvas%", n, p); + + SETUP_VAR_STACK_REMEMBERED(1); + VAR_STACK_PUSH(0, p); + + + + + WITH_VAR_STACK(((wxMediaCanvas *)((Scheme_Class_Object *)p[0])->primdata)->ClearMargins()); + + + + READY_TO_RETURN; + return scheme_void; +} + static Scheme_Object *os_wxMediaCanvasScrollTo(int n, Scheme_Object *p[]) { WXS_USE_ARGUMENT(n) WXS_USE_ARGUMENT(p) @@ -1474,7 +1495,7 @@ void objscheme_setup_wxMediaCanvas(Scheme_Env *env) wxREGGLOB(os_wxMediaCanvas_class); - os_wxMediaCanvas_class = WITH_VAR_STACK(objscheme_def_prim_class(env, "editor-canvas%", "canvas%", (Scheme_Method_Prim *)os_wxMediaCanvas_ConstructScheme, 29)); + os_wxMediaCanvas_class = WITH_VAR_STACK(objscheme_def_prim_class(env, "editor-canvas%", "canvas%", (Scheme_Method_Prim *)os_wxMediaCanvas_ConstructScheme, 30)); WITH_VAR_STACK(scheme_add_method_w_arity(os_wxMediaCanvas_class, "on-char" " method", (Scheme_Method_Prim *)os_wxMediaCanvasOnChar, 1, 1)); WITH_VAR_STACK(scheme_add_method_w_arity(os_wxMediaCanvas_class, "on-event" " method", (Scheme_Method_Prim *)os_wxMediaCanvasOnEvent, 1, 1)); @@ -1493,6 +1514,7 @@ void objscheme_setup_wxMediaCanvas(Scheme_Env *env) WITH_VAR_STACK(scheme_add_method_w_arity(os_wxMediaCanvas_class, "set-x-margin" " method", (Scheme_Method_Prim *)os_wxMediaCanvasSetXMargin, 1, 1)); WITH_VAR_STACK(scheme_add_method_w_arity(os_wxMediaCanvas_class, "get-y-margin" " method", (Scheme_Method_Prim *)os_wxMediaCanvasGetYMargin, 0, 0)); WITH_VAR_STACK(scheme_add_method_w_arity(os_wxMediaCanvas_class, "get-x-margin" " method", (Scheme_Method_Prim *)os_wxMediaCanvasGetXMargin, 0, 0)); + WITH_VAR_STACK(scheme_add_method_w_arity(os_wxMediaCanvas_class, "clear-margins" " method", (Scheme_Method_Prim *)os_wxMediaCanvasClearMargins, 0, 0)); WITH_VAR_STACK(scheme_add_method_w_arity(os_wxMediaCanvas_class, "scroll-to" " method", (Scheme_Method_Prim *)os_wxMediaCanvasScrollTo, 5, 6)); WITH_VAR_STACK(scheme_add_method_w_arity(os_wxMediaCanvas_class, "set-lazy-refresh" " method", (Scheme_Method_Prim *)os_wxMediaCanvasSetLazyRefresh, 1, 1)); WITH_VAR_STACK(scheme_add_method_w_arity(os_wxMediaCanvas_class, "get-lazy-refresh" " method", (Scheme_Method_Prim *)os_wxMediaCanvasGetLazyRefresh, 0, 0)); diff --git a/src/mred/wxs/wxs_madm.xc b/src/mred/wxs/wxs_madm.xc index ed92d361c0..27eec2a9f2 100644 --- a/src/mred/wxs/wxs_madm.xc +++ b/src/mred/wxs/wxs_madm.xc @@ -88,6 +88,8 @@ typedef void *(*CAPOFunc)(void*); @ "scroll-to" : bool ScrollTo(double,double,nndouble,nndouble, bool,SYM[bias]=0); : : : rFALSE +@ "clear-margins" : void ClearMargins(); + @ "get-x-margin" : nnint GetXMargin(); @ "get-y-margin" : nnint GetYMargin(); @ "set-x-margin" : void SetXMargin(nnint);