From 97acd18a8823aeda70415f96de73cfafdcbf1eac Mon Sep 17 00:00:00 2001 From: Hans Dijkema Date: Wed, 29 Apr 2026 14:34:12 +0200 Subject: [PATCH] Adding a tray icon. --- info.rkt | 2 +- racket-webview-qt.rkt | 53 ++++++++++++++++++++ racket-webview.rkt | 77 +++++++++++++++++++++++++++-- wv-tray.rkt | 112 ++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 238 insertions(+), 6 deletions(-) create mode 100644 wv-tray.rkt diff --git a/info.rkt b/info.rkt index 4b12db2..d1d5e26 100644 --- a/info.rkt +++ b/info.rkt @@ -1,7 +1,7 @@ #lang info (define pkg-authors '(hnmdijkema)) -(define version "0.1.5") +(define version "0.1.6") (define license 'MIT) (define collection "racket-webview") (define pkg-desc "racket-webview - A Web Based GUI library, based on a Qt WebEngine backend") diff --git a/racket-webview-qt.rkt b/racket-webview-qt.rkt index 1092cba..da9d987 100644 --- a/racket-webview-qt.rkt +++ b/racket-webview-qt.rkt @@ -51,6 +51,12 @@ rkt-webview-version rkt-webview-set-loglevel rkt-webview-info + ; tray specific + rkt-webview-tray-create + rkt-webview-tray-set-icon! + rkt-webview-tray-set-tooltip! + rkt-webview-tray-show-message + rkt-webview-tray-set-menu! ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -466,6 +472,25 @@ (define-rktwebview rkt_webview_message_box (_fun _int _string/utf-8 _string/utf-8 _string/utf-8 _rkt_messagetype_t -> _rkt_result_t)) +;RKTWEBVIEW_QT_EXPORT rktwebview_t rkt_webview_tray_create(const char *icon_file, const char *tooltip); +(define-rktwebview rkt_webview_tray_create + (_fun _string/utf-8 _string/utf-8 -> _int)) + +;RKTWEBVIEW_QT_EXPORT result_t rkt_webview_tray_set_icon( rktwebview_t tray, const char *icon_file); +(define-rktwebview rkt_webview_tray_set_icon + (_fun _int _string/utf-8 -> _rkt_result_t)) + +;RKTWEBVIEW_QT_EXPORT result_t rkt_webview_tray_set_tooltip(rktwebview_t tray, const char *tooltip); +(define-rktwebview rkt_webview_tray_set_tooltip + (_fun _int _string/utf-8 -> _rkt_result_t)) + +;RKTWEBVIEW_QT_EXPORT result_t rkt_webview_tray_show_message(rktwebview_t tray, const char *title, const char *message); +(define-rktwebview rkt_webview_tray_show_message + (_fun _int _string/utf-8 _string/utf-8 -> _rkt_result_t)) + +;RKTWEBVIEW_QT_EXPORT result_t rkt_webview_tray_set_menu(rktwebview_t tray, const char *menu_json); +(define-rktwebview rkt_webview_tray_set_menu + (_fun _int _string/utf-8 -> _rkt_result_t)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Initialize and start library @@ -840,6 +865,34 @@ ) ) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Tray specific +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (rkt-webview-tray-create icon-file tooltip evt-callback) + (let* ((evt-queue (make-queue)) + (tray (rkt_webview_tray_create icon-file tooltip)) + (handle (make-rkt-wv tray evt-queue evt-callback #t (lambda () #t)))) + (hash-set! evt-cb-hash tray (lambda (evt) (evt-callback handle evt))) + (hash-set! rkt-wv-store tray handle) + handle)) + +(define (rkt-webview-tray-set-icon! tray icon-file) + (rkt_webview_tray_set_icon (rkt-wv-win tray) icon-file)) + +(define (rkt-webview-tray-set-tooltip! tray tooltip) + (rkt_webview_tray_set_tooltip (rkt-wv-win tray) tooltip)) + +(define (rkt-webview-tray-show-message tray title message) + (rkt_webview_tray_show_message (rkt-wv-win tray) title message)) + +(define (rkt-webview-tray-set-menu! tray menu-json) + (rkt_webview_tray_set_menu (rkt-wv-win tray) menu-json)) + +;; Furthermore: rkt-webview-close, rkt-webview-valid?, rkt-webview-show and rkt-webview-hide apply also to tray + + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Administration ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/racket-webview.rkt b/racket-webview.rkt index 6271a26..d66008b 100644 --- a/racket-webview.rkt +++ b/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 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/wv-tray.rkt b/wv-tray.rkt new file mode 100644 index 0000000..388eff1 --- /dev/null +++ b/wv-tray.rkt @@ -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)))) \ No newline at end of file