Mercurial > hg > xemacs-beta

comparison tests/glyph-test.el @ 442:abe6d1db359e r21-2-36

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-36
author cvs
date Mon, 13 Aug 2007 11:35:02 +0200
parents 84b14dcb0985
children 0784d089fdc9
comparison
equal deleted inserted replaced
441:72a7cfa4a488 442:abe6d1db359e
1 (set-extent-begin-glyph 1 (set-extent-begin-glyph
2 (make-extent (point) (point)) 2 (make-extent (point) (point))
3 (setq im (make-glyph [xpm :file "xemacs-icon.xpm"]))) 3 (setq im (make-glyph [xbm :file "xemacsicon.xbm"])))
4 4
5 (set-extent-begin-glyph 5 (set-extent-begin-glyph
6 (make-extent (point) (point)) 6 (make-extent (point) (point))
7 (make-glyph [string :data "xemacs"])) 7 (make-glyph [string :data "xemacs"]))
8 8
14 14
15 ;; button in a group 15 ;; button in a group
16 (setq ok-select nil) 16 (setq ok-select nil)
17 (set-extent-begin-glyph 17 (set-extent-begin-glyph
18 (make-extent (point) (point)) 18 (make-extent (point) (point))
19 (setq radio-button1 19 (make-glyph
20 (make-glyph 20 (setq radio-button1
21 [button :descriptor ["ok " (setq ok-select t) 21 [button :face widget
22 :descriptor ["ok1" (setq ok-select t)
22 :style radio :selected ok-select]]))) 23 :style radio :selected ok-select]])))
23 ;; button in a group 24 ;; button in a group
24 (set-extent-begin-glyph 25 (set-extent-begin-glyph
25 (make-extent (point) (point)) 26 (make-extent (point) (point))
26 (setq radio-button2 27 (make-glyph
27 (make-glyph 28 (setq radio-button2
28 [button :descriptor ["ok" (setq ok-select nil) :style radio 29 [button :descriptor ["ok2" (setq ok-select nil) :style radio
29 :selected (not ok-select)]]))) 30 :selected (not ok-select)]])))
30 ;; toggle button 31 ;; toggle button
31 (set-extent-begin-glyph 32 (set-extent-begin-glyph
32 (make-extent (point) (point)) 33 (make-extent (point) (point))
33 (setq tbutton 34 (setq tbutton
34 (make-glyph [button :descriptor ["ok" (setq ok-select nil) 35 (make-glyph [button :descriptor ["ok3" (setq ok-select nil)
35 :style toggle 36 :style toggle
36 :selected (not ok-select)]]))) 37 :selected (not ok-select)]])))
37 (set-extent-begin-glyph 38 (set-extent-begin-glyph
38 (make-extent (point) (point)) 39 (make-extent (point) (point))
39 (setq toggle-button 40 (make-glyph
40 (make-glyph [button :descriptor ["ok" :style toggle 41 (setq toggle-button
41 :callback 42 [button :descriptor ["ok4" :style toggle
42 (setq ok-select (not ok-select)) 43 :callback
43 :selected ok-select]]))) 44 (setq ok-select (not ok-select))
45 :selected ok-select]])))
44 46
45 ;; normal pushbutton 47 ;; normal pushbutton
46 (set-extent-begin-glyph 48 (set-extent-begin-glyph
47 (make-extent (point) (point)) 49 (make-extent (point) (point))
48 (setq push-button 50 (setq push-button
49 (make-glyph [button :width 10 :height 2 51 (make-glyph [button :width 10 :height 2
50 :face modeline-mousable 52 :face modeline-mousable
51 :descriptor "ok" :callback foo 53 :descriptor "ok" :callback foo
52 :selected t]))) 54 :selected t])))
53 ;; tree view 55 ;; tree view
54 (set-extent-begin-glyph 56 (set-extent-begin-glyph
55 (make-extent (point) (point)) 57 (make-extent (point) (point))
56 (setq tree (make-glyph 58 (setq tree (make-glyph
57 [tree-view :width 10 59 [tree-view :width 10
58 :descriptor "My Tree" 60 :descriptor "My Tree"
59 :properties (:items (["One" foo] 61 :items (["One" foo]
60 (["Two" foo] 62 (["Two" foo]
61 ["Four" foo] 63 ["Four" foo]
62 "Six") 64 "Six")
63 "Three"))]))) 65 "Three")])))
64 66
65 ;; tab control 67 ;; tab control
66 (set-extent-begin-glyph 68 (set-extent-begin-glyph
67 (make-extent (point) (point)) 69 (make-extent (point) (point))
68 (setq tab (make-glyph 70 (setq tab (make-glyph
69 [tab-control :descriptor "My Tab" 71 [tab-control :descriptor "My Tab"
70 :face highlight 72 :face highlight
71 :orientation right 73 :orientation right
72 :properties (:items (["One" foo] 74 :items (["One" foo :selected t]
73 ["Two" fee] 75 ["Two" fee :selected nil]
74 ["Three" foo]))]))) 76 ["Three" foo :selected nil])])))
75 77
76 ;; progress gauge 78 ;; progress gauge
77 (set-extent-begin-glyph 79 (set-extent-begin-glyph
78 (make-extent (point) (point)) 80 (make-extent (point) (point))
79 (setq pgauge (make-glyph 81 (setq pgauge (make-glyph
80 [progress-gauge :width 10 :height 2 82 [progress-gauge :width 10 :height 2 :value 0
81 :descriptor "ok"]))) 83 :descriptor "ok"])))
82 ;; progress the progress ... 84 ;; progress the progress ...
83 (let ((x 0)) 85 (let ((x 0))
84 (while (<= x 100) 86 (while (<= x 100)
85 (set-image-instance-property (glyph-image-instance pgauge) :percent x) 87 (set-glyph-image pgauge `[progress-gauge :width 10 :height 2
88 :descriptor "ok" :value ,x])
86 (setq x (+ x 5)) 89 (setq x (+ x 5))
87 (sit-for 0.1))) 90 (sit-for 0.1)))
88 91
89 ;; progress gauge in the modeline 92 ;; progress gauge in the modeline
90 (setq global-mode-string 93 (setq global-mode-string
93 [progress-gauge :width 5 :pixel-height 16 96 [progress-gauge :width 5 :pixel-height 16
94 :descriptor "ok"])))) 97 :descriptor "ok"]))))
95 ;; progress the progress ... 98 ;; progress the progress ...
96 (let ((x 0)) 99 (let ((x 0))
97 (while (<= x 100) 100 (while (<= x 100)
98 (set-image-instance-property (glyph-image-instance pg) :percent x) 101 (set-glyph-image pg
102 `[progress-gauge :width 5 :pixel-height 16
103 :descriptor "ok" :value ,x])
99 (setq x (+ x 5)) 104 (setq x (+ x 5))
100 (sit-for 0.1))) 105 (sit-for 0.1)))
101 106
102 (set-extent-begin-glyph 107 (set-extent-begin-glyph
103 (make-extent (point) (point)) 108 (make-extent (point) (point))
113 (make-glyph [button :descriptor ["A Big Button" foo ]]))) 118 (make-glyph [button :descriptor ["A Big Button" foo ]])))
114 119
115 ;; edit box 120 ;; edit box
116 (set-extent-begin-glyph 121 (set-extent-begin-glyph
117 (make-extent (point) (point)) 122 (make-extent (point) (point))
118 (setq edit-field (make-glyph [edit-field :pixel-width 50 :pixel-height 30 123 (make-glyph (setq edit-field [edit-field :pixel-width 50 :pixel-height 30
119 :face bold-italic 124 :face bold-italic
120 :descriptor ["Hello"]]))) 125 :descriptor ["Hello"]])))
121 ;; combo box 126 ;; combo box
122 (set-extent-begin-glyph 127 (set-extent-begin-glyph
123 (make-extent (point) (point)) 128 (make-extent (point) (point))
124 (setq combo-box (make-glyph 129 (make-glyph (setq combo-box
125 [combo-box :width 10 :descriptor ["Hello"] 130 [combo-box :width 10 :descriptor ["Hello"]
126 :properties (:items ("One" "Two" "Three"))]))) 131 :items ("One" "Two" "Three")])))
127 132
128 ;; label 133 ;; label
129 (set-extent-begin-glyph 134 (set-extent-begin-glyph
130 (make-extent (point) (point)) 135 (make-extent (point) (point))
131 (setq label (make-glyph [label :pixel-width 150 :descriptor "Hello"]))) 136 (make-glyph (setq label [label :pixel-width 150 :descriptor "Hello"])))
132 137
133 ;; string 138 ;; string
134 (set-extent-begin-glyph 139 (set-extent-begin-glyph
135 (make-extent (point) (point)) 140 (make-extent (point) (point))
136 (setq str (make-glyph [string :data "Hello There"]))) 141 (make-glyph
142 (setq str
143 [string :data "Hello There"])))
137 144
138 ;; scrollbar 145 ;; scrollbar
139 ;(set-extent-begin-glyph 146 ;(set-extent-begin-glyph
140 ; (make-extent (point) (point)) 147 ; (make-extent (point) (point))
141 ; (make-glyph [scrollbar :width 50 :height 20 :descriptor ["Hello"]])) 148 ; (make-glyph [scrollbar :width 50 :height 20 :descriptor ["Hello"]]))
145 (set-extent-begin-glyph (make-extent (point) (point)) sw) 152 (set-extent-begin-glyph (make-extent (point) (point)) sw)
146 153
147 ;; layout 154 ;; layout
148 (setq layout 155 (setq layout
149 (make-glyph 156 (make-glyph
150 [layout :pixel-width 200 :pixel-height 250 157 `[layout :descriptor "The Layout"
151 :orientation vertical 158 :orientation vertical
152 :justify left 159 :justify left
153 :border [string :data "Hello There Mrs"] 160 :border [string :data "Hello There Mrs"]
154 :items ([layout :orientation horizontal 161 :items ([layout :orientation horizontal
155 :items (radio-button1 radio-button2)] 162 :items (,radio-button1 ,radio-button2)]
156 edit-field toggle-button label str)])) 163 ,edit-field ,toggle-button ,label ,str)]))
157 (set-glyph-face layout 'gui-element) 164 ;(set-glyph-face layout 'gui-element)
158 (set-extent-begin-glyph 165 (set-extent-begin-glyph
159 (make-extent (point) (point)) layout) 166 (make-extent (point) (point)) layout)
160 167
168 ;; another test layout
169 (set-extent-begin-glyph
170 (make-extent (point) (point))
171 (setq layout-2
172 (make-glyph `[layout :descriptor "The Layout"
173 :orientation vertical
174 :items ([progress-gauge :value 0 :width 10 :height 2
175 :descriptor "ok"])])))
176
177 (set-glyph-image layout-2 `[layout :descriptor "The Layout"
178 :orientation vertical
179 :items ([progress-gauge :value 4 :width 10 :height 2
180 :descriptor "ok"])])
161 (setq test-toggle-widget nil) 181 (setq test-toggle-widget nil)
162 182
163 (defun test-toggle (widget) 183 (defun test-toggle (widget)
164 (set-extent-begin-glyph 184 (set-extent-begin-glyph
165 (make-extent (point) (point)) 185 (make-extent (point) (point))