36 lines
918 B
Scheme
36 lines
918 B
Scheme
;;; -*-Scheme-*-
|
|
;;;
|
|
;;; Selection box demo
|
|
|
|
(require 'motif)
|
|
|
|
(define top (application-initialize 'selection))
|
|
|
|
(define sb (create-managed-widget (find-class 'selection-box) top))
|
|
|
|
(define items
|
|
'(montana washington florida california texas new\ york alaska maryland
|
|
idaho virginia maine oregon illinois new\ jersey missouri louisiana))
|
|
|
|
(set-values! sb 'list-items items 'list-item-count (length items))
|
|
(set-values! sb 'list-visible-item-count 6)
|
|
|
|
(set-values! sb 'list-label-string "Available items:" 'must-match #t)
|
|
(set-values! sb 'label-font-list "8x13" 'button-font-list "9x15")
|
|
|
|
(for-each
|
|
(lambda (c)
|
|
(add-callback sb c
|
|
(lambda r
|
|
(case (caadr r)
|
|
(no-match
|
|
(display #\007))
|
|
(help
|
|
(display "No help available!") (newline)))
|
|
(print r))))
|
|
'(apply-callback cancel-callback no-match-callback
|
|
ok-callback help-callback))
|
|
|
|
(realize-widget top)
|
|
(context-main-loop (widget-context top))
|