29 lines
852 B
Racket
29 lines
852 B
Racket
#lang racket/base
|
|
(require racket/gui/base
|
|
racket/class)
|
|
(provide (except-out (all-from-out racket/gui/base) frame%)
|
|
(rename-out [registering-frame% frame%])
|
|
lookup-frame-name)
|
|
|
|
(define (lookup-frame-name frame)
|
|
(semaphore-wait label-sema)
|
|
(begin0
|
|
(hash-ref label-ht frame (λ () #f))
|
|
(semaphore-post label-sema)))
|
|
|
|
(define label-sema (make-semaphore 1))
|
|
(define label-ht (make-weak-hasheq))
|
|
|
|
(define registering-frame%
|
|
(class frame%
|
|
(define/override (set-label x)
|
|
(semaphore-wait label-sema)
|
|
(hash-set! label-ht this x)
|
|
(semaphore-post label-sema)
|
|
(super set-label x))
|
|
(inherit get-label)
|
|
(super-instantiate ())
|
|
(semaphore-wait label-sema)
|
|
(hash-set! label-ht this (get-label))
|
|
(semaphore-post label-sema)))
|