tray icon added

gui.rkt

@@ -170,7 +170,7 @@
           )
         )
       )
-    
+
     (define (update-state st)
       (dbg-rktplayer "state: ~a" st)
       (unless (eq? st state)
@@ -614,6 +614,19 @@
         )
       )
 
+    (define/public (show-hide)
+      (let ((st (send this window-state)))
+        (if (eq? st 'hidden)
+          (send this present)
+          (send this hide)
+          )
+        )
+      )
+
+    (define/override (can-close?)
+      (show-hide)
+      #f)
+
     (begin
       (dbg-rktplayer "Initalizing gui")
       (dbg-rktplayer "ICON: ~a" (get-field icon this))

rktplayer.rkt

@@ -37,6 +37,7 @@
   )
 
 (define rktplayer-window #f)
+(define rktplayer-tray #f)
 
 (define (run . no-exit)
   (let* ((ini (new ini% [file 'rktplayer]))
@@ -47,11 +48,12 @@
                        ))
          )
     (let* ((window (new rktplayer% [wv-context context] [log-file log-file]))
-           (tray (new rktplayer-tray% [player-gui window]))
+           (tray (new rktplayer-tray% [rktplayer-gui window]))
            )
       (set! rktplayer-window window)
-      (when (and (not (null? no-exit))
+      (set! rktplayer-tray tray)
-                 (not (eq? (car no-exit) #t)))
+      (when (or (null? no-exit)
+                (not (eq? (car no-exit) #t)))
         (webview-wait-for-quit)
         (webview-exit)
         (exit))

run.sh

@@ -0,0 +1,2 @@
+#!/bin/bash
+racket -e '(enter! "rktplayer.rkt") (run)'

tray.rkt

@@ -0,0 +1,57 @@
+#lang racket
+
+(require racket-webview
+         racket/runtime-path
+         "translate.rkt"
+         )
+
+(provide rktplayer-tray%)
+
+(define-runtime-path rkt-gui-dir "gui")
+
+(define rktplayer-tray%
+  (class wv-tray%
+    (init-field [rktplayer-gui (error "Must be called with the GUI Window of RktPlayer")]
+                )
+
+    (define (adjust-menu)
+      (let ((mnu (wv-menu 'tray-menu
+                          (wv-menu-item 'm-hide-show
+                                        (if (eq? (send rktplayer-gui window-state) 'hidden)
+                                            (tr "Show window")
+                                            (tr "Hide window")))
+                          (wv-menu-item 'm-pause-play (tr "Pause / Play"))
+                          (wv-menu-item 'm-quit (tr "Quit"))
+                          )
+                 )
+            )
+        (send this set-menu! mnu)
+        (send this connect-menu! 'm-hide-show (λ () (show-hide)))
+        (send this connect-menu! 'm-quit (λ () (quit)))
+        (send this connect-menu! 'm-pause-play (λ () (pause-play)))
+        ))
+
+    (define (quit)
+      (send rktplayer-gui quit))
+
+    (define (pause-play)
+      (send rktplayer-gui play-or-pause))
+    
+    (define (show-hide)
+      (send rktplayer-gui show-hide)
+      (adjust-menu)
+      )
+
+    (define/override (activated reason)
+      (show-hide)
+      #t)
+
+    (super-new [icon (build-path rkt-gui-dir "rktplayer.png")]
+               [tooltip (tr "Racket Music Player")])
+
+    (begin
+      (adjust-menu)
+      )
+
+    )
+  )