59 lines
1.4 KiB
Racket
59 lines
1.4 KiB
Racket
#lang racket/base
|
|
|
|
(require racket/gui
|
|
xml
|
|
xml/xexpr
|
|
)
|
|
|
|
(provide ww-connect
|
|
make-delayed-reactor
|
|
mktable
|
|
simple-row-formatter
|
|
)
|
|
|
|
(define-syntax ww-connect
|
|
(syntax-rules (this)
|
|
((_ id method)
|
|
(send (send this element id) connect 'click (λ (data) (send this method)))
|
|
)
|
|
)
|
|
)
|
|
|
|
|
|
(define (make-delayed-reactor seconds closure)
|
|
(let* ((last-val #f)
|
|
(last-time -1)
|
|
(interval-ms (* seconds 1000))
|
|
(timeout-check (λ ()
|
|
(let ((ms (current-milliseconds)))
|
|
(unless (= last-time -1)
|
|
(when (> ms (+ last-time interval-ms))
|
|
(set! last-time -1)
|
|
(closure last-val))))))
|
|
(timer (new timer% [notify-callback timeout-check] [interval 100]))
|
|
)
|
|
(λ (val)
|
|
(set! last-val val)
|
|
(set! last-time (current-milliseconds))
|
|
)))
|
|
|
|
|
|
(define (simple-row-formatter row)
|
|
(map (λ (e) (list 'td (format "~a" e))) row))
|
|
|
|
(define (mktable l table-class row-formatter)
|
|
(xexpr->string
|
|
(append
|
|
(list 'table (list (list 'class (format "~a" table-class))))
|
|
(map (λ (row)
|
|
(let ((row-id (car row)))
|
|
(append (list 'tr (list (list 'id (format "~a" row-id))))
|
|
(row-formatter (cdr row)))))
|
|
l)
|
|
)
|
|
)
|
|
)
|
|
|
|
|
|
|