further Tahoe repairs and refinments

Tahoe's GUI changes affect the amount of padding around various
controls, especially buttons. Provide more consoistent path for
existing Racket applications by adding padding to bring things more in
line. Also, aubstantial extra padding is needed around the content of
a dialog box, where rounded corners especially cut into the content.

Author: mflatt

gui-lib/info.rkt

@@ -5,7 +5,7 @@
 (define deps '("srfi-lite-lib"
                "data-lib"
                ["icons" #:version "1.3"]
-               ["base" #:version "8.3.0.3"]
+               ["base" #:version "9.0.0.6"]
                ["syntax-color-lib" #:version "1.7"]
                ["draw-lib" #:version "1.18"]
                ["snip-lib" #:version "1.6"]

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

@@ -9,7 +9,8 @@
          "const.rkt"
          "window.rkt"
          "../common/event.rkt"
-         "image.rkt")
+         "image.rkt"
+         "liquid-glass.rkt")
 
 (provide 
  (protect-out button%
@@ -110,6 +111,30 @@
               (NSRect-origin f)
               (make-NSSize (+ (NSSize-width (NSRect-size f)) 2)
                            (+ (NSSize-height (NSRect-size f)) 4))))))
+
+  (define-values (h-margin v-margin)
+    (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)))))
 
   (define-values (cocoa image-cocoa)
     (if (and button-type

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

@@ -12,6 +12,7 @@
          "utils.rkt"
          "const.rkt"
          "types.rkt"
+         "liquid-glass.rkt"
          "window.rkt"
          "frame.rkt"
          "dc.rkt"
@@ -123,7 +124,7 @@
           (tellv ctx saveGraphicsState)
           (let ([cg (tell #:type _CGContextRef ctx graphicsPort)]
                 [r (tell #:type _NSRect self bounds)])
-            (CGContextSetRGBFillColor cg 0 0 0 1.0)
+            (CGContextSetRGBFillColor cg frame-black frame-black frame-black 1.0)
             (let* ([l (NSPoint-x (NSRect-origin r))]
                    [t (NSPoint-y (NSRect-origin r))]
                    [b (+ t (NSSize-height (NSRect-size r)))]
@@ -417,7 +418,8 @@
         (tell (tell (cond
                      [is-combo? NSView]
                      [has-control-border? FocusView]
-                     [(memq 'border style) (if (memq 'vscroll style)
+                     [(memq 'border style) (if (and (memq 'vscroll style)
+                                                    (not liquid-glass?))
                                                CornerlessFrameView
                                                FrameView)]
                      [else NSView])

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

@@ -6,6 +6,7 @@
          "utils.rkt"
          "const.rkt"
          "types.rkt"
+         "liquid-glass.rkt"
          "window.rkt"
          "queue.rkt"
          "menu-bar.rkt"
@@ -28,7 +29,7 @@
 
 (import-class NSWindow NSGraphicsContext NSMenu NSPanel
               NSApplication NSAutoreleasePool NSScreen
-              NSToolbar NSArray)
+              NSToolbar NSArray NSView)
 
 (define NSWindowCloseButton 0)
 (define NSWindowToolbarButton 3)
@@ -319,12 +320,37 @@
 
     (tellv cocoa setAcceptsMouseMovedEvents: #:type _BOOL #t)
 
+    (define inner-content-view
+      (cond
+        [(and is-dialog? liquid-glass?)
+         (import-class NSLayoutConstraint)
+         (define cv (tell (tell NSView alloc) init))
+         (define win (tell cocoa contentView))
+         (define margin 10)
+         (tellv win addSubview: cv)
+         (tellv cv setTranslatesAutoresizingMaskIntoConstraints: #:type _BOOL #false)
+         (tellv NSLayoutConstraint
+                activateConstraints:
+                (tell NSArray
+                      arrayWithObjects: #:type (_list i _id)
+                      (list
+                       (tell (tell cv topAnchor) constraintEqualToAnchor: (tell win topAnchor) constant: #:type _CGFloat margin)
+                       (tell (tell cv leadingAnchor) constraintEqualToAnchor: (tell win leadingAnchor) constant: #:type _CGFloat margin)
+                       (tell (tell cv trailingAnchor) constraintEqualToAnchor: (tell win trailingAnchor) constant: #:type _CGFloat (- margin))
+                       (tell (tell cv bottomAnchor) constraintEqualToAnchor: (tell win bottomAnchor) constant: #:type _CGFloat (- margin)))
+                      count: #:type _NSUInteger 4))
+         cv]
+        [else #f]))
+
     ;; Setting the window in one-shot mode helps prevent the
     ;;  frame from being resurrected by a click on the dock icon.
     (tellv cocoa setOneShot: #:type _BOOL #t)
 
+    (define/override (get-frame)
+      (tell #:type _NSRect cocoa frame))
+
     (define/override (get-cocoa-content) 
-      (tell cocoa contentView))
+      (or inner-content-view (tell cocoa contentView)))
     (define/override (get-cocoa-window) cocoa)
     (define/override (get-wx-window) this)
 

gui-lib/mred/private/wx/cocoa/liquid-glass.rkt

@@ -0,0 +1,27 @@
+#lang racket/base
+(require ffi/unsafe
+         ffi/unsafe/objc
+         "utils.rkt"
+         "types.rkt"
+         "const.rkt")
+
+(provide liquid-glass?)
+
+(define liquid-glass?
+  (and (version-26.0-or-later?)
+       (let ()
+         (import-class NSWindow)
+         (objc-class-has-instance-method? NSWindow (selector _cornerRadius))
+         ;; This seems like a terrible way to detect whether we're using
+         ;; the GUI rendering introduced in Tahoe (it depends on how Racket
+         ;; is linked, not the OS it runs on), but this is the best
+         ;; recommendation I can find for now:
+         (define cocoa
+           (tell (tell NSWindow alloc)
+                 initWithContentRect: #:type _NSRect (make-NSRect (make-NSPoint 0 0)
+                                                                  (make-NSSize 256 256))
+                 styleMask: #:type _int NSTitledWindowMask
+                 backing: #:type _int NSBackingStoreBuffered
+                 defer: #:type _BOOL NO))
+         ((tell #:type _double cocoa _cornerRadius) . > . 12.0))))
+

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

@@ -10,7 +10,8 @@
           "utils.rkt"
           "types.rkt"
           "image.rkt"
-          "color.rkt")
+          "color.rkt"
+          "liquid-glass.rkt")
 
 (provide
  (protect-out message%))
@@ -130,6 +131,26 @@
     (tellv (get-cocoa) sizeToFit)
     #t)
 
+  (define b-margin
+    (if liquid-glass?
+        4
+        0))
+
+  (define/override (get-frame)
+    (define r (super get-frame))
+    (cond
+      [(= b-margin 0)
+       r]
+      [else
+       (define p (NSRect-origin r))
+       (define s (NSRect-size r))
+       (make-NSRect p
+                    (make-NSSize (NSSize-width s)
+                                 (+ (NSSize-height s) b-margin)))]))
+
+  (define/override (set-frame x y w h)
+    (super set-frame x y w (max 0 (- h b-margin))))
+
   (define/public (get-color) color)
   (define/public (set-color c)
     (when text-label?

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

@@ -7,20 +7,26 @@
          "utils.rkt"
          "cg.rkt"
          "window.rkt"
-         "procs.rkt")
+         "procs.rkt"
+         "liquid-glass.rkt")
 
 (provide 
  (protect-out panel%
               panel-mixin
 
-              FrameView))
+              FrameView
+              frame-black
+              frame-white))
 
 (import-class NSView NSGraphicsContext)
 
 (define-objc-class RacketPanelView NSView
   #:mixins (KeyMouseTextResponder CursorDisplayer)
   [wxb])
 
+(define frame-black (if liquid-glass? 0.7 0))
+(define frame-white (if liquid-glass? 0.5 0.8))
+
 (define-objc-class FrameView NSView 
   []
   (-a #:async-apply (box (void))
@@ -33,10 +39,10 @@
           (cond
             [wob?
              (CGContextSetRGBFillColor cg 0 0 0 1.0)
-             (CGContextSetRGBStrokeColor cg 0.8 0.8 0.8 1.0)]
+             (CGContextSetRGBStrokeColor cg frame-white frame-white frame-white 1.0)]
             [else
              (CGContextSetRGBFillColor cg 1.0 1.0 1.0 1.0)
-             (CGContextSetRGBStrokeColor cg 0 0 0 1.0)])
+             (CGContextSetRGBStrokeColor cg frame-black frame-black frame-black 1.0)])
           (CGContextAddRect cg r)
           (CGContextStrokePath cg))
         (tellv ctx restoreGraphicsState))))

gui-lib/mred/private/wx/cocoa/radio-box.rkt

@@ -8,6 +8,7 @@
          "types.rkt"
          "const.rkt"
          "utils.rkt"
+         "liquid-glass.rkt"
          "window.rkt"
          "../common/event.rkt"
          "image.rkt")
@@ -85,7 +86,9 @@
                                            RacketImageButtonCell)
                             numberOfRows: #:type _NSInteger (if horiz? 1 (length labels))
                             numberOfColumns: #:type _NSInteger (if horiz? (length labels) 1)))])
-                (tellv cocoa setIntercellSpacing: #:type _NSSize (make-NSSize 2 2))
+                (tellv cocoa setIntercellSpacing: #:type _NSSize (if liquid-glass?
+                                                                     (make-NSSize 5 5)
+                                                                     (make-NSSize 2 2)))
                 (for ([label (in-list labels)]
                       [i (in-naturals)])
                   (let ([button (tell cocoa 

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

@@ -35,7 +35,8 @@
               version-10.15-or-later?
               version-11.0-or-later?
               version-12.0-or-later?
-              version-13.0-or-later?)
+              version-13.0-or-later?
+              version-26.0-or-later?)
  with-autorelease
  call-with-autorelease
  define-mz)
@@ -116,3 +117,5 @@
   (NSAppKitVersionNumber . >= . 2100))
 (define (version-13.0-or-later?) ; Ventura
   (NSAppKitVersionNumber . >= . 2200))
+(define (version-26.0-or-later?) ; Tahoe
+  (NSAppKitVersionNumber . >= . 2600))

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

@@ -738,9 +738,14 @@
 
     (define/public (is-group?) #f)
 
-    (define/private (get-frame)
+    (define/public (get-frame)
+      (tellv cocoa layoutSubtreeIfNeeded)
       (tell #:type _NSRect cocoa frame))
 
+    (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/public (flip y h)
       (if parent
           (let ([b (tell #:type _NSRect (send parent get-cocoa-content) bounds)])
@@ -810,8 +815,7 @@
             [y (if (not y) (get-y) y)])
         ;; old location will need refresh:
         (tellv cocoa setNeedsDisplay: #:type _BOOL #t)
-        (tellv cocoa setFrame: #:type _NSRect (make-NSRect (make-NSPoint x (flip y h))
-                                                           (make-NSSize w h)))
+        (set-frame x y w h)
         ;; new location needs refresh:
         (tellv cocoa setNeedsDisplay: #:type _BOOL #t))
       (queue-on-size))