Window list widgetry
This commit is contained in:
parent
3c57b71ed2
commit
0400385142
16
gui.rkt
16
gui.rkt
|
@ -500,6 +500,22 @@
|
||||||
(on (message (button-click 'start-button (mouse-state $mx $my _ _ _)))
|
(on (message (button-click 'start-button (mouse-state $mx $my _ _ _)))
|
||||||
(send! (pop-up-menu-trigger 'system-menu mx my 0 1 'left-up)))))
|
(send! (pop-up-menu-trigger 'system-menu mx my 0 1 'left-up)))))
|
||||||
|
|
||||||
|
(actor #:name 'window-list-monitor
|
||||||
|
(during/actor (window-state $id $title _)
|
||||||
|
(field [x 0] [y 0])
|
||||||
|
(define reqsize
|
||||||
|
(parameterize ((theme-button-y-padding 8)
|
||||||
|
(theme-button-min-height 0)
|
||||||
|
(theme-button-background-color (hsv->color 240 1 0.6)))
|
||||||
|
(pushbutton title x y #:id (list 'window-list id) #:parent 'toolbar
|
||||||
|
#:trigger-event 'left-down)))
|
||||||
|
(during (layout-solution 'toolbar (horizontal-layout `(-5.0 ,id)) reqsize
|
||||||
|
(rectangle $l $t $w $h))
|
||||||
|
(x l)
|
||||||
|
(y t)
|
||||||
|
(on (message (button-click (list 'window-list id) _))
|
||||||
|
(send! (raise-widget id))))))
|
||||||
|
|
||||||
(actor #:name 'clock
|
(actor #:name 'clock
|
||||||
(field [now (current-seconds)])
|
(field [now (current-seconds)])
|
||||||
(on (message (inbound (frame-event _ $timestamp _ _)))
|
(on (message (inbound (frame-event _ $timestamp _ _)))
|
||||||
|
|
Loading…
Reference in New Issue