112 lines
4.7 KiB
Racket
112 lines
4.7 KiB
Racket
#lang racket/base
|
|
|
|
(require racket/runtime-path)
|
|
|
|
(provide mk-tray
|
|
tray-close
|
|
tray-set-icon!
|
|
tray-set-menu!)
|
|
|
|
;; The platform implementation is loaded dynamically so that requiring
|
|
;; racket-tray remains possible on platforms that do not yet have a backend.
|
|
(define-runtime-module-path windows-module "private/windows.rkt")
|
|
|
|
(define platform-mk-tray #f)
|
|
(define platform-tray-close #f)
|
|
(define platform-tray-set-icon! #f)
|
|
(define platform-tray-set-menu! #f)
|
|
|
|
(when (eq? (system-type 'os*) 'windows)
|
|
(set! platform-mk-tray
|
|
(dynamic-require windows-module 'mk-tray))
|
|
(set! platform-tray-close
|
|
(dynamic-require windows-module 'tray-close))
|
|
(set! platform-tray-set-icon!
|
|
(dynamic-require windows-module 'tray-set-icon!))
|
|
(set! platform-tray-set-menu!
|
|
(dynamic-require windows-module 'tray-set-menu!)))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Supporting functions
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; goal : Report that the current operating system has no tray backend.
|
|
; pre : who is the name of the public procedure being called.
|
|
; post : No state is changed.
|
|
; result : Does not return; raises an exception naming the unsupported OS.
|
|
; internals:
|
|
; The public module remains loadable on every platform; only an
|
|
; attempted tray operation fails when no backend was loaded.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
(define (unsupported who)
|
|
(error who "not supported on this operating system: ~a" (system-type 'os*)))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Provided functions
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; goal : Create a tray icon using the backend for the current platform.
|
|
; pre : frame, icon-file, on-click-cb and hide-on-minimize? satisfy the
|
|
; requirements documented for mk-tray.
|
|
; post : On a supported platform a tray icon is created; otherwise an
|
|
; unsupported-platform exception is raised.
|
|
; result : The platform tray value accepted by the other public procedures.
|
|
; internals:
|
|
; This module is a small platform-neutral dispatcher. Windows code is
|
|
; loaded dynamically only on Windows so requiring racket-tray remains
|
|
; possible on other operating systems.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
(define (mk-tray frame
|
|
icon-file
|
|
on-click-cb
|
|
#:hide-on-minimize? [hide-on-minimize? #f])
|
|
(if platform-mk-tray
|
|
(platform-mk-tray frame
|
|
icon-file
|
|
on-click-cb
|
|
#:hide-on-minimize? hide-on-minimize?)
|
|
(unsupported 'mk-tray)))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; goal : Close a tray icon through the active platform backend.
|
|
; pre : tray is a value previously returned by mk-tray.
|
|
; post : Platform tray resources are released on supported systems.
|
|
; result : void on success; raises when the platform is unsupported.
|
|
; internals:
|
|
; All resource ownership and idempotence rules are implemented by the
|
|
; platform backend.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
(define (tray-close tray)
|
|
(if platform-tray-close
|
|
(platform-tray-close tray)
|
|
(unsupported 'tray-close)))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; goal : Replace the image of an existing tray icon.
|
|
; pre : tray is open and icon-file names a format supported by the backend.
|
|
; post : The active tray image is replaced when the backend succeeds.
|
|
; result : The backend result; the Windows implementation returns void.
|
|
; internals:
|
|
; The public facade performs no image conversion itself.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
(define (tray-set-icon! tray icon-file)
|
|
(if platform-tray-set-icon!
|
|
(platform-tray-set-icon! tray icon-file)
|
|
(unsupported 'tray-set-icon!)))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; goal : Set or remove the context menu of an existing tray icon.
|
|
; pre : tray is open and menu is accepted by the active backend.
|
|
; post : The tray uses the supplied menu specification on success.
|
|
; result : void on Windows; raises when the platform is unsupported.
|
|
; internals:
|
|
; Menu normalization belongs to the platform implementation because
|
|
; native event integration is platform-specific.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
(define (tray-set-menu! tray menu)
|
|
(if platform-tray-set-menu!
|
|
(platform-tray-set-menu! tray menu)
|
|
(unsupported 'tray-set-menu!)))
|