Mac OS: improve control alignment

As Cocoa rendering has changed slightly over versions, labels and
control content have become misaligned. Tweak control shapes to make
horizontally centered controls look better.

A better solution would involve controls reporting a baseline, and
then panel alignment modes that take baselines into account. That's a
much bigger change, however, since it would change the child-placement
protocol.

Author: mflatt

gui-lib/mred/private/wx/cocoa/button.rkt

@@ -112,29 +112,15 @@
               (make-NSSize (+ (NSSize-width (NSRect-size f)) 2)
                            (+ (NSSize-height (NSRect-size f)) 4))))))
 
-  (define-values (h-margin v-margin)
+  (define/override (get-margin-adjustments)
     (if liquid-glass?
         (if (eq? event-type 'check-box)
-            (values 1 1)
-            (values 5 5))
-        (values 0 0)))
-
-  (define/override (get-frame)
-    (define r (super get-frame))
-    (cond
-      [(and (= h-margin 0) (= v-margin 0))
-       r]
-      [else
-       (define p (NSRect-origin r))
-       (define s (NSRect-size r))
-       (make-NSRect (make-NSPoint (+ (NSPoint-x p) h-margin)
-                                  (+ (NSPoint-y p) v-margin))
-                    (make-NSSize (+ (NSSize-width s) (* 2 h-margin))
-                                 (+ (NSSize-height s) (* 2 h-margin))))]))
-
-  (define/override (set-frame x y w h)
-    (super set-frame (+ x v-margin) (+ y h-margin)
-           (max 0 (- w (* 2 h-margin))) (max 0 (- h (* 2 v-margin)))))
+            (values 1 1 1 1)
+            (values 5 5 5 5))
+        (if (and (eq? event-type 'check-box)
+                 (version-10.9-or-later?))
+            (values 0 0 0 4)
+            (values 0 0 0 0))))
 
   (define-values (cocoa image-cocoa)
     (if (and button-type

gui-lib/mred/private/wx/cocoa/canvas.rkt

@@ -513,6 +513,14 @@
      (define/override (set-size x y w h)
        (do-set-size x y w h))
 
+     (define/override (get-margin-adjustments)
+       (if (and is-combo?
+                (version-10.9-or-later?))
+           (if liquid-glass?
+               (values 0 -1 0 0)
+               (values 0 0 0 1))
+           (values 0 0 0 0)))
+
      (define tr #f)
 
      (define/override (show on?)

gui-lib/mred/private/wx/cocoa/choice.rkt

@@ -8,7 +8,8 @@
          "const.rkt"
          "utils.rkt"
          "window.rkt"
-         "../common/event.rkt")
+         "../common/event.rkt"
+         "liquid-glass.rkt")
 
 (provide 
  (protect-out choice%))
@@ -58,7 +59,13 @@
     (callback this (new control-event%
                         [event-type 'choice]
                         [time-stamp (current-milliseconds)])))
-  
+
+  (define/override (get-margin-adjustments)
+    (if (and (not liquid-glass?)
+             (version-10.9-or-later?))
+        (values 0 2 0 0)
+        (values 0 0 0 0)))
+
   (define/public (set-selection i)
     (tellv (get-cocoa) selectItemAtIndex: #:type _NSInteger i))
   (define/public (get-selection)

gui-lib/mred/private/wx/cocoa/message.rkt

@@ -117,6 +117,16 @@
              [callback void]
              [no-show? (memq 'deleted style)])
 
+  (define/override (get-margin-adjustments) (values 0
+                                                    (if (or liquid-glass?
+                                                            (not (version-10.9-or-later?)))
+                                                        0
+                                                        -3)
+                                                    0
+                                                    (if liquid-glass?
+                                                        -5
+                                                        0)))
+
   (define/override (set-label label)
     (set! text-label? (string? label))
     (cond

gui-lib/mred/private/wx/cocoa/window.rkt

@@ -738,13 +738,26 @@
 
     (define/public (is-group?) #f)
 
+    (define/public (get-margin-adjustments) (values 0 0 0 0))
+
     (define/public (get-frame)
       (tellv cocoa layoutSubtreeIfNeeded)
-      (tell #:type _NSRect cocoa frame))
+      (define r (tell #:type _NSRect cocoa frame))
+      (define-values (lm tm rm bm) (get-margin-adjustments))
+      (cond
+        [(= 0 lm tm rm bm) r]
+        [else
+         (define p (NSRect-origin r))
+         (define s (NSRect-size r))
+         (make-NSRect (make-NSPoint (- (NSPoint-x p) lm)
+                                    (- (NSPoint-y p) tm))
+                      (make-NSSize (+ (NSSize-width s) lm rm)
+                                   (+ (NSSize-height s) tm bm)))]))
 
     (define/public (set-frame x y w h)
-      (tellv cocoa setFrame: #:type _NSRect (make-NSRect (make-NSPoint x (flip y h))
-                                                         (make-NSSize w h))))
+      (define-values (lm tm rm bm) (get-margin-adjustments))
+      (tellv cocoa setFrame: #:type _NSRect (make-NSRect (make-NSPoint (+ x lm) (flip (+ y tm) (- h tm bm)))
+                                                         (make-NSSize (max 0 (- w lm rm)) (max 0 (- h tm bm))))))
 
     (define/public (flip y h)
       (if parent

gui-lib/mred/private/wxtextfield.rkt

@@ -200,10 +200,10 @@
           (if (null? children-info)
               null
               (let ([r (super-place-children children-info width height)])
-                (if horiz?
+                (if (and horiz? (pair? (cdr r)))
                     ;; Line up label right with text:
-                    (cons (list* (caar r) (+ (cadar r) dy) (cddar r))
-                          (cdr r))
+                    (list (list* (caar r) (+ (cadar r) dy) (cddar r))
+                          (list* (caadr r) (+ (cadadr r)) (cddadr r)))
                     r))))])
       (super-make-object #f proxy parent (if (memq 'deleted style) '(deleted) null) #f)
       (unless (memq 'deleted style)
@@ -215,6 +215,11 @@
          [(memq 'horizontal-label style) #t]
          [else (eq? (send (send parent get-window) get-label-position) 'horizontal)]))
       (define dy 0)
+      (define label-align-margin (if (memq 'combo style)
+                                     0
+                                     (case (system-type)
+                                       [(macosx) 2]
+                                       [else 0])))
       (define p
         (if horiz?
             this
@@ -286,7 +291,7 @@
         (send l skip-subwindow-events? #t)
         (send l x-margin 0))
       (send c set-x-margin 2)
-      (send c set-y-margin 2)
+      (send c set-y-margin (+ 2 label-align-margin))
       (send e set-line-spacing 0)
       (send e set-paste-text-only #t)
       (send e auto-wrap (and multi? (not (memq 'hscroll style))))