hans/rkt-web-player
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Use ellipsis-msg instead of message%.

Browse Source 
There's a 200 character contract for message% -> set-label.
This commit is contained in:
Hans Dijkema
2026-09-16 23:53:00 +02:00
parent 2eb9a9590e
commit 705ff17c79
2 changed files with 33 additions and 23 deletions
Download Patch File Download Diff File Expand all files Collapse all files
private-player-agent/player-agent-gui.rkt
+32 -23
View File
@@ -9,6 +9,7 @@
racket/string
racket-tray
simple-log
ellipsis-msg
"player-agent-config.rkt"
"player-agent-core.rkt"
"player-agent-translate.rkt")
@@ -101,6 +102,9 @@
(tray #f)
(shutting-down? #f))
(define (cap200 msg)
(substring msg 0 (min 199 (string-length msg))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Queue a status-label update in the GUI eventspace.
; pre : message is a string supplied by the agent runtime.
@@ -114,7 +118,7 @@
(queue-callback
(λ ()
(when status-message
(send status-message set-label message)))
(send status-message set-label (cap200 message))))
#f))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -206,21 +210,23 @@
"")))))
(send playback-message
set-label
(if track
(format "~a~a: ~a"
prefix
(if (number? track-number)
(format " #~a" track-number)
"")
track-label)
(tr 'no-track)))
(send playback-details set-label (string-join details " · "))
(cap200
(if track
(format "~a~a: ~a"
prefix
(if (number? track-number)
(format " #~a" track-number)
"")
track-label)
(tr 'no-track))))
(send playback-details set-label (cap200 (string-join details " · ")))
(send playback-filename
set-label
(if (and (string? filename)
(cap200
(if (and (string? filename)
(not (string=? filename "")))
filename
"—")))))
"—"))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Persist edited connection settings and reconnect the runtime.
@@ -246,7 +252,7 @@
(save-player-agent-config! config)
(send name-field set-value next-name)
((player-agent-runtime-reconnect! runtime) next-server next-name)
(send connect-button set-label (tr 'reconnect))))
(send connect-button set-label (cap200 (tr 'reconnect)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Release resources owned by the GUI agent exactly once.
@@ -322,7 +328,8 @@
(new agent-frame%
(label (tr 'app-title))
(width 560)
(height 310))))
;(height 310)
)))
(set! frame new-frame))
(let* ((panel
@@ -347,6 +354,7 @@
(label (tr 'playback))
(alignment '(left top))
(stretchable-height #f)))
;(msgs-pane (new vertical-pane% [parent panel]))
(controls
(new horizontal-panel%
(parent panel)
@@ -357,30 +365,31 @@
;; render their label and text poorly on some display configurations.
(send (send id-field get-editor) lock #t)
(set! playback-message
(new message%
(new ellipsis-msg%
(parent playback-panel)
(label (tr 'no-track))
(auto-resize #t)))
[ellipsis 'right] [auto-resize #t] [stretchable-width #t]
))
(set! playback-details
(new message%
(new ellipsis-msg%
(parent playback-panel)
(label "00:00:00 / --:--:--")
(auto-resize #t)))
[ellipsis 'right] [auto-resize #t] [stretchable-width #t]))
(set! playback-filename
(new message%
(new ellipsis-msg%
(parent playback-panel)
(label "—")
(auto-resize #t)))
[ellipsis 'right] [auto-resize #t] [stretchable-width #t]))
(set! connect-button
(new button%
(parent controls)
(label (tr 'save-connect))
(callback (λ (_button _event) (reconnect!)))))
(set! status-message
(new message%
(new ellipsis-msg%
(parent controls)
(label (tr 'connecting))
(auto-resize #t))))
[ellipsis 'right] [auto-resize #t] [stretchable-width #t])))
(set! playback-timer
(new timer%
@@ -402,7 +411,7 @@
(send frame show #t)
((player-agent-runtime-start! runtime))
(send connect-button set-label (tr 'reconnect))
(send connect-button set-label (cap200 (tr 'reconnect)))
frame))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;