Mac OS X 10.11: register control font to make it Pango-accessible

The new system control font is (intentially) not associated with a
font family, so it's inaccessible via Pango. A patch to Pango lets
us synthesize and register new families, so the control font can
be made accessible.

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"

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

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)