fix some updating problems, especially under Mac OS X with transparent canvases

svn: r9825

collects/mrlib/name-message.ss

@@ -260,7 +260,7 @@
   
   (define label-width
     (if label
-        (let-values ([(w _1 _2 _3) (send dc get-text-extent label)])
+        (let-values ([(w _1 _2 _3) (send dc get-text-extent label button-label-font)])
           w)
         0))
   

src/mred/mred.cxx

@@ -2089,11 +2089,9 @@ static void MrEdQueueWindowCallback(wxWindow *wx_window, Scheme_Closed_Prim *scp
 static Scheme_Object *call_on_paint(void *d, int, Scheme_Object **argv)
 {
   wxWindow *w = (wxWindow *)d;
-#ifdef wx_msw
+
-  w->OnPaint();
-#else
   ((wxCanvas *)w)->DoPaint();
-#endif
+
   return scheme_void;
 }
 

src/mzscheme/src/env.c

@@ -67,9 +67,12 @@ Scheme_Hash_Table *locals_ht[2];
 Scheme_Env *scheme_initial_env;
 
 /* locals */
-static Scheme_Env *make_env(Scheme_Env *base, int semi, int toplevel_size);
 static void make_init_env(void);
 
+static Scheme_Env *make_env(Scheme_Env *base, int toplevel_size);
+static Scheme_Env *make_empty_inited_env(int toplevel_size);
+static Scheme_Env *make_empty_not_inited_env(int toplevel_size);
+
 static Scheme_Object *namespace_identifier(int, Scheme_Object *[]);
 static Scheme_Object *namespace_variable_value(int, Scheme_Object *[]);
 static Scheme_Object *namespace_set_variable_value(int, Scheme_Object *[]);
@@ -425,7 +428,7 @@ static void make_init_env(void)
   long startt;
 #endif
 
-  env = make_env(NULL, 0, GLOBAL_TABLE_SIZE);
+  env = make_empty_inited_env(GLOBAL_TABLE_SIZE);
 
   scheme_set_param(scheme_current_config(), MZCONFIG_ENV, 
 		   (Scheme_Object *)env);
@@ -739,71 +742,71 @@ void scheme_prepare_env_renames(Scheme_Env *env, int kind)
 
 Scheme_Env *scheme_make_empty_env(void)
 {
-  Scheme_Env *e; 
+  Scheme_Env *e;
 
-  e = make_env(NULL, 0, 7);
+  e = make_empty_inited_env(7);
 
   return e;
 }
 
-static Scheme_Env *make_env(Scheme_Env *base, int semi, int toplevel_size)
+Scheme_Env *make_empty_inited_env(int toplevel_size)
 {
-  Scheme_Bucket_Table *toplevel, *syntax;
+  Scheme_Env *env;
-  Scheme_Hash_Table *module_registry, *export_registry;
+  Scheme_Object *vector;
-  Scheme_Object *modchain;
+  Scheme_Hash_Table* hash_table;
-  Scheme_Env *env, *label_env;
 
-  toplevel = scheme_make_bucket_table(toplevel_size, SCHEME_hash_ptr);
+  env = make_env(NULL, toplevel_size);
-  toplevel->with_home = 1;
 
-  if (semi > 0) {
+  vector = scheme_make_vector(3, scheme_false);
-    syntax = NULL;
+  hash_table = scheme_make_hash_table(SCHEME_hash_ptr);
-    modchain = NULL;
+  SCHEME_VEC_ELS(vector)[0] = (Scheme_Object *)hash_table;
-    module_registry = NULL;
+  env->modchain = vector;
-    export_registry = NULL;
-    label_env = NULL;
-  } else {
-    syntax = scheme_make_bucket_table(7, SCHEME_hash_ptr);
-    if (base) {
-      modchain = base->modchain;
-      module_registry = base->module_registry;
-      export_registry = base->export_registry;
-      label_env = base->label_env;
-    } else {
-      if (semi < 0) {
-	module_registry = NULL;
-	export_registry = NULL;
-	modchain = NULL;
-        label_env = NULL;
-      } else {
-	Scheme_Hash_Table *modules;
 
-	modules = scheme_make_hash_table(SCHEME_hash_ptr);
+  hash_table = scheme_make_hash_table(SCHEME_hash_ptr);
-	modchain = scheme_make_vector(3, scheme_false);
+  env->module_registry = hash_table;
-	SCHEME_VEC_ELS(modchain)[0] = (Scheme_Object *)modules;
+  env->module_registry->iso.so.type = scheme_module_registry_type;
 
-	module_registry = scheme_make_hash_table(SCHEME_hash_ptr);
+  hash_table = scheme_make_hash_table(SCHEME_hash_ptr);
-	module_registry->iso.so.type = scheme_module_registry_type;
+  env->export_registry = hash_table;
-	
+  env->label_env = NULL;
-	export_registry = scheme_make_hash_table(SCHEME_hash_ptr);
 
-        label_env = NULL;
+  return env;
-      }
+}
-    }
+
-  }
+Scheme_Env *make_empty_not_inited_env(int toplevel_size)
+{
+  Scheme_Env *e;
+
+  e = make_env(NULL, toplevel_size);
+
+  return e;
+}
+
+static Scheme_Env *make_env(Scheme_Env *base, int toplevel_size)
+{
+  Scheme_Env *env;
+  Scheme_Bucket_Table *bucket_table;
 
   env = MALLOC_ONE_TAGGED(Scheme_Env);
   env->so.type = scheme_namespace_type;
 
-  env->toplevel = toplevel;
+  bucket_table = scheme_make_bucket_table(toplevel_size, SCHEME_hash_ptr);
+  env->toplevel = bucket_table;
+  env->toplevel->with_home = 1;
 
-  env->label_env = label_env;
+  bucket_table = scheme_make_bucket_table(7, SCHEME_hash_ptr);
+  env->syntax = bucket_table;
 
-  if (semi < 1) {
+  if (base) {
-    env->syntax = syntax;
+    env->modchain = base->modchain;
-    env->modchain = modchain;
+    env->module_registry = base->module_registry;
-    env->module_registry = module_registry;
+    env->export_registry = base->export_registry;
-    env->export_registry = export_registry;
+    env->label_env = base->label_env;
+  } else {
+    env->modchain = NULL;
+    env->module_registry = NULL;
+    env->export_registry = NULL;
+    env->label_env = NULL;
   }
 
   return env;
@@ -814,7 +817,7 @@ scheme_new_module_env(Scheme_Env *env, Scheme_Module *m, int new_exp_module_tree
 {
   Scheme_Env *menv;
 
-  menv = make_env(env, 0, 7);
+  menv = make_env(env, 7);
 
   menv->module = m;
 
@@ -842,7 +845,7 @@ void scheme_prepare_exp_env(Scheme_Env *env)
 
     scheme_prepare_label_env(env);
 
-    eenv = make_env(NULL, -1, 7);
+    eenv = make_empty_not_inited_env(7);
     eenv->phase = env->phase + 1;
     eenv->mod_phase = env->mod_phase + 1;
 
@@ -883,7 +886,7 @@ void scheme_prepare_template_env(Scheme_Env *env)
 
     scheme_prepare_label_env(env);
 
-    eenv = make_env(NULL, -1, 7);
+    eenv = make_empty_not_inited_env(7);
     eenv->phase = env->phase - 1;
     eenv->mod_phase = env->mod_phase - 1;
 
@@ -923,7 +926,7 @@ void scheme_prepare_label_env(Scheme_Env *env)
     Scheme_Object *modchain;
     Scheme_Hash_Table *prev_modules;
 
-    lenv = make_env(NULL, -1, 7);
+    lenv = make_empty_not_inited_env(7);
     lenv->phase = 0;
     lenv->mod_phase = 0;
 
@@ -3908,7 +3911,7 @@ static Scheme_Object *do_variable_namespace(const char *who, int tl, int argc, S
       env = env->template_env;
     }
   } else {
-    env = make_env(env, 0, 0);
+    env = make_env(env, 0);
     
     /* rewind modchain to phase 0: */
     while (ph--) {

src/mzscheme/src/list.c

@@ -633,22 +633,10 @@ scheme_init_list (Scheme_Env *env)
 
 Scheme_Object *scheme_make_pair(Scheme_Object *car, Scheme_Object *cdr)
 {
-#ifndef MZ_PRECISE_GC
-  Scheme_Object *cons;
-#endif
-
-#if 0
-  if (!car || !cdr
-      || (SCHEME_TYPE(car) < 0)
-      || (SCHEME_TYPE(cdr) < 0)
-      || (SCHEME_TYPE(car) >= (_scheme_last_type_ + 10)) /* +10 leaves room of external types */
-      || (SCHEME_TYPE(cdr) >= (_scheme_last_type_ + 10)))
-    *(long *)0x0 = 1;
-#endif
-
 #ifdef MZ_PRECISE_GC
   return GC_malloc_pair(car, cdr);
 #else
+  Scheme_Object *cons;
   cons = scheme_alloc_object();
   cons->type = scheme_pair_type;
   SCHEME_CAR(cons) = car;

src/wxmac/include/mac/wx_canvs.h

@@ -39,6 +39,7 @@ class wxCanvas: public wxbCanvas
   wxBorderArea *canvas_border;
   wxColour *bgcol;
   wxScrollArea* cScrollArea;
+  RgnHandle needs_update;
 
   //=============================================================================
   // Public constructors
@@ -164,6 +165,7 @@ class wxCanvas: public wxbCanvas
   virtual void Paint(void);
   void DoPaint(void);
   virtual void OnPaint(void);
+  virtual void PaintRgn(RgnHandle rgn);
         
   virtual void OnSetFocus(void);
   virtual void OnKillFocus(void);
@@ -180,6 +182,8 @@ class wxCanvas: public wxbCanvas
 
   Bool SetAsControl();
 
+  void AddPaintRegion(RgnHandle r);
+
  protected:
   void ChangeToGray(Bool Gray);
 };

src/wxmac/include/mac/wx_win.h

@@ -321,6 +321,7 @@ class wxWindow: public wxbWindow
   /* Other methods */
   /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
   virtual void Paint(void);
+  virtual void PaintRgn(RgnHandle rgn);
   virtual void Refresh(void);
   virtual void RefreshIfUpdating(void);
 	

src/wxmac/src/mac/wx_canvs.cc

@@ -95,6 +95,10 @@ wxCanvas::wxCanvas // Constructor (given parentWindow)
 wxCanvas::~wxCanvas(void)
 {
   if (wx_dc) DELETE_OBJ wx_dc;
+  if (needs_update) {
+    DisposeRgn(needs_update);
+    needs_update = NULL;
+  }
 }
 
 //=============================================================================
@@ -501,8 +505,10 @@ void wxCanvas::SetScrollData
 	scrollRect.right = clientArea->Width();
 	OffsetRect(&scrollRect,SetOriginX,SetOriginY);
 	::ScrollRect(&scrollRect, -dH, -dV, theUpdateRgn);
-	if (!EmptyRgn(theUpdateRgn))
+	if (!EmptyRgn(theUpdateRgn)) {
+          AddPaintRegion(theUpdateRgn);
 	  need_repaint = 1;
+        }
 	::DisposeRgn(theUpdateRgn);
       }
       theDC->auto_device_origin_x += -dH;
@@ -857,6 +863,22 @@ int wxCanvas::GetScrollRange(int dir)
 void wxCanvas::DoPaint(void)
 {
   if (!cHidden) {
+    RgnHandle rgn;
+
+    if (needs_update) {
+      if (EmptyRgn(needs_update))
+        return;
+
+      rgn = NewRgn();
+      if (rgn) {
+        CopyRgn(needs_update, rgn);
+        SetRectRgn(needs_update, 0, 0, 0, 0);
+        wx_dc->onpaint_reg = rgn;
+        wx_dc->SetCanvasClipping();
+      }
+    } else
+      rgn = NULL;
+
     if (!(cStyle & wxTRANSPARENT_WIN)
 	&& !(cStyle & wxNO_AUTOCLEAR)) {
       Rect itemRect;
@@ -873,24 +895,49 @@ void wxCanvas::DoPaint(void)
       EraseRect(&itemRect);
       SetThemeDrawingState(s, TRUE);
     }
-    
+
     OnPaint();
+
+    if (rgn) {
+      wx_dc->onpaint_reg = NULL;
+      wx_dc->SetCanvasClipping();
+      DisposeRgn(rgn);
+    }
   }
 }
 
-void wxCanvas::Paint(void)
+void wxCanvas::AddPaintRegion(RgnHandle rgn)
+{
+  if (!needs_update) {
+    needs_update = NewRgn();
+  }
+
+  if (rgn) {
+    UnionRgn(rgn, needs_update, needs_update);
+  } else {
+    SetRectRgn(needs_update, -32000, -32000, 32000, 32000);
+  }
+}
+
+void wxCanvas::PaintRgn(RgnHandle rgn)
 {
   if (!cHidden) {
     if (cStyle & wxAS_CONTROL) {
       /* Run on-paint atomically */
       MrEdAtomicallyPaint(this);
     } else {
+      AddPaintRegion(rgn);
       /* In wx_frame.cc: */
       wxCallDoPaintOrQueue(this);
     }
   }
 }
 
+void wxCanvas::Paint()
+{
+  PaintRgn(NULL);
+}
+
 void wxCanvas::OnPaint(void)
 {
   /* Do nothing */

src/wxmac/src/mac/wx_win.cc

@@ -487,10 +487,11 @@ static OSStatus paintControlHandler(EventHandlerCallRef inCallRef,
 	  if (wx_window) {
 	    RgnHandle clipRgn;
 	    wxMacDC *mdc;
-
+            int need_reset_user = 0;
+          
 	    GetGWorld(&savep, &savegd);
 	    GetThemeDrawingState(&s);
-
+            
 	    clipRgn = NewRgn();
 	    if (clipRgn)
 	      GetClip(clipRgn);
@@ -501,6 +502,20 @@ static OSStatus paintControlHandler(EventHandlerCallRef inCallRef,
 
 	    wx_window->SetCurrentDC();
             ::TextMode(srcOr); /* for drawing labels */
+
+            if (clipRgn && (wx_window->__type == wxTYPE_MESSAGE)) {
+              /* Need proper clipping for messages, since we draw 
+                 manually and transparently. */
+              RgnHandle r2;
+              r2 = NewRgn();
+              if (r2) {
+                CopyRgn(clipRgn, r2);
+                OffsetRgn(r2, SetOriginX, SetOriginY);
+                SetClip(r2);
+                DisposeRgn(r2);
+                need_reset_user = 1;
+              }
+            }
 #if 0
 	    {
 	      Rect bounds;
@@ -509,7 +524,10 @@ static OSStatus paintControlHandler(EventHandlerCallRef inCallRef,
 	      FrameRect(&bounds);
 	    }
 #endif
-	    wx_window->Paint();
+	    wx_window->PaintRgn(clipRgn);
+
+            if (need_reset_user)
+              mdc->setCurrentUser(NULL);
 
 	    SetGWorld(savep, savegd);
 	    SetThemeDrawingState(s, TRUE);
@@ -1779,6 +1797,11 @@ void wxWindow::Paint(void)
 {
 }
 
+void wxWindow::PaintRgn(RgnHandle rgn)
+{
+  Paint();
+}
+
 //-----------------------------------------------------------------------------
 
 // Enabling Logic:  a window (or control) is shown as OS-activated when

src/wxwindow/include/msw/wx_canvs.h

@@ -22,6 +22,7 @@ class wxCanvas: public wxbCanvas
 {
  public:
   wxWindow *combo;
+  int need_update;
 
   wxCanvas(void);
   wxCanvas(wxWindow *parent, int x=-1, int y=-1, int width=-1, int height=-1,
@@ -72,6 +73,8 @@ class wxCanvas: public wxbCanvas
 
   virtual Bool AcceptsExplicitFocus();
 
+  void DoPaint(void);
+
  private:
   wxColour *bgcol;
 };

src/wxwindow/src/msw/wx_canvs.cxx

@@ -673,7 +673,10 @@ BOOL wxCanvasWnd::OnPaint(void)
       BeginPaint(handle, &ps);
 
       /* We used to call wx_window->OnPaint directly;
-	 now we queue an event. */
+	 now we queue an event. The need_update flag
+         avoids multiple updats with we queue multiple
+         events before the first is handled. */
+      ((wxCanvas *)wx_window)->need_update = 1;
       MrEdQueuePaint(wx_window);
 
       EndPaint(handle, &ps);
@@ -687,3 +690,11 @@ BOOL wxCanvasWnd::OnPaint(void)
 
   return retval;
 }
+
+void wxCanvas::DoPaint()
+{
+  if (need_update) {
+    need_update = 0;
+    OnPaint();
+  }
+}