;;; -*-Scheme-*-
;;;
;;; List widget demo

(require 'xwidgets)
(set! widget-load-path '(xhp xaw))
(load-widgets bboard list pbutton shell stext)

(define con (create-context))
(define dpy (initialize-display con #f 'list 'demo))
(define top (create-shell 'list 'demo (find-class 'application-shell) dpy))

(define bb (create-managed-widget (find-class 'bboard) top))

(define lst (create-managed-widget (find-class 'list) bb 'num-columns 3))
(set-values! lst 'x 0 'y 130 'column-width 60 'element-highlight "invert"
	         'element-height 21)

(define instant #t)
(define p1 (create-managed-widget (find-class 'push-button) bb))
(set-values! p1 'x 10 'y 10 'label "selection-style: instant")
(add-callback p1 'release
  (lambda r
    (set-values! p1 'label
      (if instant "selection-style: sticky" "selection-style: instant"))
    (set! instant (not instant))
    (set-values! lst 'selection-style (if instant "instant" "sticky"))))

(define single #t)
(define p2 (create-managed-widget (find-class 'push-button) bb))
(set-values! p2 'x 10 'y 40 'label "selection-method: single")
(add-callback p2 'release
  (lambda r
    (set-values! p2 'label
      (if single "selection-method: multiple" "selection-method: single"))
    (set! single (not single))
    (set-values! lst 'selection-method (if single "single" "multiple"))))

(define biases '(no_bias row_bias col_bias))
(define bias 0)
(define p3 (create-managed-widget (find-class 'push-button) bb))
(set-values! p3 'x 10 'y 70 'label "selection-bias: none")
(add-callback p3 'release
  (lambda r
    (set! bias (1+ bias)) (set! bias (modulo bias 3))
    (set-values! p3 'label
      (format #f "selection-bias: ~s" (list-ref biases bias)))
    (set-values! lst 'selection-bias (list-ref biases bias))))

(define invert #t)
(define p4 (create-managed-widget (find-class 'push-button) bb))
(set-values! p4 'x 10 'y 100 'label "element-highlight: invert")
(add-callback p4 'release
  (lambda r
    (set-values! p4 'label
      (if invert "element-highlight: border" "element-highlight: invert"))
    (set! invert (not invert))
    (set-values! lst 'element-highlight (if invert "invert" "border"))))

(define p5 (create-managed-widget (find-class 'push-button) bb))
(set-values! p5 'x 250 'y 10 'label 'QUIT)
(add-callback p5 'release (lambda r (exit)))

(do ((i 0 (1+ i))) ((= i 80))
  (define w (create-managed-widget (find-class 'static-text) lst
				   'string (format #f "item ~s" i)))
  (set-values! w 'highlight-thickness 2)
  (add-callback w 'select
    (lambda (w) (format #t "selected ~s~%" (car (get-values w 'string))))))

(realize-widget top)
(context-main-loop con)