1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
|
;;; -*-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 top (application-initialize 'scrollbox))
(define dpy (widget-display top))
(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 (widget-context top))
|
