Cocoa, 64-bit, 10.10 and later: use MMTabBarView

On 10.11 in 64-bit mode, showing a frame with a PSMTabBarControl
instance somehow causes the event loop to become occupied on
mouse movements, so that moving the mouse in a `2htdp/universe`
program is slow when more than one tab is open in DrRacket. The
modern MMTabBarView widget doesn't have that problem. Also, the
MMTabBarView widget has a Yosemite look (to replace Aqua).
This commit is contained in:
Matthew Flatt 2016-04-07 11:43:38 -06:00
parent 30c8202656
commit 9ef883a79f
3 changed files with 29 additions and 8 deletions

View File

@ -19,15 +19,33 @@
(define-runtime-path psm-tab-bar-dir
'(so "PSMTabBarControl.framework"))
(define-runtime-path mm-tab-bar-dir
;; This directory will not exist for platforms other than x86_64:
'(so "MMTabBarView.framework"))
;; Load PSMTabBarControl:
(void (ffi-lib (build-path psm-tab-bar-dir "PSMTabBarControl")))
(define use-mm?
(and (version-10.10-or-later?)
64-bit?
(directory-exists? mm-tab-bar-dir)))
;; Load MMTabBarView or PSMTabBarControl:
(if use-mm?
(void (ffi-lib (build-path mm-tab-bar-dir "MMTabBarView")))
(void (ffi-lib (build-path psm-tab-bar-dir "PSMTabBarControl"))))
(define NSNoTabsNoBorder 6)
(define NSDefaultControlTint 0)
(define NSClearControlTint 7)
(import-class NSView NSTabView NSTabViewItem PSMTabBarControl)
(import-class NSView NSTabView NSTabViewItem)
(define TabBarControl
(if use-mm?
(let ()
(import-class MMTabBarView)
MMTabBarView)
(let ()
(import-class PSMTabBarControl)
PSMTabBarControl)))
(import-protocol NSTabViewDelegate)
(define NSOrderedAscending -1)
@ -49,7 +67,7 @@
(when (and wx (send wx callbacks-enabled?))
(queue-window*-event wxb (lambda (wx) (send wx do-callback)))))))
(define-objc-class RacketPSMTabBarControl PSMTabBarControl
(define-objc-class RacketPSMTabBarControl TabBarControl
#:mixins (FocusResponder KeyMouseResponder CursorDisplayer)
[wxb]
(-a _void (tabView: [_id cocoa] didSelectTabViewItem: [_id item-cocoa])
@ -83,8 +101,10 @@
(tellv tabv-cocoa setDelegate: i)
(tellv tabv-cocoa setTabViewType: #:type _int NSNoTabsNoBorder)
(tellv i setTabView: tabv-cocoa)
(tellv i setStyleNamed: #:type _NSString "Aqua")
;;(tellv i setSizeCellsToFit: #:type _BOOL #t)
(tellv i setStyleNamed: #:type _NSString (if use-mm? "Yosemite" "Aqua"))
;; (tellv i setSizeCellsToFit: #:type _BOOL #t)
(when use-mm?
(tellv i setResizeTabsToFitTotalWidth: #:type _BOOL #t))
(tellv i setDisableTabClose: #:type _BOOL #t)
i)))

View File

@ -21,8 +21,6 @@
(define _OSStatus _sint32)
(define 64-bit? (= (ctype-sizeof _long) 8))
(define _CGFloat (make-ctype (if 64-bit? _double _float)
(lambda (v) (if (and (number? v)
(exact? v))

View File

@ -21,6 +21,7 @@
clean-menu-label
->wxb
->wx
64-bit?
old-cocoa?
version-10.6-or-later?
version-10.7-or-later?
@ -74,6 +75,8 @@
(and wxb
(weak-box-value wxb)))
(define 64-bit? (= (ctype-sizeof _long) 8))
(define-appkit NSAppKitVersionNumber _double)
(define old-cocoa?