38 lines
1.1 KiB
Racket
38 lines
1.1 KiB
Racket
#lang racket/base
|
|
(require ffi/unsafe
|
|
racket/class
|
|
"../../syntax.rkt"
|
|
"button.rkt"
|
|
"utils.rkt"
|
|
"types.rkt"
|
|
"../../lock.rkt")
|
|
|
|
(provide
|
|
(protect-out check-box%))
|
|
|
|
;; ----------------------------------------
|
|
|
|
(define-gtk gtk_check_button_new_with_mnemonic (_fun _string -> _GtkWidget))
|
|
(define-gtk gtk_check_button_new (_fun -> _GtkWidget))
|
|
(define-gtk gtk_toggle_button_get_active (_fun _GtkWidget -> _gboolean))
|
|
(define-gtk gtk_toggle_button_set_active (_fun _GtkWidget _gboolean -> _void))
|
|
|
|
(defclass check-box% button-core%
|
|
(super-new [gtk_new_with_mnemonic gtk_check_button_new_with_mnemonic]
|
|
[gtk_new gtk_check_button_new]
|
|
[event-type 'check-box])
|
|
(inherit get-gtk)
|
|
|
|
(define/public (set-value v)
|
|
(atomically
|
|
(set! no-clicked? #t)
|
|
(gtk_toggle_button_set_active (get-gtk) v)
|
|
(set! no-clicked? #f)))
|
|
|
|
(define no-clicked? #f)
|
|
(define/override (queue-clicked)
|
|
(unless no-clicked? (super queue-clicked)))
|
|
|
|
(define/public (get-value)
|
|
(gtk_toggle_button_get_active (get-gtk))))
|