hans/racket-webview
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Adding a tray icon.

Browse Source
This commit is contained in:
Hans Dijkema
2026-04-29 14:34:12 +02:00
parent 964a0439e6
commit 97acd18a88
4 changed files with 238 additions and 6 deletions
Download Patch File Download Diff File Expand all files Collapse all files
info.rkt
+1 -1
View File
@@ -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")
racket-webview-qt.rkt
+53
View File
@@ -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
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
racket-webview.rkt
+72 -5
View File
@@ -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
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
wv-tray.rkt
+112
View File
@@ -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))))