;;; -*-Scheme-*-
;;;
;;; Scroll box demo

(require 'xwidgets)
(load-widgets shell command box label)

(define items (list 'Helvetica 'Courier 'Times 'Palatino 'Zapf\ Chancery 'Zapf\ Dingbats))
(set-cdr! (last-pair items) items)

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

(define dia-bits "\0\0\100\0\340\0\360\1\370\3\374\7\376\17\374\7\370\3\360\1\340\0\100\0\0\0")
(define dia (create-bitmap-from-data (display-root-window dpy) dia-bits 13 13))

(define box (create-managed-widget (find-class 'box) top))
(set-values! box 'width 200)

(define button (create-managed-widget (find-class 'command) box))
(set-values! button 'bitmap dia)

(define label (create-managed-widget (find-class 'label) box))
(set-values! label 'width 130 'label (car items) 'resize #f 'justify 'left
                   'font (open-font dpy "*courier-bold-r-normal--14*"))
(add-callback button 'callback
  (lambda (w)
    (set! items (cdr items))
    (set-values! label 'label (car items))))

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