Adding a tray icon.

2026-04-29 14:34:12 +02:00
parent 964a0439e6
commit 97acd18a88
4 changed files with 238 additions and 6 deletions
@@ -0,0 +1,112 @@
+#lang racket/base
+
+(require "racket-webview.rkt"
+         "menu.rkt"
+         racket/class)
+
+(provide wv-tray%)
+
+(define wv-tray%
+  (class object%
+
+    (init-field [icon (error "tray icon is mandatory")]
+                [tooltip ""]
+                [menu #f])
+
+    (define wv #f)
+    (define menu-callbacks (make-hash))
+
+    (define/private (event-handler wv evt)
+      (let ((event (hash-ref evt 'event 'unknown-event)))
+        (cond
+          [(eq? event 'tray-activated)
+           (send this activated (hash-ref evt 'reason 'unknown))]
+
+          [(eq? event 'tray-message-clicked)
+           (send this message-clicked)]
+
+          [(eq? event 'tray-menu-item-chosen)
+           (let* ((id (string->symbol
+                       (format "~a" (hash-ref evt 'id 'unknown))))
+                  (cb (hash-ref menu-callbacks id #f)))
+             (if cb
+                 (cb)
+                 (send this menu-item-chosen id)))]
+
+          [else
+           (send this unhandled-event evt)])))
+
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    ;; Events
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+    (define/public (activated reason)
+      #t)
+
+    (define/public (message-clicked)
+      #t)
+
+    (define/public (menu-item-chosen id)
+      #t)
+
+    (define/public (unhandled-event evt)
+      #t)
+
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    ;; Commands
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+    (define/public (show)
+      (webview-show wv)
+      this)
+
+    (define/public (hide)
+      (webview-hide wv)
+      this)
+
+    (define/public (close)
+      (webview-close wv)
+      this)
+
+    (define/public (set-icon! icon-file)
+      (webview-tray-set-icon! wv icon-file)
+      this)
+
+    (define/public (set-tooltip! text)
+      (webview-tray-set-tooltip! wv text)
+      this)
+
+    (define/public (show-message title message)
+      (webview-tray-show-message wv title message)
+      this)
+
+    (define/public (set-menu! menu-def)
+      (hash-clear! menu-callbacks)
+      (wv-menu-for-each menu-def
+                        (lambda (item)
+                          (let ((id (wv-menu-item-id item))
+                                (cb (wv-menu-item-callback item)))
+                            (when cb
+                              (hash-set! menu-callbacks id cb)))))
+      (webview-tray-set-menu! wv menu-def)
+      this)
+
+    (define/public (connect-menu! id callback)
+      (hash-set! menu-callbacks id callback)
+      this)
+
+    (define/public (disconnect-menu! id)
+      (hash-remove! menu-callbacks id)
+      this)
+
+    (define/public (handle)
+      wv)
+
+    (super-new)
+
+    (set! wv (webview-tray-create icon (λ (wv evt)
+                                         (send this event-handler wv evt))
+                                  #:tooltip tooltip))
+
+    (unless (eq? menu #f)
+      (send this set-menu! menu))))