diff --git a/gui-lib/info.rkt b/gui-lib/info.rkt index dcd8bca3..726d14fd 100644 --- a/gui-lib/info.rkt +++ b/gui-lib/info.rkt @@ -6,7 +6,7 @@ "data-lib" ["base" #:version "6.2.900.17"] "syntax-color-lib" - ("draw-lib" #:version "1.6") + ["draw-lib" #:version "1.9"] "snip-lib" "wxme-lib" "pict-lib" diff --git a/gui-lib/mred/private/wx/cocoa/font.rkt b/gui-lib/mred/private/wx/cocoa/font.rkt index a27f1642..e10a76ec 100644 --- a/gui-lib/mred/private/wx/cocoa/font.rkt +++ b/gui-lib/mred/private/wx/cocoa/font.rkt @@ -3,13 +3,17 @@ racket/draw ffi/unsafe ffi/unsafe/objc + ffi/unsafe/alloc + racket/draw/unsafe/pango + racket/draw/private/dc "../../lock.rkt" "const.rkt" "utils.rkt" "types.rkt") (provide - (protect-out font->NSFont)) + (protect-out font->NSFont) + system-control-font-name) (import-class NSFont NSFontManager) @@ -47,3 +51,35 @@ (begin (retain f) f))))))))) + +;; ------------------------------------------------------------ + +;; As of OS X 10.11, the font that is used for controls is not +;; accessible through a font family. (The idea is that the face can +;; vary with the requested size --- but we don't want to go there in +;; general.) To make the main face accessible, we've added a hook to +;; Pango to register a family manually, mapping the family name to one +;; or more face descriptions. + +(define-cocoa kCTFontFamilyNameAttribute _pointer) +(define-cocoa CTFontDescriptorCopyAttribute (_fun _pointer _pointer -> _NSString)) +(define-cf CFRelease (_fun _pointer -> _void) + #:wrap (deallocator)) +(define-cocoa CTFontDescriptorCreateWithNameAndSize (_fun _NSString _CGFloat -> _pointer) + #:wrap (allocator CFRelease)) + +(define system-control-font-name + (and (version-10.11-or-later?) + (with-autorelease + (let ([control-font (tell NSFont systemFontOfSize: #:type _double 13.0)]) + (and control-font + (let ([desc (tell #:type _pointer control-font fontDescriptor)]) + (and desc + (CTFontDescriptorCopyAttribute desc kCTFontFamilyNameAttribute)))))))) + +(when system-control-font-name + (set-font-map-init-hook! + (lambda (fm) + (define n-desc (CTFontDescriptorCreateWithNameAndSize system-control-font-name 0.0)) + (pango_core_text_add_family_for_font_descriptors fm system-control-font-name 1 (vector n-desc)) + (CFRelease n-desc)))) diff --git a/gui-lib/mred/private/wx/cocoa/procs.rkt b/gui-lib/mred/private/wx/cocoa/procs.rkt index 24f97297..e79bf662 100644 --- a/gui-lib/mred/private/wx/cocoa/procs.rkt +++ b/gui-lib/mred/private/wx/cocoa/procs.rkt @@ -19,6 +19,7 @@ "cgl.rkt" "sound.rkt" "keycode.rkt" + "font.rkt" "../../lock.rkt" "../common/handlers.rkt" (except-in "../common/default-procs.rkt" @@ -88,11 +89,8 @@ (define (get-double-click-time) 500) (define (get-control-font-face) - ;; Using `(tell NSFont systemFontOfSize: ...)` gives us an OS-determined - ;; font, but my attempts to extract the name give something like ".LucidaGrandeUI" - ;; instead of "Lucida Grande" have failed. (cond - ;; [(version-10.11-or-later?) "San Francisco"] + [system-control-font-name] ; via (tell NSFont systemFontOfSize: ...) [(version-10.10-or-later?) "Helvetica Neue"] [else "Lucida Grande"])) (define (get-control-font-size) 13)