82 lines
2.2 KiB
Racket
82 lines
2.2 KiB
Racket
#lang racket/base
|
|
|
|
(require racket/gui
|
|
xml
|
|
xml/xexpr
|
|
)
|
|
|
|
(provide ww-connect
|
|
make-delayed-reactor
|
|
mktable
|
|
simple-row-formatter
|
|
while
|
|
open-file-manager
|
|
)
|
|
|
|
|
|
(define-syntax while
|
|
(syntax-rules ()
|
|
((_ cond body ...)
|
|
(letrec ((while-f (lambda (last-result)
|
|
(if cond
|
|
(let ((last-result (begin
|
|
body
|
|
...)))
|
|
(while-f last-result))
|
|
last-result))))
|
|
(while-f #f))
|
|
)
|
|
))
|
|
|
|
(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)
|
|
)
|
|
)
|
|
)
|
|
|
|
(define (open-file-manager path)
|
|
(let ((folder (if (path? path) (path->string path) path)))
|
|
(case (system-type 'os)
|
|
[(windows) (process (string-append "explorer.exe " folder))]
|
|
[(macosx) (process (string-append "open " folder))]
|
|
[else (process (string-append "xdg-open " folder))]))
|
|
)
|
|
|