37 lines
1.1 KiB
Scheme
37 lines
1.1 KiB
Scheme
;;; -*-Scheme-*-
|
|
;;;
|
|
;;; Trivial text widget demo (the text widget isn't fully supported
|
|
;;; by Elk)
|
|
|
|
(require 'xaw)
|
|
|
|
(define top (application-initialize 'text))
|
|
|
|
(define box (create-managed-widget (find-class 'box) top))
|
|
|
|
(define lab (create-managed-widget (find-class 'label) box))
|
|
(set-values! lab 'border-width 0 'label "Enter a number:")
|
|
|
|
(define txt (create-managed-widget (find-class 'ascii-text) box))
|
|
(set-values! txt 'edit-type 'edit 'resize 'width)
|
|
|
|
(define can (create-managed-widget (find-class 'command) box))
|
|
(set-values! can 'label "CANCEL")
|
|
(add-callback can 'callback (lambda foo (exit)))
|
|
|
|
(define acc (create-managed-widget (find-class 'command) box))
|
|
(set-values! acc 'label "ACCEPT")
|
|
(add-callback acc 'callback
|
|
(lambda foo
|
|
(let ((s (ascii-text-string txt)))
|
|
(if (not (number-string? s))
|
|
(format #t "~s is not a number!~%" s)
|
|
(format #t "Result is ~a~%" s)
|
|
(exit)))))
|
|
|
|
(define (number-string? s)
|
|
(not (or (eqv? s "") (memq #f (map char-numeric? (string->list s))))))
|
|
|
|
(realize-widget top)
|
|
(context-main-loop (widget-context top))
|