suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

no callback for `tab-panel%' tab additions and deletions

Browse Source
This commit is contained in:
Matthew Flatt 2012-03-10 10:07:37 -07:00
parent 402fdaad9a
commit 97a64b1166
2 changed files with 40 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
collects/mred/private/wx/cocoa/tab-panel.rkt
View File

@ -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))

25
collects/mred/private/wx/gtk/tab-panel.rkt
View File

@ -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))