From 618ab0567b0c68a2a28ba2441b08ec3e001800c2 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Sat, 10 Mar 2012 10:07:37 -0700
Subject: [PATCH] no callback for `tab-panel%' tab additions and deletions

original commit: 97a64b1166315382945826c0fb6d654f95ed7f0b
---
 collects/mred/private/wx/cocoa/tab-panel.rkt | 28 ++++++++++++++------
 collects/mred/private/wx/gtk/tab-panel.rkt   | 25 +++++++++++++----
 2 files changed, 40 insertions(+), 13 deletions(-)

diff --git a/collects/mred/private/wx/cocoa/tab-panel.rkt b/collects/mred/private/wx/cocoa/tab-panel.rkt
index b47d1874..6e8b11b1 100644
--- a/collects/mred/private/wx/cocoa/tab-panel.rkt
+++ b/collects/mred/private/wx/cocoa/tab-panel.rkt
@@ -149,6 +149,12 @@
 
   (public [append* append])
   (define (append* lbl)
+    (atomically
+     (set! callbacks-ok? #f)
+     (do-append lbl)
+     (set! callbacks-ok? #t)))
+
+  (define (do-append lbl)
     (let ([item (as-objc-allocation
                  (tell (tell NSTabViewItem alloc) initWithIdentifier: #f))])
       (tellv item setLabel: #:type _NSString (label->plain-label lbl))
@@ -160,16 +166,22 @@
              context: #:type _pointer content-cocoa)))
 
   (define/public (delete i)
-    (let ([item-cocoa (list-ref item-cocoas i)])
-      (tellv tabv-cocoa removeTabViewItem: item-cocoa)
-      (set! item-cocoas (remq item-cocoa item-cocoas))))
+    (atomically
+     (set! callbacks-ok? #f)
+     (let ([item-cocoa (list-ref item-cocoas i)])
+       (tellv tabv-cocoa removeTabViewItem: item-cocoa)
+       (set! item-cocoas (remq item-cocoa item-cocoas)))
+     (set! callbacks-ok? #t)))
 
   (define/public (set choices)
-    (for ([item-cocoa (in-list item-cocoas)])
-      (tellv tabv-cocoa removeTabViewItem: item-cocoa))
-    (set! item-cocoas null)
-    (for ([lbl (in-list choices)])
-      (append* lbl)))
+    (atomically
+     (set! callbacks-ok? #f)
+     (for ([item-cocoa (in-list item-cocoas)])
+       (tellv tabv-cocoa removeTabViewItem: item-cocoa))
+     (set! item-cocoas null)
+     (for ([lbl (in-list choices)])
+       (do-append lbl))
+     (set! callbacks-ok? #t)))
 
   (define callback void)
   (define/public (set-callback cb) (set! callback cb))
diff --git a/collects/mred/private/wx/gtk/tab-panel.rkt b/collects/mred/private/wx/gtk/tab-panel.rkt
index 896de01f..345bb9c4 100644
--- a/collects/mred/private/wx/gtk/tab-panel.rkt
+++ b/collects/mred/private/wx/gtk/tab-panel.rkt
@@ -127,6 +127,12 @@
 
     (public [append* append])
     (define (append* lbl)
+      (atomically
+       (set! callback-ok? #f)
+       (do-append lbl)
+       (set! callback-ok? #t)))
+
+    (define/private (do-append lbl)
       (let ([page
              (let ([bin-gtk (gtk_hbox_new #f 0)]
                    [label-gtk (gtk_label_new_with_mnemonic lbl)])
@@ -139,7 +145,7 @@
           (g_object_ref empty-bin-gtk)
           (gtk_notebook_remove_page gtk 0))))
 
-    (define/public (delete i)
+    (define/private (do-delete i)
       (let ([page (list-ref pages i)])
         (when (ptr-equal? current-bin-gtk (page-bin-gtk page))
           (let ([cnt (length pages)])
@@ -155,11 +161,20 @@
         (gtk_notebook_remove_page gtk i)
         (set! pages (remq page pages))))
 
+    (define/public (delete i)
+      (atomically
+       (set! callback-ok? #f)
+       (do-delete i)
+       (set! callback-ok? #t)))
+
     (define/public (set choices)
-      (for ([page (in-list pages)])
-        (delete 0))
-      (for ([lbl (in-list choices)])
-        (append* lbl)))
+      (atomically
+       (set! callback-ok? #f)
+       (for ([page (in-list pages)])
+         (do-delete 0))
+       (for ([lbl (in-list choices)])
+         (append* lbl))
+       (set! callback-ok? #t)))
 
     (define/public (set-label i str)
       (gtk_label_set_text_with_mnemonic (page-label-gtk (list-ref pages i))