Adding a tray icon.

racket-webview.rkt

@@ -37,6 +37,8 @@
          webview-devtools
          webview-close
 
+         wv-win?
+
          webview-run-js
          webview-call-js
          webview-call-js-result?
@@ -129,6 +131,14 @@
 
          webview-delayed-reactor
 
+         ; tray specific
+         webview-tray-create
+         webview-tray-set-icon!
+         webview-tray-set-tooltip!
+         webview-tray-show-message
+         webview-tray-set-menu!
+         wv-tray?
+
          ;test
          )
 
@@ -187,8 +197,23 @@
   ([handle #:mutable]
    [context #:mutable]
    [window-nr #:mutable]
+   [kind #:mutable]
    )
-  #:transparent)
+  #:transparent
+  )
+
+(define raw-wv-win? wv-win?)
+
+(set! wv-win?
+      (λ (wv)
+        (and (raw-wv-win? wv)
+             (eq? (wv-win-kind wv) 'window))))
+
+(define (wv-tray? wv)
+  (and (raw-wv-win? wv)
+       (eq? (wv-win-kind wv) 'tray)))
+
+
 
 (define re_head #px"[<][/][Hh][eE][aA][dD][>]")
 
@@ -507,7 +532,7 @@
   (->* (wv-context? string? procedure?)
        (#:parent (or/c wv-win? #f))
        wv-win?)
-  (let* ((h (make-wv-win #f context -1))
+  (let* ((h (make-wv-win #f context -1 'window))
          (event-processor (λ (wv evt)
                             (event-callback h (util-parse-event evt))))
          (close-callback (λ () #t))
@@ -606,8 +631,15 @@
        (-> wv-win? symbol?)
        (name-to-wrap (wv-win-handle wv))))))
 
-(def-win-func webview-show rkt-webview-show)
-(def-win-func webview-hide rkt-webview-hide)
+(define-syntax def-win-tray-func
+  (syntax-rules ()
+    ((_ name name-to-wrap)
+     (define/contract (name wv)
+       (-> (or/c wv-win? wv-tray?) symbol?)
+       (name-to-wrap (wv-win-handle wv))))))
+
+(def-win-tray-func webview-show rkt-webview-show)
+(def-win-tray-func webview-hide rkt-webview-hide)
 (def-win-func webview-maximize rkt-webview-maximize)
 (def-win-func webview-minimize rkt-webview-minimize)
 (def-win-func webview-show-normal rkt-webview-show-normal)
@@ -667,7 +699,7 @@
   (rkt-webview-set-icon! (wv-win-handle wv) (format "~a" icon-file)))
 
 (define/contract (webview-close wv)
-  (-> wv-win? symbol?)
+  (-> (or/c wv-win? wv-tray?) symbol?)
   (begin
     (rkt-webview-close (wv-win-handle wv))
     'oke))
@@ -1021,6 +1053,41 @@
 (define (webview-info)
   (rkt-webview-info))
 
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Tray specific
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define/contract (webview-tray-create icon-file event-callback #:tooltip [tooltip ""])
+  (->* ((or/c string? path?) procedure?) (#:tooltip string?) wv-win?)
+  (let* ((h (make-wv-win #f #f -1 'tray))
+         (event-processor
+          (lambda (wv evt)
+            (event-callback h (util-parse-event evt))))
+         (internal-handle
+          (rkt-webview-tray-create (format "~a" icon-file)
+                                   tooltip
+                                   event-processor)))
+    (set-wv-win-handle! h internal-handle)
+    (set-wv-win-window-nr! h (rkt-wv-win internal-handle))
+    h))
+
+(define/contract (webview-tray-set-icon! tray icon-file)
+  (-> wv-tray? (or/c string? path?) symbol?)
+  (rkt-webview-tray-set-icon! tray (format "~a" icon-file)))
+
+(define/contract (webview-tray-set-tooltip! tray tooltip)
+  (-> wv-tray? string? symbol?)
+  (rkt-webview-tray-set-tooltip! tray tooltip))
+
+(define/contract (webview-tray-show-message tray title message)
+  (-> wv-tray? string? string? symbol?)
+  (rkt-webview-tray-show-message tray title message))
+
+(define/contract (webview-tray-set-menu! tray menu)
+  (-> wv-tray? is-wv-menu? symbol?)
+  (rkt-webview-tray-set-menu! tray (wv-menu->json menu)))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; delayed reactor
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;