linux & mac support, refactoring on minimize

README.md

@@ -1,10 +1,14 @@
 # racket-tray
 
-A small system tray API for Racket.
+A small cross-platform system tray API for Racket GUI applications.
 
-Version 0.1.1 implements Windows directly through the Win32 API. It uses the
+Version 0.1.1 contains native backends for Windows, Linux and macOS:
-native `HWND` of an existing Racket `frame%` or `dialog%`, `Shell_NotifyIconW`,
+
-and `SetWindowSubclass`. No additional native DLL is required.
+- Windows uses `Shell_NotifyIconW` and `SetWindowSubclass`.
+- Linux uses Ayatana AppIndicator and GTK3.
+- macOS uses AppKit `NSStatusItem` and `NSMenu` through Racket's Objective-C FFI.
+
+The public API and symbolic menu actions are the same on every platform.
 
 ```racket
 #lang racket/gui
@@ -28,35 +32,106 @@ and `SetWindowSubclass`. No additional native DLL is required.
   (when (send frame is-iconized?)
     (send frame iconize #f)))
 
+(define (tray-action action)
+  (case action
+    [(open)
+     (show-frame)]
+    [(exit)
+     (tray-close tray)
+     (exit)]))
+
 (define tray
   (mk-tray frame
            "example.png"
-           show-frame
+           (list tray-action 'open)
            #:hide-on-minimize? #t))
 
 (tray-set-menu!
  tray
  (list
-  (list "Open" show-frame)
+  (list 'open "Open")
   'separator
-  (list "Exit"
+  (list 'exit "Exit")))
-        (λ ()
-          (tray-close tray)
-          (exit)))))
 
 (send frame show #t)
 ```
 
-`mk-tray` and `tray-set-icon!` accept both Windows `.ico` files and `.png`
+## Action and menu model
-files. PNG transparency is preserved when the image is converted to a native
-Windows tray icon.
 
-With `#:hide-on-minimize? #t`, minimizing the associated window hides it from
+The third argument of `mk-tray` is mandatory and has the form:
-the taskbar while keeping its native window handle alive. Closing a window to
-the tray does not need a separate tray API: override `frame%`'s `on-close` and
-call `(send this show #f)`.
 
