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