Permalink
Fetching contributors…
Cannot retrieve contributors at this time
99 lines (93 sloc) 4.19 KB
(require :tk-gui)
(use-package :tk-gui)
(define context (make-context :withdraw-toplevel #t))
(define window (make-window context))
(window-on-delete window
(lambda (window)
(when (string=? (message-box context
:message "Really quit?"
:type "yesno"
:icon "question")
"yes")
(destroy-window! window))))
(window-title window "tk-gui demo")
(define-widgets window
(<entry> ()
:grid (:row 0 :column 0)
:variable entry)
(:button (:text "The Button")
:grid (:row 0 :column 1)
:events ((:command
(lambda ()
(message-box context
:message
(format "Value is: ~s"
(get-value entry)))))))
(:button (:text "Second Button" :bg "red")
:grid (:row 0 :column 2)
:events ((:command
(lambda ()
(set-value! entry "Foo")))))
(<check-button> (:text "Check-button")
:grid (:row 1 :column 0)
:variable check)
(:button (:text "Value?")
:grid (:row 1 :column 1)
:events ((:command
(lambda ()
(message-box context
:message (if (get-value check)
"Checkbox is checked"
"Checkbox is lonely"))))))
(:button (:text "Flash")
:grid (:row 1 :column 2)
:events ((:command (lambda () (flash-button! check)))))
(:frame () :grid (:row 2 :column 0 :columnspan 3)
:contents
((:button (:text "Button dialog") :pack ()
:events ((:command
(lambda ()
(button-dialog context
'("Nyaa" "Nyuu" "Nyan" "Knik" "Uguu")
:title "foo?"
:text "Neko?")))))
(:button (:text "Open dialog") :pack ()
:events ((:command
(lambda ()
(open-dialog context)))))
(:button (:text "Color dialog") :pack ()
:events ((:command
(lambda ()
(color-dialog context)))))))
(:frame () :grid (:row 3 :column 0)
:contents
((<radio-button> (band "HF" :text "HF") :pack ())
(<radio-button> (band "VHF" :text "VHF") :pack ())
(<radio-button> (band "UHF" :text "UHF") :pack ())))
(:frame () :grid (:row 3 :column 1)
:contents
((<radio-button> (band "Ka" :text "Ka") :pack ())
(<radio-button> (band "K" :text "K") :pack ())
(<radio-button> (band "Ku" :text "Ku") :pack ())))
(:button (:text "Tx") :grid (:row 3 :column 2)
:events ((:command
(lambda ()
(message-box context
:message (format "Tx at ~a"
(get-value band)))))))
(<list-box> () :grid (:row 4 :column 0 :columnspan 2 :rowspan 2)
:variable lbox)
(:button (:text "Selection") :grid (:row 4 :column 2)
:events ((:command
(lambda ()
(message-box context
:message (format "Selection: ~a"
(get-selection lbox)))))))
(:button (:text "Value") :grid (:row 5 :column 2)
:events ((:command
(lambda ()
(message-box context
:message (format "Value: ~a"
(get-value lbox))))))))
(list-box-insert lbox 0 "foo" "bar" "baz" "quux")
(wait-for-window window)