Use `->subsumptive' for some character definitions.
[chise/xemacs-chise.git.1] / tests / glyph-test.el
1 (set-extent-begin-glyph 
2  (make-extent (point) (point))
3  (setq im (make-glyph [xbm :file "xemacsicon.xbm"])))
4
5 (set-extent-begin-glyph 
6  (make-extent (point) (point))
7  (make-glyph [string :data "xemacs"]))
8
9 (defun foo ()
10   (interactive)
11   (setq ok-select (not ok-select)))
12
13 (defun fee () (interactive) (message "hello"))
14
15 ;; button in a group
16 (setq ok-select nil)
17 (set-extent-begin-glyph 
18  (make-extent (point) (point))
19  (make-glyph 
20   (setq radio-button1 
21         [button :face widget
22                 :descriptor ["ok1" (setq ok-select t)
23                              :style radio :selected ok-select]])))
24 ;; button in a group
25 (set-extent-begin-glyph 
26  (make-extent (point) (point))
27  (make-glyph 
28   (setq radio-button2
29         [button :descriptor ["ok2" (setq ok-select nil) :style radio 
30                              :selected (not ok-select)]])))
31 ;; toggle button
32 (set-extent-begin-glyph 
33  (make-extent (point) (point))
34  (setq tbutton
35        (make-glyph [button :descriptor ["ok3" (setq ok-select nil) 
36                                         :style toggle 
37                                         :selected (not ok-select)]])))
38 (set-extent-begin-glyph 
39  (make-extent (point) (point))
40  (make-glyph 
41   (setq toggle-button
42         [button :descriptor ["ok4" :style toggle 
43                              :callback 
44                              (setq ok-select (not ok-select))
45                              :selected ok-select]])))
46
47 ;; normal pushbutton
48 (set-extent-begin-glyph 
49  (make-extent (point) (point))
50  (setq push-button 
51        (make-glyph [button :width 10 :height 2
52                            :face modeline-mousable
53                            :descriptor "ok" :callback foo
54                            :selected t])))
55 ;; tree view
56 (set-extent-begin-glyph 
57  (make-extent (point) (point))
58  (setq tree (make-glyph 
59              [tree-view :width 10
60                         :descriptor "My Tree"
61                         :items (["One" foo]
62                                 (["Two" foo]
63                                  ["Four" foo]
64                                  "Six")
65                                 "Three")])))
66
67 ;; tab control
68 (set-extent-begin-glyph 
69  (make-extent (point) (point))
70  (setq tab (make-glyph 
71             [tab-control :descriptor "My Tab"
72                          :face highlight
73                          :orientation right
74                          :items (["One" foo :selected t]
75                                  ["Two" fee :selected nil]
76                                  ["Three" foo :selected nil])])))
77
78 ;; progress gauge
79 (set-extent-begin-glyph 
80  (make-extent (point) (point))
81  (setq pgauge (make-glyph 
82                [progress-gauge :width 10 :height 2 :value 0
83                                :descriptor "ok"])))
84 ;; progress the progress ...
85 (let ((x 0))
86   (while (<= x 100)
87     (set-glyph-image pgauge `[progress-gauge :width 10 :height 2
88                                              :descriptor "ok" :value ,x])
89     (setq x (+ x 5))
90     (sit-for 0.1)))
91
92 ;; progress gauge in the modeline
93 (setq global-mode-string 
94       (cons (make-extent nil nil)
95             (setq pg (make-glyph 
96                       [progress-gauge :width 5 :pixel-height 16
97                                       :descriptor "ok"]))))
98 ;; progress the progress ...
99 (let ((x 0))
100   (while (<= x 100)
101     (set-glyph-image pg
102                      `[progress-gauge :width 5 :pixel-height 16
103                                       :descriptor "ok" :value ,x])
104     (setq x (+ x 5))
105     (redisplay-frame)
106     (sit-for 0.1)))
107
108 (set-extent-begin-glyph 
109  (make-extent (point) (point))
110  (make-glyph 
111   [button :face modeline-mousable
112           :descriptor "ok" :callback foo
113           :image [xpm :file "../etc/xemacs-icon.xpm"]]))
114
115 ;; normal pushbutton
116 (set-extent-begin-glyph 
117  (make-extent (point) (point))
118  (setq pbutton
119        (make-glyph [button :descriptor ["A Big Button" foo ]])))
120
121 ;; edit box
122 (set-extent-begin-glyph 
123  (make-extent (point) (point)) 
124  (make-glyph (setq edit-field [edit-field :pixel-width 50 :pixel-height 30
125                                           :face bold-italic
126                                           :descriptor ["Hello"]])))
127 ;; combo box
128 (set-extent-begin-glyph 
129  (make-extent (point) (point))
130  (make-glyph (setq combo-box
131                    [combo-box :width 10 :descriptor ["Hello"] 
132                               :items ("One" "Two" "Three")])))
133
134 ;; label
135 (set-extent-begin-glyph 
136  (make-extent (point) (point))
137  (make-glyph (setq label [label :pixel-width 150 :descriptor "Hello"])))
138
139 ;; string
140 (set-extent-begin-glyph 
141  (make-extent (point) (point))
142  (make-glyph 
143   (setq str
144         [string :data "Hello There"])))
145
146 ;; scrollbar
147 ;(set-extent-begin-glyph 
148 ; (make-extent (point) (point))
149 ; (make-glyph [scrollbar :width 50 :height 20 :descriptor ["Hello"]]))
150
151 ;; generic subwindow
152 (setq sw (make-glyph [subwindow :pixel-width 50 :pixel-height 70]))
153 (set-extent-begin-glyph (make-extent (point) (point)) sw)
154
155 ;; layout
156 (setq layout 
157       (make-glyph
158        `[layout :descriptor "The Layout"
159                 :orientation vertical
160                 :justify left
161                 :border [string :data "Hello There Mrs"]
162                 :items ([layout :orientation horizontal
163                                 :items (,radio-button1 ,radio-button2)]
164                         ,edit-field ,toggle-button ,label ,str)]))
165 ;(set-glyph-face layout 'gui-element)
166 (set-extent-begin-glyph
167  (make-extent (point) (point)) layout)
168
169 ;; another test layout
170 (set-extent-begin-glyph
171  (make-extent (point) (point)) 
172  (setq layout-2
173        (make-glyph `[layout :descriptor "The Layout"
174                             :orientation vertical
175                             :items ([progress-gauge :value 0 :width 10 :height 2
176                                                     :descriptor "ok"])])))
177
178 (set-glyph-image layout-2 `[layout :descriptor "The Layout"
179                                    :orientation vertical
180                                    :items ([progress-gauge :value 4 :width 10 :height 2
181                                                            :descriptor "ok"])])
182 (setq test-toggle-widget nil)
183         
184 (defun test-toggle (widget)
185   (set-extent-begin-glyph 
186    (make-extent (point) (point))
187    (make-glyph (vector 'button
188                        :descriptor "ok"
189                        :style 'toggle
190                        :selected `(funcall test-toggle-value
191                                            ,widget)
192                        :callback `(funcall test-toggle-action
193                                            ,widget)))))
194
195 (defun test-toggle-action (widget &optional event)
196   (if widget
197       (message "Widget is t")
198     (message "Widget is nil")))
199
200 (defun test-toggle-value (widget)
201   (setq widget (not widget))
202   (not widget))