1#lang racket/base 2(require ffi/unsafe 3 racket/class 4 "../../syntax.rkt" 5 "button.rkt" 6 "utils.rkt" 7 "types.rkt" 8 "../../lock.rkt") 9 10(provide 11 (protect-out check-box%)) 12 13;; ---------------------------------------- 14 15(define-gtk gtk_check_button_new_with_mnemonic (_fun _string -> _GtkWidget)) 16(define-gtk gtk_check_button_new (_fun -> _GtkWidget)) 17(define-gtk gtk_toggle_button_get_active (_fun _GtkWidget -> _gboolean)) 18(define-gtk gtk_toggle_button_set_active (_fun _GtkWidget _gboolean -> _void)) 19 20(defclass check-box% button-core% 21 (super-new [gtk_new_with_mnemonic gtk_check_button_new_with_mnemonic] 22 [gtk_new gtk_check_button_new] 23 [event-type 'check-box]) 24 (inherit get-gtk) 25 26 (define/public (set-value v) 27 (atomically 28 (set! no-clicked? #t) 29 (gtk_toggle_button_set_active (get-gtk) v) 30 (set! no-clicked? #f))) 31 32 (define no-clicked? #f) 33 (define/override (queue-clicked) 34 (unless no-clicked? (super queue-clicked))) 35 36 (define/public (get-value) 37 (gtk_toggle_button_get_active (get-gtk)))) 38