-`tray-set-menu!` accepts a `popup-menu%` object directly, a simple menu list,
+```racket
-or `#f` to remove the context menu.
+(list callback default-action-id)
+```
 
-At the moment non-Windows platforms report that the operation is unsupported.
+`callback` accepts one symbol. `default-action-id` is a symbol that must also
+occur in the menu installed by `tray-set-menu!`.
+
+A menu contains `(list action-id label)` entries and separators:
+
+```racket
+(list
+ (list 'open "Open")
+ 'separator
+ (list 'exit "Exit"))
+```
+
+Choosing a menu item calls the callback with its action identifier. In the
+example above, choosing `Open` calls `(tray-action 'open)` and choosing `Exit`
+calls `(tray-action 'exit)`.
+
+Direct tray activation is platform dependent:
+
+- **Windows:** a normal activation invokes the configured default action.
+  The context-menu gesture opens the tray menu.
+- **Linux with Ayatana AppIndicator 0.6 or newer:** a primary activation can
+  invoke the configured default action. The context-menu gesture opens the
+  menu.
+- **Linux with Ayatana AppIndicator 0.5.x:** primary activation opens the menu;
+  the older library has no primary-activation callback.
+- **macOS:** the native status item opens its menu. Menu selections invoke the
+  symbolic callback. The default id remains part of the common API but is not
+  invoked directly by an `NSStatusItem` with an attached menu.
+
+## Hide on minimize
+
+`#:hide-on-minimize?` is implemented in the platform-independent Racket layer.
+It periodically checks `frame%`'s public `is-iconized?` method and hides the
+frame when it becomes iconized. No Win32, GTK or AppKit minimize hook is used.
+
+Closing a frame to the tray is separate because Racket already has the public
+`on-close` callback. Override it and call `(send this show #f)` as shown above.
+
+## Icons
+
+`example.png` is suitable on all three supported platforms. Windows also
+accepts `.ico`; PNG alpha transparency is converted to a native `HICON` by the
+Windows backend. Linux passes an absolute image path to AppIndicator. macOS
+loads the image with `NSImage`.
+
+## Linux runtime dependency
+
+Linux requires the Ayatana AppIndicator GTK3 runtime library. `racket-tray`
+loads the native shared library dynamically. If it is missing, `mk-tray`
+reports the dependency and the appropriate package commands instead of
+exposing a raw FFI loader error.
+
+Debian/Ubuntu:
+
+```text
+sudo apt install libayatana-appindicator3-1
+```
+
+Fedora:
+
+```text
+sudo dnf install libayatana-appindicator-gtk3
+```
+
+Arch Linux:
+
+```text
+sudo pacman -S libayatana-appindicator
+```
+
+No additional native dependency is required by the Windows or macOS backend.

examples/simple.rkt

@@ -5,10 +5,12 @@
 
 ;; This example demonstrates the two common "close to tray" behaviours:
 ;;
-;;   * minimize: handled by racket-tray through #:hide-on-minimize?
+;;   * minimize: handled portably by racket-tray through
+;;               #:hide-on-minimize?
 ;;   * close [X]: handled by frame%'s normal on-close callback
 ;;
-;; The frame remains alive in both cases because the tray icon uses its HWND.
+;; The frame remains alive in both cases. Only the tray menu's Exit action
+;; terminates the application.
 (define simple%
   (class frame%
     (super-new [label "Racket Tray"]
@@ -17,7 +19,7 @@
 
     (define lbl
       (new message%
-           [label "Counting tray clicks"]
+           [label "Counting tray activations"]
            [parent this]
            [auto-resize #t]
            [stretchable-width #t]))
@@ -27,11 +29,11 @@
     (define/public (count-next)
       (set! count (add1 count))
       (send lbl set-label
-            (format "Counting tray clicks: ~a" count)))
+            (format "Counting tray activations: ~a" count)))
 
     ;; Clicking the window's close button hides the frame instead of
     ;; destroying it. The tray menu's Exit item terminates the application.
-    (define/override (on-close)
+    (define/augment (on-close)
       (send this show #f))))
 
 (define frame (new simple%))
@@ -42,32 +44,44 @@
 ; post   : frame is visible and no longer iconized.
 ; result : Unspecified.
 ; internals:
-;          A frame hidden in response to SIZE_MINIMIZED can still retain its
+;          The portable minimize watcher hides an iconized frame. Explicitly
-;          iconized state, so show #t is followed by iconize #f when needed.
+;          de-iconizing here makes restoring predictable on every platform.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (define (show-frame)
-  ;; A frame hidden after a minimize can still be iconized. Make sure it is
-  ;; restored when it is opened from the tray.
   (send frame show #t)
   (when (send frame is-iconized?)
     (send frame iconize #f)))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Handle every symbolic action generated by the tray icon/menu.
+; pre    : action is one of the identifiers installed with tray-set-menu!.
+; post   : 'open restores the frame and increments the counter; 'exit removes
+;          the tray icon and terminates the example.
+; result : Unspecified.
+; internals:
+;          The same callback is used for menu selections and for native direct
+;          activation on platforms that support the configured default action.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (tray-action action)
+  (case action
+    [(open)
+     (send frame count-next)
+     (show-frame)]
+    [(exit)
+     (tray-close tray)
+     (exit)]))
+
 (define tray
   (mk-tray frame
            "simple.png"
-           (λ ()
+           (list tray-action 'open)
-             (send frame count-next)
-             (show-frame))
            #:hide-on-minimize? #t))
 
 (tray-set-menu!
  tray
  (list
-  (list "Open" show-frame)
+  (list 'open "Open")
   'separator
-  (list "Exit"
+  (list 'exit "Exit")))
-        (λ ()
-          (tray-close tray)
-          (exit)))))
 
 (send frame show #t)

info.rkt

@@ -4,7 +4,7 @@
 (define version "0.1.1")
 (define license 'MIT)
 (define collection "racket-tray")
-(define pkg-desc "A tray icon for Racket")
+(define pkg-desc "A cross-platform tray icon for Racket")
 
 (define scribblings
   '(("scrbl/racket-tray.scrbl" () (library 0))))

main.rkt

@@ -1,30 +1,60 @@
 #lang racket/base
 
-(require racket/runtime-path)
+(require racket/class
+         racket/gui/base
+         racket/runtime-path)
 
 (provide mk-tray
          tray-close
          tray-set-icon!
          tray-set-menu!)
 
-;; The platform implementation is loaded dynamically so that requiring
+;; Platform backends are loaded dynamically so requiring racket-tray stays
-;; racket-tray remains possible on platforms that do not yet have a backend.
+;; possible when a platform-specific native dependency is not installed.
 (define-runtime-module-path windows-module "private/windows.rkt")
+(define-runtime-module-path linux-module "private/linux.rkt")
+(define-runtime-module-path macos-module "private/macos.rkt")
 
 (define platform-mk-tray #f)
 (define platform-tray-close #f)
 (define platform-tray-set-icon! #f)
 (define platform-tray-set-menu! #f)
 
-(when (eq? (system-type 'os*) 'windows)
+(cond
-  (set! platform-mk-tray
+  [(eq? (system-type 'os) 'windows)
-        (dynamic-require windows-module 'mk-tray))
+   (set! platform-mk-tray
-  (set! platform-tray-close
+         (dynamic-require windows-module 'mk-tray))
-        (dynamic-require windows-module 'tray-close))
+   (set! platform-tray-close
-  (set! platform-tray-set-icon!
+         (dynamic-require windows-module 'tray-close))
-        (dynamic-require windows-module 'tray-set-icon!))
+   (set! platform-tray-set-icon!
-  (set! platform-tray-set-menu!
+         (dynamic-require windows-module 'tray-set-icon!))
-        (dynamic-require windows-module 'tray-set-menu!)))
+   (set! platform-tray-set-menu!
+         (dynamic-require windows-module 'tray-set-menu!))]
+  [(eq? (system-type 'os) 'unix)
+   (set! platform-mk-tray
+         (dynamic-require linux-module 'mk-tray))
+   (set! platform-tray-close
+         (dynamic-require linux-module 'tray-close))
+   (set! platform-tray-set-icon!
+         (dynamic-require linux-module 'tray-set-icon!))
+   (set! platform-tray-set-menu!
+         (dynamic-require linux-module 'tray-set-menu!))]
+  [(eq? (system-type 'os) 'macosx)
+   (set! platform-mk-tray
+         (dynamic-require macos-module 'mk-tray))
+   (set! platform-tray-close
+         (dynamic-require macos-module 'tray-close))
+   (set! platform-tray-set-icon!
+         (dynamic-require macos-module 'tray-set-icon!))
+   (set! platform-tray-set-menu!
+         (dynamic-require macos-module 'tray-set-menu!))])
+
+;; The public tray value keeps only platform-independent state. Native state is
+;; owned entirely by the backend stored in platform-tray.
+(struct tray (platform-tray
+              default-action
+              minimize-timer)
+  #:mutable)
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Supporting functions
@@ -40,7 +70,128 @@
 ;          attempted tray operation fails when no backend was loaded.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (define (unsupported who)
-  (error who "not supported on this operating system: ~a" (system-type 'os*)))
+  (error who "not supported on this operating system: ~a" (system-type 'os)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Validate and split the action specification supplied to mk-tray.
+; pre    : action-spec is any Racket value.
+; post   : No state is changed.
+; result : Two values: a one-argument callback and its default action symbol;
+;          raises an argument exception for any other shape.
+; internals:
+;          A single application callback is shared by direct tray activation
+;          and menu items. The second list value identifies the menu action
+;          used for a platform-supported primary-click activation.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (action-spec->values action-spec)
+  (cond
+    [(and (list? action-spec)
+          (= (length action-spec) 2))
+     (let ((callback (car action-spec))
+           (default-action (cadr action-spec)))
+       (unless (and (procedure? callback)
+                    (procedure-arity-includes? callback 1))
+         (raise-argument-error
+          'mk-tray
+          "(list/c (procedure-arity-includes/c 1) symbol?)"
+          action-spec))
+       (unless (symbol? default-action)
+         (raise-argument-error
+          'mk-tray
+          "(list/c (procedure-arity-includes/c 1) symbol?)"
+          action-spec))
+       (values callback default-action))]
+    [else
+     (raise-argument-error
+      'mk-tray
+      "(list/c (procedure-arity-includes/c 1) symbol?)"
+      action-spec)]))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Validate a platform-independent tray menu specification.
+; pre    : menu-spec is any Racket value.
+; post   : No state is changed.
+; result : A list of the action symbols present in menu-spec; raises a precise
+;          argument error for malformed entries or duplicate action symbols.
+; internals:
+;          A menu contains (list action-id label) entries and separator
+;          markers. Keeping callbacks out of the menu specification gives all
+;          platforms the same action-dispatch API.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (menu-action-ids menu-spec)
+  (unless (list? menu-spec)
+    (raise-argument-error 'tray-set-menu! "list?" menu-spec))
+  (let loop ((entries menu-spec)
+             (ids '()))
+    (cond
+      [(null? entries)
+       (reverse ids)]
+      [else
+       (let ((entry (car entries)))
+         (cond
+           [(or (eq? entry 'separator)
+                (eq? entry #f))
+            (loop (cdr entries) ids)]
+           [(and (list? entry)
+                 (= (length entry) 2)
+                 (symbol? (car entry))
+                 (string? (cadr entry)))
+            (let ((action-id (car entry)))
+              (when (memq action-id ids)
+                (error 'tray-set-menu!
+                       "duplicate tray menu action id: ~a"
+                       action-id))
+              (loop (cdr entries) (cons action-id ids)))]
+           [else
+            (error 'tray-set-menu!
+                   "expected menu entries of the form (list symbol label), #f, or 'separator; got: ~e"
+                   entry)]))])))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Create the portable timer that hides a frame after minimization.
+; pre    : frame implements top-level-window<%> and owns a live eventspace.
+; post   : A timer runs in the frame eventspace and hides the frame when
+;          is-iconized? changes from #f to #t.
+; result : The timer% object; callers stop it when the tray is closed.
+; internals:
+;          Racket GUI has no portable minimize callback. Polling is therefore
+;          intentionally implemented here instead of in a native backend, so
+;          Windows, Linux and macOS have identical hide-on-minimize behavior.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (make-minimize-timer frame)
+  (let ((was-iconized? #f)
+        (minimize-timer #f))
+    (parameterize ([current-eventspace (send frame get-eventspace)])
+      (set! minimize-timer
+            (new timer%
+                 [interval 100]
+                 [notify-callback
+                  (λ ()
+                    (with-handlers ([exn:fail?
+                                     (λ (_exn)
+                                       (send minimize-timer stop))])
+                      (let ((iconized? (send frame is-iconized?)))
+                        (when (and iconized?
+                                   (not was-iconized?))
+                          (send frame show #f))
+                        (set! was-iconized? iconized?))))])))
+    minimize-timer))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Check that a value is an open public racket-tray value.
+; pre    : who names the calling public procedure and value is any value.
+; post   : No state is changed.
+; result : void for a valid tray; raises an argument/state exception otherwise.
+; internals:
+;          A closed tray has its platform-tray field set to #f after backend
+;          cleanup, which also prevents native procedures from being called
+;          twice on the same resources.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (check-open-tray who value)
+  (unless (tray? value)
+    (raise-argument-error who "tray?" value))
+  (unless (tray-platform-tray value)
+    (error who "tray icon is already closed")))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Provided functions
@@ -48,64 +199,95 @@
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ; goal   : Create a tray icon using the backend for the current platform.
-; pre    : frame, icon-file, on-click-cb and hide-on-minimize? satisfy the
+; pre    : frame implements top-level-window<%>, icon-file is accepted by the
-;          requirements documented for mk-tray.
+;          platform backend, action-spec is (list callback default-action),
-; post   : On a supported platform a tray icon is created; otherwise an
+;          callback accepts one symbol, and hide-on-minimize? is boolean.
-;          unsupported-platform exception is raised.
+; post   : A native tray icon exists and, when requested, a portable minimize
-; result : The platform tray value accepted by the other public procedures.
+;          timer watches frame. Partial creation is cleaned up on failure.
+; result : A public tray value accepted by the other provided procedures.
 ; internals:
-;          This module is a small platform-neutral dispatcher. Windows code is
+;          The backend receives the callback and default action separately.
-;          loaded dynamically only on Windows so requiring racket-tray remains
+;          Hide-on-minimize is deliberately implemented in this module and is
-;          possible on other operating systems.
+;          therefore independent of Win32, GTK/AppIndicator, or AppKit.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (define (mk-tray frame
                  icon-file
-                 on-click-cb
+                 action-spec
                  #:hide-on-minimize? [hide-on-minimize? #f])
-  (if platform-mk-tray
+  (unless (is-a? frame top-level-window<%>)
-      (platform-mk-tray frame
+    (raise-argument-error 'mk-tray "(is-a?/c top-level-window<%>)" frame))
-                        icon-file
+  (unless (boolean? hide-on-minimize?)
-                        on-click-cb
+    (raise-argument-error 'mk-tray "boolean?" hide-on-minimize?))
-                        #:hide-on-minimize? hide-on-minimize?)
+  (unless platform-mk-tray
-      (unsupported 'mk-tray)))
+    (unsupported 'mk-tray))
+  (let-values (((callback default-action)
+                (action-spec->values action-spec)))
+    (let ((platform-tray
+           (platform-mk-tray frame icon-file callback default-action)))
+      (with-handlers ([exn?
+                       (λ (exn)
+                         (platform-tray-close platform-tray)
+                         (raise exn))])
+        (let ((minimize-timer
+               (if hide-on-minimize?
+                   (make-minimize-timer frame)
+                   #f)))
+          (tray platform-tray default-action minimize-timer))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-; goal   : Close a tray icon through the active platform backend.
+; goal   : Close a tray icon and all platform-independent support around it.
-; pre    : tray is a value previously returned by mk-tray.
+; pre    : value is a tray previously returned by mk-tray; repeated closing is
-; post   : Platform tray resources are released on supported systems.
+;          allowed.
-; result : void on success; raises when the platform is unsupported.
+; post   : The minimize timer is stopped, native resources are released once,
+;          and the public tray is marked closed.
+; result : void.
 ; internals:
-;          All resource ownership and idempotence rules are implemented by the
+;          Cleanup of native resources remains the responsibility of the
-;          platform backend.
+;          backend; this procedure only coordinates the portable wrapper.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(define (tray-close tray)
+(define (tray-close value)
-  (if platform-tray-close
+  (unless (tray? value)
-      (platform-tray-close tray)
+    (raise-argument-error 'tray-close "tray?" value))
-      (unsupported 'tray-close)))
+  (when (tray-minimize-timer value)
+    (send (tray-minimize-timer value) stop)
+    (set-tray-minimize-timer! value #f))
+  (when (tray-platform-tray value)
+    (platform-tray-close (tray-platform-tray value))
+    (set-tray-platform-tray! value #f))
+  (void))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ; goal   : Replace the image of an existing tray icon.
-; pre    : tray is open and icon-file names a format supported by the backend.
+; pre    : value is open and icon-file is accepted by the active backend.
-; post   : The active tray image is replaced when the backend succeeds.
+; post   : The active native tray image is replaced when the backend succeeds.
-; result : The backend result; the Windows implementation returns void.
+; result : void.
 ; internals:
-;          The public facade performs no image conversion itself.
+;          Image conversion and native resource ownership remain backend
+;          responsibilities because the accepted native image form differs by
+;          operating system.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(define (tray-set-icon! tray icon-file)
+(define (tray-set-icon! value icon-file)
-  (if platform-tray-set-icon!
+  (check-open-tray 'tray-set-icon! value)
-      (platform-tray-set-icon! tray icon-file)
+  (platform-tray-set-icon! (tray-platform-tray value) icon-file)
-      (unsupported 'tray-set-icon!)))
+  (void))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-; goal   : Set or remove the context menu of an existing tray icon.
+; goal   : Set the action menu of an existing tray icon.
-; pre    : tray is open and menu is accepted by the active backend.
+; pre    : value is open and menu-spec is a list of (list symbol label) entries
-; post   : The tray uses the supplied menu specification on success.
+;          and separator markers; it contains the tray's default action id.
-; result : void on Windows; raises when the platform is unsupported.
+; post   : The active backend displays a menu whose selections invoke the
+;          callback supplied to mk-tray with the selected action symbol.
+; result : void.
 ; internals:
-;          Menu normalization belongs to the platform implementation because
+;          Validation is performed once here so every backend receives the same
-;          native event integration is platform-specific.
+;          small, platform-independent menu representation.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(define (tray-set-menu! tray menu)
+(define (tray-set-menu! value menu-spec)
-  (if platform-tray-set-menu!
+  (check-open-tray 'tray-set-menu! value)
-      (platform-tray-set-menu! tray menu)
+  (let ((ids (menu-action-ids menu-spec)))
-      (unsupported 'tray-set-menu!)))
+    (unless (memq (tray-default-action value) ids)
+      (error 'tray-set-menu!
+             "menu does not contain the default action id: ~a"
+             (tray-default-action value)))
+    (platform-tray-set-menu! (tray-platform-tray value) menu-spec))
+  (void))

private/linux.rkt

@@ -0,0 +1,563 @@
+#lang racket/base
+
+(require ffi/unsafe
+         ffi/unsafe/os-async-channel
+         racket/class
+         racket/gui/base
+         racket/match)
+
+(provide mk-tray
+         tray-close
+         tray-set-icon!
+         tray-set-menu!)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Native libraries and constants
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define APP_INDICATOR_CATEGORY_APPLICATION_STATUS 0)
+(define APP_INDICATOR_STATUS_PASSIVE 0)
+(define APP_INDICATOR_STATUS_ACTIVE 1)
+
+;; Debian/Ubuntu install libayatana-appindicator3.so.1. The compatibility
+;; libappindicator3.so.1 name is tried as a fallback because some distributions
+;; and older installations expose that SONAME instead.
+(define appindicator-lib
+  (or (ffi-lib "libayatana-appindicator3" '("1" #f)
+               #:fail (λ () #f))
+      (ffi-lib "libappindicator3" '("1" #f)
+               #:fail (λ () #f))))
+
+(define gtk-lib
+  (ffi-lib "libgtk-3" '("0" #f)
+           #:fail (λ () #f)))
+
+(define gobject-lib
+  (ffi-lib "libgobject-2.0" '("0" #f)
+           #:fail (λ () #f)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Resolve a native function without making module loading fail.
+; pre    : lib is an ffi-lib value or #f, name is a foreign symbol name, and
+;          type is the FFI type of that function.
+; post   : No native state is changed.
+; result : The foreign procedure when available, otherwise #f.
+; internals:
+;          Linux native dependencies are intentionally checked lazily so the
+;          racket-tray package can still be installed, compiled and required
+;          on build hosts that do not have Ayatana AppIndicator installed.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (ffi-procedure lib name type)
+  (if lib
+      (get-ffi-obj name lib type (λ () #f))
+      #f))
+
+;; AppIndicator API. These functions are available in the 0.5.x GTK3 library
+;; used by Debian/Fedora as well as the newer 0.6.x line.
+(define app_indicator_get_type
+  (ffi-procedure appindicator-lib
+                 "app_indicator_get_type"
+                 (_fun -> _ulong)))
+
+(define app_indicator_new
+  (ffi-procedure appindicator-lib
+                 "app_indicator_new"
+                 (_fun _string/utf-8 _string/utf-8 _int -> _pointer)))
+
+(define app_indicator_set_status
+  (ffi-procedure appindicator-lib
+                 "app_indicator_set_status"
+                 (_fun _pointer _int -> _void)))
+
+(define app_indicator_set_menu
+  (ffi-procedure appindicator-lib
+                 "app_indicator_set_menu"
+                 (_fun _pointer _pointer -> _void)))
+
+(define app_indicator_set_icon_full
+  (ffi-procedure appindicator-lib
+                 "app_indicator_set_icon_full"
+                 (_fun _pointer _string/utf-8 _string/utf-8 -> _void)))
+
+(define app_indicator_set_title
+  (ffi-procedure appindicator-lib
+                 "app_indicator_set_title"
+                 (_fun _pointer _string/utf-8 -> _void)))
+
+;; GTK3 menu construction.
+(define gtk_menu_new
+  (ffi-procedure gtk-lib "gtk_menu_new" (_fun -> _pointer)))
+
+(define gtk_menu_item_new_with_label
+  (ffi-procedure gtk-lib
+                 "gtk_menu_item_new_with_label"
+                 (_fun _string/utf-8 -> _pointer)))
+
+(define gtk_separator_menu_item_new
+  (ffi-procedure gtk-lib
+                 "gtk_separator_menu_item_new"
+                 (_fun -> _pointer)))
+
+(define gtk_menu_shell_append
+  (ffi-procedure gtk-lib
+                 "gtk_menu_shell_append"
+                 (_fun _pointer _pointer -> _void)))
+
+(define gtk_widget_show_all
+  (ffi-procedure gtk-lib
+                 "gtk_widget_show_all"
+                 (_fun _pointer -> _void)))
+
+;; GObject signal/ref-count functions. Two bindings to g_signal_connect_data
+;; are used because menu activation and AppIndicator activation have different
+;; callback signatures.
+(define _MENU-ACTIVATE-CALLBACK
+  (_fun _pointer _pointer -> _void))
+
+(define _INDICATOR-ACTIVATE-CALLBACK
+  (_fun _pointer _int _int _pointer -> _void))
+
+(define g_signal_connect_menu
+  (ffi-procedure gobject-lib
+                 "g_signal_connect_data"
+                 (_fun _pointer
+                       _string/utf-8
+                       _MENU-ACTIVATE-CALLBACK
+                       _pointer
+                       _pointer
+                       _uint32
+                       -> _ulong)))
+
+(define g_signal_connect_indicator
+  (ffi-procedure gobject-lib
+                 "g_signal_connect_data"
+                 (_fun _pointer
+                       _string/utf-8
+                       _INDICATOR-ACTIVATE-CALLBACK
+                       _pointer
+                       _pointer
+                       _uint32
+                       -> _ulong)))
+
+(define g_signal_lookup
+  (ffi-procedure gobject-lib
+                 "g_signal_lookup"
+                 (_fun _string/utf-8 _ulong -> _uint32)))
+
+(define g_object_unref
+  (ffi-procedure gobject-lib
+                 "g_object_unref"
+                 (_fun _pointer -> _void)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Internal state
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; Native GTK/AppIndicator objects are owned by this backend. callback and the
+;; callback procedures kept in menu-callbacks/activate-callback must stay
+;; reachable while C retains their generated function pointers.
+(struct tray (frame
+              indicator
+              callback
+              default-action
+              eventspace
+              event-channel
+              event-thread
+              menu
+              menu-callbacks
+              activate-callback
+              closed?)
+  #:mutable)
+
+(define next-indicator-id 1)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Supporting functions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Raise a clear installation error when Linux native libraries are
+;          unavailable.
+; pre    : Called before a tray operation that needs AppIndicator/GTK3.
+; post   : No native state is changed.
+; result : void when all required functions are available; otherwise raises an
+;          exception with distribution-specific runtime package suggestions.
+; internals:
+;          The runtime package, not a -dev package, is sufficient for Racket
+;          FFI because racket-tray loads the installed shared object directly.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (ensure-linux-libraries)
+  (unless (and appindicator-lib
+               gtk-lib
+               gobject-lib
+               app_indicator_get_type
+               app_indicator_new
+               app_indicator_set_status
+               app_indicator_set_menu
+               app_indicator_set_icon_full
+               gtk_menu_new
+               gtk_menu_item_new_with_label
+               gtk_separator_menu_item_new
+               gtk_menu_shell_append
+               gtk_widget_show_all
+               g_signal_connect_menu
+               g_signal_lookup
+               g_object_unref)
+    (error
+     'racket-tray
+     (string-append
+      "Linux tray support requires the Ayatana AppIndicator GTK3 runtime library.\n"
+      "Install it and start the program again.\n\n"
+      "Debian/Ubuntu:\n"
+      "  sudo apt install libayatana-appindicator3-1\n\n"
+      "Fedora:\n"
+      "  sudo dnf install libayatana-appindicator-gtk3\n\n"
+      "Arch Linux:\n"
+      "  sudo pacman -S libayatana-appindicator"))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Allocate a stable process-local AppIndicator identifier.
+; pre    : next-indicator-id contains the next positive identifier.
+; post   : next-indicator-id is incremented by one.
+; result : A string suitable as the AppIndicator id.
+; internals:
+;          AppIndicator ids should be unique within an application. A simple
+;          monotonic process-local suffix is sufficient for racket-tray.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (allocate-indicator-id)
+  (let ((id next-indicator-id))
+    (set! next-indicator-id (add1 next-indicator-id))
+    (format "racket-tray-~a" id)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Run thunk synchronously in the handler thread of eventspace.
+; pre    : eventspace is live and thunk accepts no arguments.
+; post   : thunk has completed, or its exception has been re-raised in the
+;          calling thread.
+; result : The value returned by thunk.
+; internals:
+;          GTK objects must be created and changed from the Racket GUI thread
+;          that owns the existing GTK application/event loop.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (call-in-eventspace eventspace thunk)
+  (let ((handler-thread (eventspace-handler-thread eventspace)))
+    (unless handler-thread
+      (error 'racket-tray "the frame's eventspace has been shut down"))
+    (if (eq? (current-thread) handler-thread)
+        (parameterize ([current-eventspace eventspace])
+          (thunk))
+        (let ((result-channel (make-channel)))
+          (parameterize ([current-eventspace eventspace])
+            (queue-callback
+             (λ ()
+               (with-handlers ([exn?
+                                (λ (exn)
+                                  (channel-put result-channel
+                                               (cons 'error exn)))])
+                 (channel-put result-channel (cons 'ok (thunk)))))))
+          (match (channel-get result-channel)
+            [(cons 'ok value) value]
+            [(cons 'error exn) (raise exn)])))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Queue user work in the frame eventspace.
+; pre    : t is a tray and thunk accepts no arguments.
+; post   : thunk is queued when the eventspace is live and the tray stays open.
+; result : Unspecified.
+; internals:
+;          FFI signal callbacks do not execute application code directly. This
+;          also keeps Linux callback behavior aligned with the Windows backend.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (queue-eventspace-callback t thunk)
+  (let ((eventspace (tray-eventspace t)))
+    (unless (eventspace-shutdown? eventspace)
+      (with-handlers ([exn:fail? (λ (_exn) (void))])
+        (parameterize ([current-eventspace eventspace])
+          (queue-callback
+           (λ ()
+             (unless (tray-closed? t)
+               (thunk)))))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Start the ordinary Racket thread that dispatches native GTK events.
+; pre    : t has an event channel and no event thread.
+; post   : tray-event-thread is set and exits after receiving 'close.
+; result : Unspecified; t is modified in place.
+; internals:
+;          GTK/GObject callbacks only put immutable action values into the OS
+;          async channel. User callbacks run later as ordinary Racket GUI work.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (start-event-thread! t)
+  (let ((event-thread
+         (thread
+          (λ ()
+            (let loop ()
+              (match (sync (tray-event-channel t))
+                ['close
+                 (void)]
+                [(vector 'action action-id)
+                 (queue-eventspace-callback
+                  t
+                  (λ ()
+                    ((tray-callback t) action-id)))
+                 (loop)]
+                [_
+                 (loop)]))))))
+    (set-tray-event-thread! t event-thread)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Return an absolute icon filename accepted by AppIndicator.
+; pre    : icon-file is a path-string naming an existing file.
+; post   : No state is changed.
+; result : An absolute native path string.
+; internals:
+;          AppIndicator treats an icon name beginning with '/' as an absolute
+;          icon path and exports that path through StatusNotifierItem.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (icon-path icon-file)
+  (unless (path-string? icon-file)
+    (raise-argument-error 'racket-tray "path-string?" icon-file))
+  (unless (file-exists? icon-file)
+    (error 'racket-tray "icon file does not exist: ~a" icon-file))
+  (path->string (path->complete-path icon-file)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Build a native GtkMenu for the common menu specification.
+; pre    : t is open and menu-spec has already been validated by main.rkt.
+; post   : A GtkMenu and menu-item signal callbacks have been created.
+; result : Two values: the GtkMenu pointer and a list of Racket callbacks that
+;          must remain reachable while that menu exists.
+; internals:
+;          Each GtkMenuItem receives an "activate" handler that only forwards
+;          the corresponding symbol to the tray's OS async channel.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (make-menu t menu-spec)
+  (let ((menu (gtk_menu_new))
+        (callbacks '()))
+    (for ((entry (in-list menu-spec)))
+      (cond
+        [(or (eq? entry 'separator)
+             (eq? entry #f))
+         (gtk_menu_shell_append menu (gtk_separator_menu_item_new))]
+        [else
+         (let* ((action-id (car entry))
+                (label (cadr entry))
+                (item (gtk_menu_item_new_with_label label))
+                (callback
+                 (λ (_item _data)
+                   (os-async-channel-put
+                    (tray-event-channel t)
+                    (vector 'action action-id)))))
+           (g_signal_connect_menu item "activate" callback #f #f 0)
+           (set! callbacks (cons callback callbacks))
+           (gtk_menu_shell_append menu item))]))
+    (gtk_widget_show_all menu)
+    (values menu callbacks)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Connect primary activation when the installed AppIndicator supports
+;          its 0.6+ "activate" signal.
+; pre    : t has a live indicator and event channel.
+; post   : On AppIndicator 0.6+ a signal callback is installed and retained;
+;          on 0.5.x no callback is installed.
+; result : #t when primary activation was connected, otherwise #f.
+; internals:
+;          AppIndicator 0.6.0 added StatusNotifierItem Activate handling. Older
+;          0.5.x libraries intentionally fall back to opening the menu, which
+;          is why the common default action remains a mandatory menu item.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (connect-primary-activation! t)
+  (if (and g_signal_connect_indicator
+           (> (g_signal_lookup "activate" (app_indicator_get_type)) 0))
+      (let ((callback
+             (λ (_indicator _x _y _data)
+               (os-async-channel-put
+                (tray-event-channel t)
+                (vector 'action (tray-default-action t))))))
+        (g_signal_connect_indicator
+         (tray-indicator t)
+         "activate"
+         callback
+         #f
+         #f
+         0)
+        (set-tray-activate-callback! t callback)
+        #t)
+      #f))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Check that t is an open Linux tray value.
+; pre    : who names the calling backend procedure and t is any value.
+; post   : No state is changed.
+; result : void when valid; otherwise raises an argument/state exception.
+; internals:
+;          Native AppIndicator/GTK resources may only be mutated while the
+;          backend tray remains open.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (check-open-tray who t)
+  (unless (tray? t)
+    (raise-argument-error who "tray?" t))
+  (when (tray-closed? t)
+    (error who "tray icon is already closed")))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Provided functions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Create a Linux tray icon using Ayatana AppIndicator and GTK3.
+; pre    : frame implements top-level-window<%>, icon-file exists, callback
+;          accepts one symbol, default-action is a symbol, and the required
+;          Linux runtime libraries are installed.
+; post   : An active AppIndicator with an empty GtkMenu exists and an event
+;          dispatcher thread is running.
+; result : A mutable Linux tray object.
+; internals:
+;          Racket GUI already owns the GTK event loop, so this backend does not
+;          call gtk_init or gtk_main. AppIndicator 0.6+ primary activation is
+;          connected when available; 0.5.x retains its normal menu-on-click
+;          behavior.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (mk-tray frame icon-file callback default-action)
+  (ensure-linux-libraries)
+  (unless (is-a? frame top-level-window<%>)
+    (raise-argument-error 'mk-tray "(is-a?/c top-level-window<%>)" frame))
+  (unless (and (procedure? callback)
+               (procedure-arity-includes? callback 1))
+    (raise-argument-error 'mk-tray "(procedure-arity-includes/c 1)" callback))
+  (unless (symbol? default-action)
+    (raise-argument-error 'mk-tray "symbol?" default-action))
+  (let ((eventspace (send frame get-eventspace))
+        (filename (icon-path icon-file)))
+    (call-in-eventspace
+     eventspace
+     (λ ()
+       (let ((indicator
+              (app_indicator_new
+               (allocate-indicator-id)
+               filename
+               APP_INDICATOR_CATEGORY_APPLICATION_STATUS)))
+         (unless indicator
+           (error 'mk-tray "app_indicator_new failed"))
+         (let ((menu (gtk_menu_new)))
+           (unless menu
+             (g_object_unref indicator)
+             (error 'mk-tray "gtk_menu_new failed"))
+           (let ((menu-installed? #f)
+                 (t (tray frame
+                          indicator
+                          callback
+                          default-action
+                          eventspace
+                          (make-os-async-channel)
+                          #f
+                          menu
+                          '()
+                          #f
+                          #f)))
+             (with-handlers
+                 ([exn?
+                   (λ (exn)
+                     (when (tray-event-thread t)
+                       (os-async-channel-put (tray-event-channel t) 'close))
+                     (app_indicator_set_status
+                      indicator
+                      APP_INDICATOR_STATUS_PASSIVE)
+                     (g_object_unref indicator)
+                     (unless menu-installed?
+                       (g_object_unref menu))
+                     (raise exn))])
+               (app_indicator_set_menu indicator menu)
+               (set! menu-installed? #t)
+               (gtk_widget_show_all menu)
+               (app_indicator_set_icon_full
+                indicator
+                filename
+                "Racket tray icon")
+               (when app_indicator_set_title
+                 (let ((frame-label (send frame get-label)))
+                   (when (string? frame-label)
+                     (app_indicator_set_title indicator frame-label))))
+               (connect-primary-activation! t)
+               (start-event-thread! t)
+               (app_indicator_set_status indicator APP_INDICATOR_STATUS_ACTIVE)
+               t))))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Hide and release a Linux AppIndicator and its GTK menu.
+; pre    : t is a Linux tray object; repeated closing is allowed.
+; post   : The indicator is passive and unreferenced, its GtkMenu reference is
+;          released by AppIndicator, callbacks are released, and the event
+;          thread is told to stop.
+; result : void.
+; internals:
+;          AppIndicator exposes no dedicated remove function. PASSIVE is the
+;          supported state for removing the indicator from the panel before
+;          the final GObject reference is released.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (tray-close t)
+  (unless (tray? t)
+    (raise-argument-error 'tray-close "tray?" t))
+  (unless (tray-closed? t)
+    (call-in-eventspace
+     (tray-eventspace t)
+     (λ ()
+       (unless (tray-closed? t)
+         (app_indicator_set_status
+          (tray-indicator t)
+          APP_INDICATOR_STATUS_PASSIVE)
+         ;; AppIndicator owns the GtkMenu reference installed through
+         ;; app_indicator_set_menu and releases it during object disposal.
+         (g_object_unref (tray-indicator t))
+         (set-tray-menu! t #f)
+         (set-tray-menu-callbacks! t '())
+         (set-tray-activate-callback! t #f)
+         (set-tray-closed?! t #t)
+         (os-async-channel-put (tray-event-channel t) 'close)))))
+  (void))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Replace the icon exported by an open Linux AppIndicator.
+; pre    : t is open and icon-file names an existing image file.
+; post   : AppIndicator exports the new absolute icon path.
+; result : void.
+; internals:
+;          Ayatana AppIndicator accepts absolute filenames as icon names, so no
+;          Racket-side image conversion is needed on Linux.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (tray-set-icon! t icon-file)
+  (check-open-tray 'tray-set-icon! t)
+  (let ((filename (icon-path icon-file)))
+    (call-in-eventspace
+     (tray-eventspace t)
+     (λ ()
+       (app_indicator_set_icon_full
+        (tray-indicator t)
+        filename
+        "Racket tray icon"))))
+  (void))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Replace the menu exported by an open Linux AppIndicator.
+; pre    : t is open and menu-spec has been validated by the public module.
+; post   : AppIndicator exports a newly built GtkMenu; its previous GtkMenu
+;          reference and the corresponding Racket callbacks are released.
+; result : void.
+; internals:
+;          GTK menu item activation is converted to the same symbolic action
+;          callback used by Windows and macOS.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (tray-set-menu! t menu-spec)
+  (check-open-tray 'tray-set-menu! t)
+  (call-in-eventspace
+   (tray-eventspace t)
+   (λ ()
+     (let-values (((menu callbacks)
+                   (make-menu t menu-spec)))
+       ;; app_indicator_set_menu refs/sinks the new GtkMenu and unrefs the
+       ;; previous GtkMenu itself. The old Racket callbacks can be released
+       ;; immediately after the native call has returned.
+       (app_indicator_set_menu (tray-indicator t) menu)
+       (set-tray-menu! t menu)
+       (set-tray-menu-callbacks! t callbacks))))
+  (void))

private/macos.rkt

@@ -0,0 +1,377 @@
+#lang racket/base
+
+(require ffi/unsafe
+         ffi/unsafe/objc
+         ffi/unsafe/nsstring
+         racket/class
+         racket/gui/base
+         racket/match)
+
+(provide mk-tray
+         tray-close
+         tray-set-icon!
+         tray-set-menu!)
+
+;; AppKit and Foundation are standard macOS frameworks. Load them explicitly
+;; before importing Objective-C classes so this backend does not depend on
+;; another Racket library having loaded them first.
+(ffi-lib "/System/Library/Frameworks/Foundation.framework/Foundation")
+(ffi-lib "/System/Library/Frameworks/AppKit.framework/AppKit")
+
+(import-class NSObject
+              NSImage
+              NSMenu
+              NSMenuItem
+              NSStatusBar)
+
+;; NSVariableStatusItemLength is the native sentinel for a status item whose
+;; width follows the image or title supplied to its button.
+(define NSVariableStatusItemLength -1.0)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Internal state / functions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; NSMenuItem does not own its target. RacketTrayMenuTarget instances are
+;; therefore kept in tray-menu-targets for as long as the corresponding menu
+;; exists. Each target owns only Racket values in Objective-C ivars.
+(struct tray (frame
+              status-bar
+              status-item
+              button
+              callback
+              default-action
+              eventspace
+              menu
+              menu-targets
+              closed?)
+  #:mutable)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Queue one application tray action in a Racket GUI eventspace.
+; pre    : eventspace is live, callback accepts one argument and action-id is
+;          the symbol associated with a menu item.
+; post   : callback is queued in eventspace unless that eventspace has shut
+;          down before the queue operation.
+; result : Unspecified.
+; internals:
+;          AppKit invokes Objective-C target/action methods from its native
+;          event processing. User code is kept outside that native callback by
+;          forwarding the action to Racket's normal GUI callback queue.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (queue-action eventspace callback action-id)
+  (unless (eventspace-shutdown? eventspace)
+    (with-handlers ([exn:fail? (λ (_exn) (void))])
+      (parameterize ([current-eventspace eventspace])
+        (queue-callback
+         (λ ()
+           (callback action-id)))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Receive native NSMenuItem target/action messages for tray actions.
+; pre    : callback, action-id and eventspace ivars are set before the target
+;          is assigned to an NSMenuItem.
+; post   : trayAction: forwards the selected symbolic action to queue-action.
+; result : Objective-C class RacketTrayMenuTarget.
+; internals:
+;          define-objc-class stores the three fields as Racket-managed ivars.
+;          objc_lookUpClass reuses a class left by an earlier run in the same
+;          process, which avoids redefining an Objective-C runtime class in
+;          DrRacket. Instances are retained by the tray backend because
+;          NSMenuItem does not provide the ownership needed to keep a Racket
+;          callback target alive by itself.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define RacketTrayMenuTarget
+  (or (objc_lookUpClass "RacketTrayMenuTarget")
+      (let ()
+        (define-objc-class RacketTrayMenuTarget NSObject
+          [callback action-id eventspace]
+          (- _void (trayAction: [_id _sender])
+            (when (and callback action-id eventspace)
+              (queue-action eventspace callback action-id))))
+        RacketTrayMenuTarget)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Run thunk synchronously in the handler thread of eventspace.
+; pre    : eventspace is live and thunk accepts no arguments.
+; post   : thunk has completed, or its exception has been re-raised in the
+;          calling thread.
+; result : The value returned by thunk.
+; internals:
+;          AppKit objects that belong to a Racket GUI application are created
+;          and modified on the GUI eventspace thread. When the caller is
+;          already that thread, no callback round trip is needed.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (call-in-eventspace eventspace thunk)
+  (let ((handler-thread (eventspace-handler-thread eventspace)))
+    (unless handler-thread
+      (error 'racket-tray "the frame's eventspace has been shut down"))
+    (if (eq? (current-thread) handler-thread)
+        (parameterize ([current-eventspace eventspace])
+          (thunk))
+        (let ((result-channel (make-channel)))
+          (parameterize ([current-eventspace eventspace])
+            (queue-callback
+             (λ ()
+               (with-handlers ([exn?
+                                (λ (exn)
+                                  (channel-put result-channel
+                                               (cons 'error exn)))])
+                 (channel-put result-channel (cons 'ok (thunk)))))))
+          (match (channel-get result-channel)
+            [(cons 'ok value) value]
+            [(cons 'error exn) (raise exn)])))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Validate an icon filename and return its absolute native path.
+; pre    : icon-file is any Racket value.
+; post   : No state is changed.
+; result : An absolute path string when icon-file names an existing file;
+;          otherwise raises a precise argument or file error.
+; internals:
+;          NSImage loads normal macOS image formats such as PNG directly from
+;          a filename, so the backend does not need an image converter.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (icon-path icon-file)
+  (unless (path-string? icon-file)
+    (raise-argument-error 'racket-tray "path-string?" icon-file))
+  (unless (file-exists? icon-file)
+    (error 'racket-tray "icon file does not exist: ~a" icon-file))
+  (path->string (path->complete-path icon-file)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Load icon-file as an NSImage owned by the caller.
+; pre    : icon-file names an existing image that AppKit can decode.
+; post   : One retained NSImage exists when loading succeeds.
+; result : The retained NSImage; raises an exception if AppKit cannot load it.
+; internals:
+;          alloc/initWithContentsOfFile: gives this procedure ownership. The
+;          caller releases that ownership after setImage:, because the status
+;          bar button retains the image it displays.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (load-image icon-file)
+  (let* ((path (icon-path icon-file))
+         (image
+          (tell (tell NSImage alloc)
+                initWithContentsOfFile: #:type _NSString path)))
+    (unless image
+      (error 'racket-tray "could not load tray icon: ~a" icon-file))
+    image))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Release Objective-C menu target objects owned by racket-tray.
+; pre    : targets is a list of retained RacketTrayMenuTarget instances.
+; post   : Each target has received release exactly once.
+; result : void.
+; internals:
+;          NSMenuItem's target reference is not used as an ownership boundary;
+;          racket-tray explicitly retains targets by creating them with new
+;          and explicitly releases them after detaching the menu.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (release-menu-targets targets)
+  (for ((target (in-list targets)))
+    (tellv target release))
+  (void))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Build an NSMenu from the common racket-tray menu specification.
+; pre    : t is open and menu-spec has been validated by main.rkt.
+; post   : A retained NSMenu and retained target object for every actionable
+;          item have been created.
+; result : Two values: the retained NSMenu and its retained target list.
+; internals:
+;          Each item uses the same trayAction: selector. Its target stores the
+;          corresponding action symbol, so all choices reach the one callback
+;          supplied to mk-tray. Separators need no target object.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (make-menu t menu-spec)
+  (let ((menu (tell NSMenu new))
+        (targets '()))
+    (tellv menu setAutoenablesItems: #:type _BOOL #f)
+    (for ((entry (in-list menu-spec)))
+      (cond
+        [(or (eq? entry 'separator)
+             (eq? entry #f))
+         (tellv menu addItem: (tell NSMenuItem separatorItem))]
+        [else
+         (let* ((action-id (car entry))
+                (label (cadr entry))
+                (target (tell RacketTrayMenuTarget new))
+                (item
+                 (tell (tell NSMenuItem alloc)
+                       initWithTitle: #:type _NSString label
+                       action: #:type _SEL (selector trayAction:)
+                       keyEquivalent: #:type _NSString "")))
+           (set-ivar! target callback (tray-callback t))
+           (set-ivar! target action-id action-id)
+           (set-ivar! target eventspace (tray-eventspace t))
+           (tellv item setTarget: target)
+           (tellv menu addItem: item)
+           (tellv item release)
+           (set! targets (cons target targets)))]))
+    (values menu (reverse targets))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Validate that t is an open macOS tray object.
+; pre    : who names the calling procedure and t is any value.
+; post   : No state is changed.
+; result : void when valid; otherwise raises an argument/state exception.
+; internals:
+;          Native Objective-C objects must not receive messages after
+;          tray-close has released the status item and menu resources.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (check-open-tray who t)
+  (unless (tray? t)
+    (raise-argument-error who "tray?" t))
+  (when (tray-closed? t)
+    (error who "tray icon is already closed")))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Provided functions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Create a native macOS menu-bar status item for a Racket frame.
+; pre    : frame implements top-level-window<%>, icon-file is readable,
+;          callback accepts one symbol and default-action is a symbol.
+; post   : A retained NSStatusItem exists in the system status bar and shows
+;          icon-file. Its menu is initially empty.
+; result : A mutable tray object for the remaining backend procedures.
+; internals:
+;          macOS status items conventionally open their NSMenu when clicked.
+;          Menu selections invoke callback with their action symbol. The
+;          default-action is retained for the common cross-platform API, but
+;          AppKit does not use it for a status item that has an attached menu.
+;          statusItemWithLength: does not transfer ownership to the status bar,
+;          so racket-tray retains the returned status item until tray-close.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (mk-tray frame icon-file callback default-action)
+  (unless (is-a? frame top-level-window<%>)
+    (raise-argument-error 'mk-tray "(is-a?/c top-level-window<%>)" frame))
+  (unless (and (procedure? callback)
+               (procedure-arity-includes? callback 1))
+    (raise-argument-error 'mk-tray "(procedure-arity-includes/c 1)" callback))
+  (unless (symbol? default-action)
+    (raise-argument-error 'mk-tray "symbol?" default-action))
+  (let ((eventspace (send frame get-eventspace)))
+    (call-in-eventspace
+     eventspace
+     (λ ()
+       (let* ((status-bar (tell NSStatusBar systemStatusBar))
+              (status-item
+               (tell status-bar
+                     statusItemWithLength: #:type _double
+                     NSVariableStatusItemLength))
+              (button (tell status-item button)))
+         (unless (and status-item button)
+           (when status-item
+             (tellv status-bar removeStatusItem: status-item))
+           (error 'mk-tray "could not create a macOS status item"))
+         (tellv status-item retain)
+         (let ((menu #f)
+               (image #f))
+           (with-handlers
+               ([exn?
+                 (λ (exn)
+                   (when image
+                     (tellv image release))
+                   (when menu
+                     (tellv menu release))
+                   (tellv status-bar removeStatusItem: status-item)
+                   (tellv status-item release)
+                   (raise exn))])
+             (set! menu (tell NSMenu new))
+             (set! image (load-image icon-file))
+             (tellv button setImage: image)
+             (tellv image release)
+             (set! image #f)
+             (let ((frame-label (send frame get-label)))
+               (when (string? frame-label)
+                 (tellv button setToolTip: #:type _NSString frame-label)))
+             (tellv status-item setMenu: menu)
+             (tray frame
+                   status-bar
+                   status-item
+                   button
+                   callback
+                   default-action
+                   eventspace
+                   menu
+                   '()
+                   #f))))))))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Remove a macOS status item and release resources owned by it.
+; pre    : t is a tray object; repeated calls are allowed.
+; post   : The status item is removed, its menu and item targets are released,
+;          and t is marked closed.
+; result : void.
+; internals:
+;          The menu is first detached from NSStatusItem so AppKit no longer
+;          references it. Targets are released after the menu is detached, and
+;          the explicit retain from mk-tray is balanced last.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (tray-close t)
+  (unless (tray? t)
+    (raise-argument-error 'tray-close "tray?" t))
+  (unless (tray-closed? t)
+    (call-in-eventspace
+     (tray-eventspace t)
+     (λ ()
+       (unless (tray-closed? t)
+         (tellv (tray-status-item t) setMenu: #f)
+         (tellv (tray-status-bar t) removeStatusItem: (tray-status-item t))
+         (when (tray-menu t)
+           (tellv (tray-menu t) release)
+           (set-tray-menu! t #f))
+         (release-menu-targets (tray-menu-targets t))
+         (set-tray-menu-targets! t '())
+         (tellv (tray-status-item t) release)
+         (set-tray-closed?! t #t)))))
+  (void))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Replace the image shown by an open macOS status item.
+; pre    : t is open and icon-file names an image AppKit can decode.
+; post   : The status bar button displays the new image.
+; result : void.
+; internals:
+;          The temporary retained NSImage is released immediately after
+;          setImage:, leaving normal AppKit ownership with the button.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (tray-set-icon! t icon-file)
+  (check-open-tray 'tray-set-icon! t)
+  (call-in-eventspace
+   (tray-eventspace t)
+   (λ ()
+     (let ((image (load-image icon-file)))
+       (tellv (tray-button t) setImage: image)
+       (tellv image release))))
+  (void))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Replace the menu attached to an open macOS status item.
+; pre    : t is open and menu-spec is the validated common menu format.
+; post   : The status item opens the new NSMenu; resources belonging to the
+;          previous menu have been released.
+; result : void.
+; internals:
+;          The new menu is attached before the old menu and its retained target
+;          objects are released. This prevents AppKit from observing a target
+;          object whose Racket-owned retain has already been balanced.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (tray-set-menu! t menu-spec)
+  (check-open-tray 'tray-set-menu! t)
+  (call-in-eventspace
+   (tray-eventspace t)
+   (λ ()
+     (let-values (((new-menu new-targets)
+                   (make-menu t menu-spec)))
+       (let ((old-menu (tray-menu t))
+             (old-targets (tray-menu-targets t)))
+         (tellv (tray-status-item t) setMenu: new-menu)
+         (set-tray-menu! t new-menu)
+         (set-tray-menu-targets! t new-targets)
+         (when old-menu
+           (tellv old-menu release))
+         (release-menu-targets old-targets)))))
+  (void))

private/windows.rkt

@@ -32,7 +32,6 @@
 (define NOTIFYICON_VERSION_4 4)
 
 ;; Window messages used by the tray integration.
-(define WM_SIZE        #x0005)
 (define WM_CONTEXTMENU #x007B)
 (define WM_NCDESTROY   #x0082)
 (define WM_USER        #x0400)
@@ -40,8 +39,6 @@
 (define NIN_SELECT     (+ WM_USER 0))
 (define NIN_KEYSELECT  (+ WM_USER 1))
 
-(define SIZE_MINIMIZED 1)
-
 (define IMAGE_ICON       1)
 (define LR_LOADFROMFILE  #x00000010)
 (define SM_CXSMICON      49)
@@ -189,8 +186,8 @@
               hwnd
               id
               callback-message
-              on-click
+              callback
-              hide-on-minimize?
+              default-action
               eventspace
               event-channel
               event-thread
@@ -217,11 +214,11 @@
 ;          reserved by Windows for application-private messages.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (define (allocate-tray-id)
-  (define id next-tray-id)
+  (let ((id next-tray-id))
-  (when (> id #xffff)
+    (when (> id #xffff)
-    (error 'mk-tray "too many tray icons have been created in this process"))
+      (error 'mk-tray "too many tray icons have been created in this process"))
-  (set! next-tray-id (add1 next-tray-id))
+    (set! next-tray-id (add1 next-tray-id))
-  id)
+    id))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ; goal   : Convert a Win32 BOOL-style result to a Racket boolean.
@@ -248,23 +245,23 @@
 ;          on the GUI thread that owns the window.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (define (call-in-eventspace eventspace thunk)
-  (define handler-thread (eventspace-handler-thread eventspace))
+  (let ((handler-thread (eventspace-handler-thread eventspace)))
-  (unless handler-thread
+    (unless handler-thread
-    (error 'racket-tray "the frame's eventspace has been shut down"))
+      (error 'racket-tray "the frame's eventspace has been shut down"))
-  (if (eq? (current-thread) handler-thread)
+    (if (eq? (current-thread) handler-thread)
-      (parameterize ([current-eventspace eventspace])
-        (thunk))
-      (let ([result-channel (make-channel)])
         (parameterize ([current-eventspace eventspace])
-          (queue-callback
+          (thunk))
-           (λ ()
+        (let ((result-channel (make-channel)))
-             (with-handlers ([exn?
+          (parameterize ([current-eventspace eventspace])
-                              (λ (exn)
+            (queue-callback
-                                (channel-put result-channel (cons 'error exn)))])
+             (λ ()
-               (channel-put result-channel (cons 'ok (thunk)))))))
+               (with-handlers ([exn?
-        (match (channel-get result-channel)
+                                (λ (exn)
-          [(cons 'ok value) value]
+                                  (channel-put result-channel (cons 'error exn)))])
-          [(cons 'error exn) (raise exn)]))))
+                 (channel-put result-channel (cons 'ok (thunk)))))))
+          (match (channel-get result-channel)
+            [(cons 'ok value) value]
+            [(cons 'error exn) (raise exn)])))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ; goal   : Allocate and initialize a NOTIFYICONDATAW structure.
@@ -278,17 +275,17 @@
 ;          Win32 without containing Racket-managed pointers.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (define (make-notify-data hwnd id callback-message icon)
-  (define data
+  (let ((data
-    (cast (malloc _NOTIFYICONDATAW 'atomic)
+         (cast (malloc _NOTIFYICONDATAW 'atomic)
-          _pointer
+               _pointer
-          _NOTIFYICONDATAW-pointer))
+               _NOTIFYICONDATAW-pointer)))
-  (memset data 0 0 (ctype-sizeof _NOTIFYICONDATAW))
+    (memset data 0 0 (ctype-sizeof _NOTIFYICONDATAW))
-  (set-NOTIFYICONDATAW-cbSize! data (ctype-sizeof _NOTIFYICONDATAW))
+    (set-NOTIFYICONDATAW-cbSize! data (ctype-sizeof _NOTIFYICONDATAW))
-  (set-NOTIFYICONDATAW-hWnd! data hwnd)
+    (set-NOTIFYICONDATAW-hWnd! data hwnd)
-  (set-NOTIFYICONDATAW-uID! data id)
+    (set-NOTIFYICONDATAW-uID! data id)
-  (set-NOTIFYICONDATAW-uCallbackMessage! data callback-message)
+    (set-NOTIFYICONDATAW-uCallbackMessage! data callback-message)
-  (set-NOTIFYICONDATAW-hIcon! data icon)
+    (set-NOTIFYICONDATAW-hIcon! data icon)
-  data)
+    data))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ; goal   : Copy a Racket string into a fixed-size UTF-16 Win32 array.
@@ -302,15 +299,15 @@
 ;          valid zero-terminated Win32 string.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (define (set-wide-array! array text capacity)
-  (define source (cast text _string/utf-16 _pointer))
+  (let ((source (cast text _string/utf-16 _pointer)))
-  (for ([i (in-range capacity)])
+    (for ([i (in-range capacity)])
-    (array-set! array i 0))
+      (array-set! array i 0))
-  (let loop ([i 0])
+    (let loop ((i 0))
-    (when (< i (sub1 capacity))
+      (when (< i (sub1 capacity))
-      (let ([code-unit (ptr-ref source _uint16 i)])
+        (let ((code-unit (ptr-ref source _uint16 i)))
-        (unless (zero? code-unit)
+          (unless (zero? code-unit)
-          (array-set! array i code-unit)
+            (array-set! array i code-unit)
-          (loop (add1 i)))))))
+            (loop (add1 i))))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Icon loading
@@ -326,18 +323,18 @@
 ;          the shell receives an icon already sized for the notification area.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (define (load-ico-icon icon-file)
-  (define width (GetSystemMetrics SM_CXSMICON))
+  (let* ((width (GetSystemMetrics SM_CXSMICON))
-  (define height (GetSystemMetrics SM_CYSMICON))
+         (height (GetSystemMetrics SM_CYSMICON))
-  (define icon
+         (icon
-    (LoadImageW #f
+          (LoadImageW #f
-                (path->string (path->complete-path icon-file))
+                      (path->string (path->complete-path icon-file))
-                IMAGE_ICON
+                      IMAGE_ICON
-                width
+                      width
-                height
+                      height
-                LR_LOADFROMFILE))
+                      LR_LOADFROMFILE)))
-  (unless icon
+    (unless icon
-    (error 'mk-tray "could not load ICO file: ~a" icon-file))
+      (error 'mk-tray "could not load ICO file: ~a" icon-file))
-  icon)
+    icon))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ; goal   : Convert a PNG file with alpha transparency to a native HICON.
@@ -357,125 +354,135 @@
   ;; Racket's drawing library already decodes PNG and preserves its alpha
   ;; channel. Scale it to the same system-small-icon size that is used for
   ;; ICO files, then turn the premultiplied pixels into a native HICON.
-  (define source-bitmap
+  (let* ((source-bitmap (read-bitmap icon-file 'png/alpha #f #t))
-    (read-bitmap icon-file 'png/alpha #f #t))
+         (width (max 1 (GetSystemMetrics SM_CXSMICON)))
-  (unless (send source-bitmap ok?)
+         (height (max 1 (GetSystemMetrics SM_CYSMICON))))
-    (error 'mk-tray "could not load PNG file: ~a" icon-file))
+    (unless (send source-bitmap ok?)
+      (error 'mk-tray "could not load PNG file: ~a" icon-file))
 
-  (define width (max 1 (GetSystemMetrics SM_CXSMICON)))
+    (let* ((source-width (send source-bitmap get-width))
-  (define height (max 1 (GetSystemMetrics SM_CYSMICON)))
+           (source-height (send source-bitmap get-height))
-  (define source-width (send source-bitmap get-width))
+           ;; Keep the aspect ratio and center non-square images in the
-  (define source-height (send source-bitmap get-height))
+           ;; tray-icon area.
+           (scale
+            (min (/ width source-width)
+                 (/ height source-height)))
+           (draw-width
+            (max 1 (inexact->exact (round (* source-width scale)))))
+           (draw-height
+            (max 1 (inexact->exact (round (* source-height scale)))))
+           (draw-x (quotient (- width draw-width) 2))
+           (draw-y (quotient (- height draw-height) 2))
+           (bitmap (make-bitmap width height #t))
+           (dc (new bitmap-dc% [bitmap bitmap])))
+      (send dc draw-bitmap-section-smooth
+            source-bitmap
+            draw-x
+            draw-y
+            draw-width
+            draw-height
+            0
+            0
+            source-width
+            source-height)
+      (send dc set-bitmap #f)
 
-  ;; Keep the aspect ratio and center non-square images in the tray-icon area.
+      (let* ((pixel-count (* width height))
-  (define scale
+             (argb (make-bytes (* pixel-count 4)))
-    (min (/ width source-width)
+             (header
-         (/ height source-height)))
+              (make-BITMAPINFOHEADER
-  (define draw-width (max 1 (inexact->exact (round (* source-width scale)))))
+               (ctype-sizeof _BITMAPINFOHEADER)
-  (define draw-height (max 1 (inexact->exact (round (* source-height scale)))))
+               width
-  (define draw-x (quotient (- width draw-width) 2))
+               (- height) ; negative means top-down, matching Racket's row order
-  (define draw-y (quotient (- height draw-height) 2))
+               1
+               32
+               BI_RGB
+               (* pixel-count 4)
+               0
+               0
+               0
+               0))
+             (bits-out (malloc _pointer 'atomic)))
+        (send bitmap get-argb-pixels 0 0 width height argb #f #t)
+        (ptr-set! bits-out _pointer #f)
 
-  (define bitmap (make-bitmap width height #t))
+        (let ((color-bitmap
-  (define dc (new bitmap-dc% [bitmap bitmap]))
+               (CreateDIBSection #f header DIB_RGB_COLORS bits-out #f 0))
-  (send dc draw-bitmap-section-smooth
+              (mask-bitmap #f))
-        source-bitmap
+          (unless color-bitmap
-        draw-x
+            (error 'mk-tray
-        draw-y
+                   "CreateDIBSection failed while loading PNG icon: ~a"
-        draw-width
+                   icon-file))
-        draw-height
-        0
-        0
-        source-width
-        source-height)
-  (send dc set-bitmap #f)
 
-  (define pixel-count (* width height))
+          ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-  (define argb (make-bytes (* pixel-count 4)))
+          ; goal   : Release temporary GDI bitmaps created during PNG conversion.
-  (send bitmap get-argb-pixels 0 0 width height argb #f #t)
+          ; pre    : color-bitmap and mask-bitmap are HBITMAP values or #f.
+          ; post   : Every non-#f bitmap is deleted and its local variable is set
+          ;          to #f, making repeated cleanup safe.
+          ; result : Unspecified.
+          ; internals:
+          ;          This local procedure is used on both the normal and
+          ;          exceptional CreateIconIndirect paths so temporary GDI
+          ;          objects never leak.
+          ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+          (letrec ((cleanup-bitmaps!
+                    (λ ()
+                      (when mask-bitmap
+                        (DeleteObject mask-bitmap)
+                        (set! mask-bitmap #f))
+                      (when color-bitmap
+                        (DeleteObject color-bitmap)
+                        (set! color-bitmap #f)))))
+            (with-handlers ([exn?
+                             (λ (exn)
+                               (cleanup-bitmaps!)
+                               (raise exn))])
+              (let ((dib-bits (ptr-ref bits-out _pointer)))
+                (unless dib-bits
+                  (error 'mk-tray
+                         "CreateDIBSection did not return pixel storage for: ~a"
+                         icon-file))
 
-  (define header
+                ;; Racket returns A,R,G,B. A Windows 32-bit DIB uses B,G,R,A
-    (make-BITMAPINFOHEADER
+                ;; byte order. get-argb-pixels was requested premultiplied
-     (ctype-sizeof _BITMAPINFOHEADER)
+                ;; because that is the form expected by alpha-blended icons.
-     width
+                (for ((pixel (in-range pixel-count)))
-     (- height) ; negative means top-down, matching Racket's row order
+                  (let* ((source (* pixel 4))
-     1
+                         (alpha (bytes-ref argb source))
-     32
+                         (red (bytes-ref argb (+ source 1)))
-     BI_RGB
+                         (green (bytes-ref argb (+ source 2)))
-     (* pixel-count 4)
+                         (blue (bytes-ref argb (+ source 3))))
-     0
+                    (ptr-set! dib-bits _uint8 source blue)
-     0
+                    (ptr-set! dib-bits _uint8 (+ source 1) green)
-     0
+                    (ptr-set! dib-bits _uint8 (+ source 2) red)
-     0))
+                    (ptr-set! dib-bits _uint8 (+ source 3) alpha)))
-  (define bits-out (malloc _pointer 'atomic))
-  (ptr-set! bits-out _pointer #f)
-  (define color-bitmap
-    (CreateDIBSection #f header DIB_RGB_COLORS bits-out #f 0))
-  (unless color-bitmap
-    (error 'mk-tray "CreateDIBSection failed while loading PNG icon: ~a" icon-file))
 
-  (define mask-bitmap #f)
+                ;; For modern 32-bit alpha icons the color bitmap carries
-  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+                ;; transparency. ICONINFO still requires a same-sized
-  ; goal   : Release temporary GDI bitmaps created during PNG conversion.
+                ;; monochrome mask for a color icon.
-  ; pre    : color-bitmap and mask-bitmap are HBITMAP values or #f.
+                (let* ((mask-stride (* 2 (quotient (+ width 15) 16)))
-  ; post   : Every non-#f bitmap is deleted and its local variable is set to
+                       (mask-size (* mask-stride height))
-  ;          #f, making repeated cleanup safe.
+                       (mask-bits (malloc mask-size 'atomic)))
-  ; result : Unspecified.
+                  (memset mask-bits 0 0 mask-size)
-  ; internals:
+                  (set! mask-bitmap
-  ;          This local helper is used on both the normal and exceptional
+                        (CreateBitmap width height 1 1 mask-bits))
-  ;          CreateIconIndirect paths so temporary GDI objects never leak.
+                  (unless mask-bitmap
-  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+                    (error 'mk-tray
-  (define (cleanup-bitmaps!)
+                           "CreateBitmap failed while loading PNG icon: ~a"
-    (when mask-bitmap
+                           icon-file))
-      (DeleteObject mask-bitmap)
-      (set! mask-bitmap #f))
-    (when color-bitmap
-      (DeleteObject color-bitmap)
-      (set! color-bitmap #f)))
 
-  (with-handlers ([exn?
+                  (let* ((icon-info
-                   (λ (exn)
+                          (make-ICONINFO 1 0 0 mask-bitmap color-bitmap))
-                     (cleanup-bitmaps!)
+                         (icon (CreateIconIndirect icon-info)))
-                     (raise exn))])
+                    ;; CreateIconIndirect copies both bitmaps, so the source
-    (define dib-bits (ptr-ref bits-out _pointer))
+                    ;; GDI objects can be released immediately. The returned
-    (unless dib-bits
+                    ;; HICON remains owned by us.
-      (error 'mk-tray "CreateDIBSection did not return pixel storage for: ~a" icon-file))
+                    (cleanup-bitmaps!)
-
+                    (unless icon
-    ;; Racket returns A,R,G,B. A Windows 32-bit DIB uses B,G,R,A byte order.
+                      (error 'mk-tray
-    ;; get-argb-pixels was requested premultiplied because that is the form
+                             "CreateIconIndirect failed while loading PNG icon: ~a"
-    ;; expected by alpha-blended Windows icons.
+                             icon-file))
-    (for ([pixel (in-range pixel-count)])
+                    icon))))))))))
-      (define source (* pixel 4))
-      (define alpha (bytes-ref argb source))
-      (define red (bytes-ref argb (+ source 1)))
-      (define green (bytes-ref argb (+ source 2)))
-      (define blue (bytes-ref argb (+ source 3)))
-      (ptr-set! dib-bits _uint8 source blue)
-      (ptr-set! dib-bits _uint8 (+ source 1) green)
-      (ptr-set! dib-bits _uint8 (+ source 2) red)
-      (ptr-set! dib-bits _uint8 (+ source 3) alpha))
-
-    ;; For modern 32-bit alpha icons the color bitmap carries transparency.
-    ;; ICONINFO still requires a same-sized monochrome mask for a color icon.
-    (define mask-stride (* 2 (quotient (+ width 15) 16)))
-    (define mask-size (* mask-stride height))
-    (define mask-bits (malloc mask-size 'atomic))
-    (memset mask-bits 0 0 mask-size)
-    (set! mask-bitmap
-          (CreateBitmap width height 1 1 mask-bits))
-    (unless mask-bitmap
-      (error 'mk-tray "CreateBitmap failed while loading PNG icon: ~a" icon-file))
-
-    (define icon-info
-      (make-ICONINFO 1 0 0 mask-bitmap color-bitmap))
-    (define icon (CreateIconIndirect icon-info))
-
-    ;; CreateIconIndirect copies both bitmaps, so the source GDI objects can
-    ;; be released immediately. The returned HICON remains owned by us.
-    (cleanup-bitmaps!)
-    (unless icon
-      (error 'mk-tray "CreateIconIndirect failed while loading PNG icon: ~a" icon-file))
-    icon))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ; goal   : Load a supported icon file into a native HICON.
@@ -487,18 +494,18 @@
 ;          the public API stays predictable and small.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (define (load-icon icon-file)
-  (define name
+  (let ((name
-    (string-downcase
+         (string-downcase
-     (path->string (path->complete-path icon-file))))
+          (path->string (path->complete-path icon-file)))))
-  (cond
+    (cond
-    [(regexp-match? #rx"[.]ico$" name)
+      [(regexp-match? #rx"[.]ico$" name)
-     (load-ico-icon icon-file)]
+       (load-ico-icon icon-file)]
-    [(regexp-match? #rx"[.]png$" name)
+      [(regexp-match? #rx"[.]png$" name)
-     (png->icon icon-file)]
+       (png->icon icon-file)]
-    [else
+      [else
-     (error 'mk-tray
+       (error 'mk-tray
-            "expected an .ico or .png icon file; got: ~a"
+              "expected an .ico or .png icon file; got: ~a"
-            icon-file)]))
+              icon-file)])))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ; goal   : Extract the low 16 bits from a pointer-sized Win32 value.
@@ -521,10 +528,10 @@
 ;          values >= #x8000 therefore represent negative coordinates.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (define (signed-word value)
-  (define n (low-word value))
+  (let ((n (low-word value)))
-  (if (>= n #x8000)
+    (if (>= n #x8000)
-      (- n #x10000)
+        (- n #x10000)
-      n))
+        n)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ; goal   : Extract the signed X coordinate supplied by a tray notification.
@@ -553,45 +560,30 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-; goal   : Normalize a public tray menu specification to popup-menu%.
+; goal   : Convert a platform-independent menu specification to popup-menu%.
-; pre    : menu-spec is #f, a popup-menu%, or a list containing two-element
+; pre    : t is an open tray and menu-spec contains (list action-id label)
-;          (label callback) lists and separator markers.
+;          entries and separator markers validated by the public module.
-; post   : Newly created menu items hold callbacks that invoke the supplied
+; post   : Menu items invoke the tray callback with their action symbol.
-;          zero-argument procedures.
+; result : A newly created popup-menu%.
-; result : #f, the original popup-menu%, or a newly created popup-menu%.
 ; internals:
-;          A simple list is converted directly to Racket GUI menu objects so
+;          Windows can reuse Racket GUI's popup-menu% because the tray icon is
-;          menu callbacks remain ordinary Racket GUI callbacks rather than
+;          associated with the existing Racket frame HWND. Menu callbacks are
-;          native Win32 callback code.
+;          therefore ordinary GUI callbacks, not native Win32 callbacks.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(define (menu-spec->popup-menu menu-spec)
+(define (menu-spec->popup-menu t menu-spec)
-  (cond
+  (let ((popup (new popup-menu%)))
-    [(not menu-spec) #f]
+    (for ((entry (in-list menu-spec)))
-    [(is-a? menu-spec popup-menu%) menu-spec]
+      (match entry
-    [(list? menu-spec)
+        [(or #f 'separator)
-     (let ([popup (new popup-menu%)])
+         (new separator-menu-item% [parent popup])]
-       (for ([entry (in-list menu-spec)])
+        [(list (? symbol? action-id) (? string? label))
-         (match entry
+         (new menu-item%
-           [(or #f 'separator)
+              [parent popup]
-            (new separator-menu-item% [parent popup])]
+              [label label]
-           [(list (? string? label) (? procedure? callback))
+              [callback
-            (unless (procedure-arity-includes? callback 0)
+               (λ (_item _event)
-              (error 'tray-set-menu!
+                 ((tray-callback t) action-id))])]))
-                     "menu callback for ~e does not accept zero arguments"
+    popup))
-                     label))
-            (new menu-item%
-                 [parent popup]
-                 [label label]
-                 [callback (λ (_item _event) (callback))])]
-           [_
-            (error 'tray-set-menu!
-                   "expected a popup-menu% or a list containing (list label callback), #f, or 'separator; got: ~e"
-                   entry)]))
-       popup)]
-    [else
-     (error 'tray-set-menu!
-            "expected a popup-menu%, menu specification list, or #f; got: ~e"
-            menu-spec)]))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ; goal   : Queue application work on the eventspace associated with tray t.
@@ -604,14 +596,14 @@
 ;          messages can arrive while the GUI is being torn down.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (define (queue-eventspace-callback t thunk)
-  (define eventspace (tray-eventspace t))
+  (let ((eventspace (tray-eventspace t)))
-  (unless (eventspace-shutdown? eventspace)
+    (unless (eventspace-shutdown? eventspace)
-    (with-handlers ([exn:fail? (λ (_exn) (void))])
+      (with-handlers ([exn:fail? (λ (_exn) (void))])
-      (parameterize ([current-eventspace eventspace])
+        (parameterize ([current-eventspace eventspace])
-        (queue-callback
+          (queue-callback
-         (λ ()
+           (λ ()
-           (unless (tray-closed? t)
+             (unless (tray-closed? t)
-             (thunk))))))))
+               (thunk)))))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ; goal   : Start the ordinary Racket thread that dispatches native tray events.
@@ -622,45 +614,38 @@
 ; internals:
 ;          Native FFI callbacks only write small immutable event values to the
 ;          OS async channel. This thread receives those values outside atomic
-;          FFI callback mode and queues GUI/user work into the frame eventspace.
+;          FFI callback mode and queues user work into the frame eventspace.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (define (start-event-thread! t)
-  (define event-thread
+  (let ((event-thread
-    (thread
+         (thread
-     (λ ()
+          (λ ()
-       (let loop ()
+            (let loop ()
-         (match (sync (tray-event-channel t))
+              (match (sync (tray-event-channel t))
-           ['close
+                ['close
-            (void)]
+                 (void)]
-           ['activate
+                ['activate
-            (let ([callback (tray-on-click t)])
+                 (queue-eventspace-callback
-              (when callback
+                  t
-                (queue-eventspace-callback t callback)))
+                  (λ ()
-            (loop)]
+                    ((tray-callback t) (tray-default-action t))))
-           ['minimize
+                 (loop)]
-            (queue-eventspace-callback
+                [(vector 'context-menu screen-x screen-y)
-             t
+                 (queue-eventspace-callback
-             (λ ()
+                  t
-               ;; Hiding instead of iconizing removes the application from the
+                  (λ ()
-               ;; taskbar while keeping the HWND alive for the tray icon.
+                    (let ((menu (tray-menu t)))
-               (send (tray-frame t) show #f)))
+                      (when menu
-            (loop)]
+                        (let-values (((x y)
-           [(vector 'context-menu screen-x screen-y)
+                                      (send (tray-frame t)
-            (queue-eventspace-callback
+                                            screen->client
-             t
+                                            screen-x
-             (λ ()
+                                            screen-y)))
-               (define menu (tray-menu t))
+                          (send (tray-frame t) popup-menu menu x y))))))
-               (when menu
+                 (loop)]
-                 (let-values ([(x y)
+                [_
-                               (send (tray-frame t)
+                 (loop)]))))))
-                                     screen->client
+    (set-tray-event-thread! t event-thread)))
-                                     screen-x
-                                     screen-y)])
-                   (send (tray-frame t) popup-menu menu x y)))))
-            (loop)]
-           [_
-            (loop)])))))
-  (set-tray-event-thread! t event-thread))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ; goal   : Translate a Shell_NotifyIcon callback message to an internal event.
@@ -678,19 +663,19 @@
   ;; Racket CS evaluates foreign callbacks in atomic mode. Do not run GUI or
   ;; user code here. An OS async channel is explicitly safe to use from an OS
   ;; callback/thread, so forward the event to an ordinary Racket thread.
-  (define notification (low-word lparam))
+  (let ((notification (low-word lparam)))
-  (cond
+    (cond
-    [(or (= notification NIN_SELECT)
+      [(or (= notification NIN_SELECT)
-         (= notification NIN_KEYSELECT))
+           (= notification NIN_KEYSELECT))
-     (os-async-channel-put (tray-event-channel t) 'activate)]
+       (os-async-channel-put (tray-event-channel t) 'activate)]
-    [(= notification WM_CONTEXTMENU)
+      [(= notification WM_CONTEXTMENU)
-     (os-async-channel-put
+       (os-async-channel-put
-      (tray-event-channel t)
+        (tray-event-channel t)
-      (vector 'context-menu
+        (vector 'context-menu
-              (x-from-wparam wparam)
+                (x-from-wparam wparam)
-              (y-from-wparam wparam)))]
+                (y-from-wparam wparam)))]
-    [else
+      [else
-     (void)]))
+       (void)])))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Native window integration
@@ -703,10 +688,11 @@
 ; post   : No subclass is installed by this procedure itself.
 ; result : A Racket procedure with the SUBCLASSPROC calling convention.
 ; internals:
-;          The procedure handles only the private tray callback, optional
+;          The procedure handles only the private tray callback and
-;          WM_SIZE/SIZE_MINIMIZED handling, and WM_NCDESTROY cleanup. Every
+;          WM_NCDESTROY cleanup. Minimize handling is intentionally absent:
-;          other message is passed unchanged to DefSubclassProc so Racket's
+;          the public module implements it portably with is-iconized? polling.
-;          own window procedure remains in control.
+;          Every other message is passed unchanged to DefSubclassProc so
+;          Racket's own window procedure remains in control.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (define (make-subclass-proc t)
   (λ (hwnd msg wparam lparam _subclass-id _ref-data)
@@ -714,23 +700,16 @@
       [(= msg (tray-callback-message t))
        (handle-native-tray-event t wparam lparam)
        0]
-      [(and (= msg WM_SIZE)
-            (= wparam SIZE_MINIMIZED)
-            (tray-hide-on-minimize? t))
-       ;; Forward only a small value from the native callback. GUI work is
-       ;; performed later on the frame's eventspace.
-       (os-async-channel-put (tray-event-channel t) 'minimize)
-       (DefSubclassProc hwnd msg wparam lparam)]
       [(= msg WM_NCDESTROY)
        ;; The HWND is going away. Remove the notification-area icon while the
        ;; handle is still valid. Windows discards the subclass automatically
        ;; as part of window destruction.
        (unless (tray-closed? t)
-         (let ([data
+         (let ((data
                 (make-notify-data hwnd
                                   (tray-id t)
                                   (tray-callback-message t)
-                                  (tray-icon t))])
+                                  (tray-icon t))))
            (Shell_NotifyIconW NIM_DELETE data)
            (when (tray-icon t)
              (DestroyIcon (tray-icon t))
@@ -756,23 +735,23 @@
 ;          the just-added icon again.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (define (add-notify-icon! t icon tooltip)
-  (define data
+  (let ((data
-    (make-notify-data (tray-hwnd t)
+         (make-notify-data (tray-hwnd t)
-                      (tray-id t)
+                           (tray-id t)
-                      (tray-callback-message t)
+                           (tray-callback-message t)
-                      icon))
+                           icon)))
-  (set-NOTIFYICONDATAW-uFlags!
+    (set-NOTIFYICONDATAW-uFlags!
-   data
+     data
-   (bitwise-ior NIF_MESSAGE NIF_ICON NIF_TIP NIF_SHOWTIP))
+     (bitwise-ior NIF_MESSAGE NIF_ICON NIF_TIP NIF_SHOWTIP))
-  (set-wide-array! (NOTIFYICONDATAW-szTip data) tooltip 128)
+    (set-wide-array! (NOTIFYICONDATAW-szTip data) tooltip 128)
 
-  (unless (bool-result? (Shell_NotifyIconW NIM_ADD data))
+    (unless (bool-result? (Shell_NotifyIconW NIM_ADD data))
-    (error 'mk-tray "Shell_NotifyIconW failed to add the tray icon"))
+      (error 'mk-tray "Shell_NotifyIconW failed to add the tray icon"))
 
-  (set-NOTIFYICONDATAW-uVersion! data NOTIFYICON_VERSION_4)
+    (set-NOTIFYICONDATAW-uVersion! data NOTIFYICON_VERSION_4)
-  (unless (bool-result? (Shell_NotifyIconW NIM_SETVERSION data))
+    (unless (bool-result? (Shell_NotifyIconW NIM_SETVERSION data))
-    (Shell_NotifyIconW NIM_DELETE data)
+      (Shell_NotifyIconW NIM_DELETE data)
-    (error 'mk-tray "Shell_NotifyIconW could not enable NOTIFYICON_VERSION_4")))
+      (error 'mk-tray "Shell_NotifyIconW could not enable NOTIFYICON_VERSION_4"))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ; goal   : Validate that t is a tray object that is still open.
@@ -797,8 +776,8 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ; goal   : Create a Windows notification-area icon bound to a Racket window.
 ; pre    : frame implements top-level-window<%>, has a native HWND, icon-file
-;          names a supported icon, on-click-cb is #f or a zero-argument
+;          names a supported icon, callback accepts one symbol, and
-;          procedure, and hide-on-minimize? is boolean.
+;          default-action is a symbol.
 ; post   : A native icon is registered, the frame HWND is subclassed, and an
 ;          event-dispatch thread is running. On failure, resources created up
 ;          to that point are released.
@@ -806,75 +785,70 @@
 ;          tray-set-menu!.
 ; internals:
 ;          Creation is performed in the frame's eventspace because the HWND
-;          belongs to that GUI thread. The existing Racket HWND is reused;
+;          belongs to that GUI thread. SetWindowSubclass observes only tray
-;          SetWindowSubclass observes tray/minimize messages without replacing
+;          messages and window destruction; minimize handling is portable and
-;          Racket's own WndProc.
+;          belongs to the public module.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(define (mk-tray frame
+(define (mk-tray frame icon-file callback default-action)
-                 icon-file
-                 on-click-cb
-                 #:hide-on-minimize? [hide-on-minimize? #f])
   (unless (is-a? frame top-level-window<%>)
     (raise-argument-error 'mk-tray "(is-a?/c top-level-window<%>)" frame))
-  (unless (boolean? hide-on-minimize?)
+  (unless (and (procedure? callback)
-    (raise-argument-error 'mk-tray "boolean?" hide-on-minimize?))
+               (procedure-arity-includes? callback 1))
-  (unless (or (not on-click-cb)
+    (raise-argument-error 'mk-tray "(procedure-arity-includes/c 1)" callback))
-              (and (procedure? on-click-cb)
+  (unless (symbol? default-action)
-                   (procedure-arity-includes? on-click-cb 0)))
+    (raise-argument-error 'mk-tray "symbol?" default-action))
-    (raise-argument-error 'mk-tray "(or/c #f (-> any))" on-click-cb))
 
-  (define eventspace (send frame get-eventspace))
+  (let ((eventspace (send frame get-eventspace)))
-  (call-in-eventspace
+    (call-in-eventspace
-   eventspace
+     eventspace
-   (λ ()
+     (λ ()
-     (define hwnd (send frame get-handle))
+       (let ((hwnd (send frame get-handle)))
-     (unless hwnd
+         (unless hwnd
-       (error 'mk-tray "the frame does not have a native HWND"))
+           (error 'mk-tray "the frame does not have a native HWND"))
 
-     (let* ([id (allocate-tray-id)]
+         (let* ((id (allocate-tray-id))
-            [callback-message (+ WM_APP id)]
+                (callback-message (+ WM_APP id))
-            [icon (load-icon icon-file)]
+                (icon (load-icon icon-file))
-            [t (tray frame
+                (t (tray frame
-                     hwnd
+                         hwnd
-                     id
+                         id
-                     callback-message
+                         callback-message
-                     on-click-cb
+                         callback
-                     hide-on-minimize?
+                         default-action
-                     eventspace
+                         eventspace
-                     (make-os-async-channel)
+                         (make-os-async-channel)
-                     #f
+                         #f
-                     #f
+                         #f
-                     icon
+                         icon
-                     #f
+                         #f
-                     #f)]
+                         #f))
-            [subclass-proc
+                (subclass-proc
-             (function-ptr (make-subclass-proc t) _SUBCLASSPROC)])
+                 (function-ptr (make-subclass-proc t) _SUBCLASSPROC)))
-       ;; WM_APP through 0xBFFF is reserved for application-private messages.
+           ;; WM_APP through 0xBFFF is reserved for application-private messages.
-       (when (> callback-message #xbfff)
+           (when (> callback-message #xbfff)
-         (DestroyIcon icon)
+             (DestroyIcon icon)
-         (error 'mk-tray
+             (error 'mk-tray
-                "too many simultaneously addressable tray callback messages"))
+                    "too many simultaneously addressable tray callback messages"))
 
-       (set-tray-subclass-proc! t subclass-proc)
+           (set-tray-subclass-proc! t subclass-proc)
-       (start-event-thread! t)
+           (start-event-thread! t)
 
-       (unless (bool-result?
+           (unless (bool-result?
-                (SetWindowSubclass hwnd subclass-proc id 0))
+                    (SetWindowSubclass hwnd subclass-proc id 0))
-         (os-async-channel-put (tray-event-channel t) 'close)
+             (os-async-channel-put (tray-event-channel t) 'close)
-         (DestroyIcon icon)
+             (DestroyIcon icon)
-         (error 'mk-tray "SetWindowSubclass failed for the Racket frame"))
+             (error 'mk-tray "SetWindowSubclass failed for the Racket frame"))
-
-       (with-handlers ([exn?
-                        (λ (exn)
-                          (RemoveWindowSubclass hwnd subclass-proc id)
-                          (os-async-channel-put (tray-event-channel t) 'close)
-                          (DestroyIcon icon)
-                          (raise exn))])
-         (define frame-label (send frame get-label))
-         (add-notify-icon! t icon
-                           (if (string? frame-label) frame-label "Racket"))
-         t)))))
 
+           (with-handlers ([exn?
+                            (λ (exn)
+                              (RemoveWindowSubclass hwnd subclass-proc id)
+                              (os-async-channel-put (tray-event-channel t) 'close)
+                              (DestroyIcon icon)
+                              (raise exn))])
+             (let ((frame-label (send frame get-label)))
+               (add-notify-icon! t icon
+                                 (if (string? frame-label) frame-label "Racket"))
+               t))))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ; goal   : Remove a tray icon and release all native resources owned by it.
@@ -928,29 +902,29 @@
   (call-in-eventspace
    (tray-eventspace t)
    (λ ()
-     (define new-icon (load-icon icon-file))
+     (let* ((new-icon (load-icon icon-file))
-     (define data
+            (data
-       (make-notify-data (tray-hwnd t)
+             (make-notify-data (tray-hwnd t)
-                         (tray-id t)
+                               (tray-id t)
-                         (tray-callback-message t)
+                               (tray-callback-message t)
-                         new-icon))
+                               new-icon)))
-     (set-NOTIFYICONDATAW-uFlags! data NIF_ICON)
+       (set-NOTIFYICONDATAW-uFlags! data NIF_ICON)
-     (cond
+       (cond
-       [(bool-result? (Shell_NotifyIconW NIM_MODIFY data))
+         [(bool-result? (Shell_NotifyIconW NIM_MODIFY data))
-        (let ([old-icon (tray-icon t)])
+          (let ((old-icon (tray-icon t)))
-          (set-tray-icon! t new-icon)
+            (set-tray-icon! t new-icon)
-          (when old-icon
+            (when old-icon
-            (DestroyIcon old-icon)))]
+              (DestroyIcon old-icon)))]
-       [else
+         [else
-        (DestroyIcon new-icon)
+          (DestroyIcon new-icon)
-        (error 'tray-set-icon! "Shell_NotifyIconW failed to change the icon")]))))
+          (error 'tray-set-icon! "Shell_NotifyIconW failed to change the icon")])))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-; goal   : Associate a context menu with an existing tray object.
+; goal   : Associate an action menu with an existing tray object.
-; pre    : t is an open tray and menu-spec is accepted by
+; pre    : t is open and menu-spec contains validated (list action-id label)
-;          menu-spec->popup-menu.
+;          entries and separator markers.
-; post   : tray-menu contains #f or a popup-menu% ready to be shown on the
+; post   : tray-menu contains a popup-menu% whose selections dispatch action
-;          frame eventspace when Windows reports WM_CONTEXTMENU.
+;          symbols through the callback supplied to mk-tray.
 ; result : void.
 ; internals:
 ;          Menu creation is performed in the frame eventspace because Racket
@@ -961,5 +935,5 @@
   (call-in-eventspace
    (tray-eventspace t)
    (λ ()
-     (set-tray-menu! t (menu-spec->popup-menu menu-spec))))
+     (set-tray-menu! t (menu-spec->popup-menu t menu-spec))))
   (void))

scrbl/racket-tray.scrbl

@@ -10,60 +10,79 @@
 
 @defmodule[racket-tray]
 
-Racket Tray provides a small API for adding a system tray icon to a Racket GUI
+Racket Tray provides a small cross-platform system tray API for Racket GUI
-application. Version 0.1.1 supports Windows. The Windows implementation uses
+applications. Version 0.1.1 contains native backends for Windows, Linux and
-the native @tt{HWND} of an existing Racket top-level window and requires no
+macOS. The public API uses symbolic actions so application code does not depend
-additional native library.
+on a platform-specific tray menu implementation.
 
 @section{Creating a Tray Icon}
 
 @defproc[(mk-tray [frame (is-a?/c top-level-window<%>)]
                   [icon-file path-string?]
-                  [on-click-cb (or/c #f (-> any))]
+                  [action-spec list?]
                   [#:hide-on-minimize? hide-on-minimize? boolean? #f])
          any/c]{
-Creates a tray icon associated with @racket[frame]. The frame must already
+Creates a tray icon associated with @racket[frame]. A @racket[frame%] or
-have a native window handle. A @racket[frame%] or @racket[dialog%] is suitable.
+@racket[dialog%] is suitable.
 
-@racket[icon-file] can be a Windows @tt{.ico} file or a @tt{.png} file. PNG
+@racket[action-spec] is mandatory and must contain exactly two values:
-alpha transparency is preserved when the image is converted to a native
+@racket[(list callback default-action-id)]. @racket[callback] must accept one
-Windows icon.
+argument and @racket[default-action-id] must be a symbol. Every action generated
+by the tray is passed to @racket[callback] as a symbol.
 
-When the tray icon is activated, @racket[on-click-cb] is queued in the
+The default action must occur in the menu later installed with
-eventspace of @racket[frame]. Use @racket[#f] when no activation callback is
+@racket[tray-set-menu!]. Windows maps normal tray activation to this action.
-needed.
+Ayatana AppIndicator 0.6 or newer can do the same on Linux. Older AppIndicator
+0.5.x implementations open the menu on primary activation instead. A native
+macOS status item with an attached menu also opens its menu instead of invoking
+the default action directly.
 
-When @racket[hide-on-minimize?] is true, minimizing the associated window
+When @racket[hide-on-minimize?] is true, Racket Tray periodically checks
-hides it after Windows reports @tt{SIZE_MINIMIZED}. Hiding the window removes
+@method[frame% is-iconized?]. When the frame changes to the iconized state it
-it from the taskbar while leaving its native handle alive for the tray icon.
+is hidden with @racket[(send frame show #f)]. This implementation is entirely
-When showing such a window again, an application can restore it with
+platform independent and does not use a Win32, GTK or AppKit minimize hook.
-@racket[(send frame iconize #f)] when @racket[(send frame is-iconized?)] is
-true.
 
 The returned value represents the tray icon and is accepted by the other
 procedures in this library.
 }
 
+@section{Tray Actions and Menus}
+
+@defproc[(tray-set-menu! [tray any/c]
+                         [menu-spec list?]) void?]{
+Sets the menu for @racket[tray]. An actionable entry has the form
+@racket[(list action-id label)], where @racket[action-id] is a symbol and
+@racket[label] is a string. @racket['separator] or @racket[#f] creates a
+separator. Action identifiers must be unique and the menu must contain the
+default action supplied to @racket[mk-tray].
+
+For example:
+
+@racketblock[
+(tray-set-menu!
+ tray
+ (list
+  (list 'open "Open")
+  'separator
+  (list 'exit "Exit")))
+]
+
+Choosing @racket["Open"] invokes the callback as @racket[(callback 'open)]. The
+same callback receives every other menu action.
+}
+
 @section{Changing and Closing a Tray Icon}
 
 @defproc[(tray-set-icon! [tray any/c]
                          [icon-file path-string?]) void?]{
-Replaces the image of @racket[tray]. Both @tt{.ico} and @tt{.png} files are
+Replaces the image of @racket[tray]. PNG files can be used on all supported
-accepted.
+platforms. The Windows backend also accepts ICO files.
-}
-
-@defproc[(tray-set-menu! [tray any/c]
-                         [menu any/c]) void?]{
-Sets the context menu for @racket[tray]. @racket[menu] can be a
-@racket[popup-menu%], @racket[#f], or a list. A list entry of the form
-@racket[(list label callback)] creates a menu item. @racket['separator] and
-@racket[#f] create a separator. Each callback must accept zero arguments.
 }
 
 @defproc[(tray-close [tray any/c]) void?]{
-Removes @racket[tray], detaches its native window hook, and releases the
+Removes @racket[tray], stops its optional portable minimize watcher and releases
-Windows icon resources owned by the tray object. Calling this procedure does
+the native resources owned by the active platform backend. Calling this
-not close the associated Racket window.
+procedure does not close the associated Racket window.
 }
 
 @section{Closing a Window to the Tray}
@@ -81,17 +100,36 @@ of a frame. A tray application normally overrides it and hides the frame:
 ]
 
 This is intentionally separate from @racket[#:hide-on-minimize?]. Closing a
-window is already represented by a public Racket GUI callback, while Windows
+window already has a portable public Racket callback; minimizing does not.
-does not expose minimizing through a corresponding public Racket callback.
+
+@section{Platform Behaviour}
+
+On Windows, the backend uses the native HWND returned by Racket GUI,
+@tt{Shell_NotifyIconW} and @tt{SetWindowSubclass}. A normal tray activation
+invokes the configured default action. No additional native library is needed.
+
+On Linux, the backend uses Ayatana AppIndicator and GTK3. AppIndicator 0.6 or
+newer provides primary activation, which Racket Tray maps to the default action.
+With AppIndicator 0.5.x, primary activation opens the menu instead. Menu choices
+have the same symbolic callback behaviour on both library versions.
+
+On macOS, the backend uses AppKit @tt{NSStatusItem}, @tt{NSStatusBarButton} and
+@tt{NSMenu} through Racket's Objective-C FFI. A status item with an attached
+menu opens that menu when activated. Menu choices invoke the common symbolic
+callback. No additional native library is needed.
+
+@section{Linux Runtime Dependency}
+
+The Linux backend requires the Ayatana AppIndicator GTK3 runtime library. If it
+cannot be loaded, @racket[mk-tray] reports the missing dependency and suggests
+the native package to install.
+
+Debian and Ubuntu use @tt{libayatana-appindicator3-1}. Fedora uses
+@tt{libayatana-appindicator-gtk3}. Arch Linux uses
+@tt{libayatana-appindicator}.
 
 @section{Example}
 
-The package contains @filepath{examples/simple.rkt}. It demonstrates hiding a
+The package contains @filepath{examples/simple.rkt}. It demonstrates symbolic
-frame on both minimize and close, restoring it from the tray, and terminating
+tray actions, hiding a frame on minimize and close, restoring it from the tray,
-the application only through the tray menu.
+and terminating the application only through the @racket['exit] action.
-
-@section{Platform Support}
-
-Version 0.1.1 implements Windows. Requiring @racketmodname[racket-tray] is safe
-on other operating systems, but calling its tray operations reports that the
-platform is not yet supported.

tests/basic.rkt

@@ -3,15 +3,17 @@
 (require rackunit
          racket-tray)
 
-;; The public module must be loadable on every platform, even when no tray
+;; The public module must be loadable on every package build host, including a
-;; backend is available for the current operating system.
+;; Linux host that does not have the optional AppIndicator runtime installed.
 (check-true (procedure? mk-tray))
 (check-true (procedure? tray-close))
 (check-true (procedure? tray-set-icon!))
 (check-true (procedure? tray-set-menu!))
 
-;; Keep the keyword part of the public API testable without constructing a GUI
+;; Keep the public signature testable without opening a GUI window or requiring
-;; window or depending on Windows being available on the package build host.
+;; any native tray implementation to be available on the build host.
+(check-true (procedure-arity-includes? mk-tray 3))
+
 (define-values (required-keywords allowed-keywords)
   (procedure-keywords mk-tray))