428
|
1 (set-extent-begin-glyph
|
|
2 (make-extent (point) (point))
|
442
|
3 (setq im (make-glyph [xbm :file "xemacsicon.xbm"])))
|
428
|
4
|
438
|
5 (set-extent-begin-glyph
|
|
6 (make-extent (point) (point))
|
|
7 (make-glyph [string :data "xemacs"]))
|
|
8
|
428
|
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))
|
442
|
19 (make-glyph
|
|
20 (setq radio-button1
|
|
21 [button :face widget
|
|
22 :descriptor ["ok1" (setq ok-select t)
|
428
|
23 :style radio :selected ok-select]])))
|
|
24 ;; button in a group
|
|
25 (set-extent-begin-glyph
|
|
26 (make-extent (point) (point))
|
442
|
27 (make-glyph
|
|
28 (setq radio-button2
|
|
29 [button :descriptor ["ok2" (setq ok-select nil) :style radio
|
428
|
30 :selected (not ok-select)]])))
|
|
31 ;; toggle button
|
|
32 (set-extent-begin-glyph
|
|
33 (make-extent (point) (point))
|
|
34 (setq tbutton
|
442
|
35 (make-glyph [button :descriptor ["ok3" (setq ok-select nil)
|
428
|
36 :style toggle
|
|
37 :selected (not ok-select)]])))
|
|
38 (set-extent-begin-glyph
|
|
39 (make-extent (point) (point))
|
442
|
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]])))
|
428
|
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
|
442
|
53 :descriptor "ok" :callback foo
|
428
|
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"
|
442
|
61 :items (["One" foo]
|
|
62 (["Two" foo]
|
|
63 ["Four" foo]
|
|
64 "Six")
|
|
65 "Three")])))
|
428
|
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
|
438
|
73 :orientation right
|
442
|
74 :items (["One" foo :selected t]
|
|
75 ["Two" fee :selected nil]
|
|
76 ["Three" foo :selected nil])])))
|
428
|
77
|
|
78 ;; progress gauge
|
|
79 (set-extent-begin-glyph
|
|
80 (make-extent (point) (point))
|
|
81 (setq pgauge (make-glyph
|
442
|
82 [progress-gauge :width 10 :height 2 :value 0
|
428
|
83 :descriptor "ok"])))
|
|
84 ;; progress the progress ...
|
|
85 (let ((x 0))
|
|
86 (while (<= x 100)
|
442
|
87 (set-glyph-image pgauge `[progress-gauge :width 10 :height 2
|
|
88 :descriptor "ok" :value ,x])
|
428
|
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)
|
442
|
101 (set-glyph-image pg
|
|
102 `[progress-gauge :width 5 :pixel-height 16
|
|
103 :descriptor "ok" :value ,x])
|
428
|
104 (setq x (+ x 5))
|
|
105 (sit-for 0.1)))
|
|
106
|
|
107 (set-extent-begin-glyph
|
|
108 (make-extent (point) (point))
|
|
109 (make-glyph
|
|
110 [button :face modeline-mousable
|
|
111 :descriptor "ok" :callback foo
|
|
112 :image [xpm :file "../etc/xemacs-icon.xpm"]]))
|
|
113
|
|
114 ;; normal pushbutton
|
|
115 (set-extent-begin-glyph
|
|
116 (make-extent (point) (point))
|
438
|
117 (setq pbutton
|
|
118 (make-glyph [button :descriptor ["A Big Button" foo ]])))
|
428
|
119
|
|
120 ;; edit box
|
|
121 (set-extent-begin-glyph
|
|
122 (make-extent (point) (point))
|
442
|
123 (make-glyph (setq edit-field [edit-field :pixel-width 50 :pixel-height 30
|
428
|
124 :face bold-italic
|
|
125 :descriptor ["Hello"]])))
|
|
126 ;; combo box
|
|
127 (set-extent-begin-glyph
|
|
128 (make-extent (point) (point))
|
442
|
129 (make-glyph (setq combo-box
|
|
130 [combo-box :width 10 :descriptor ["Hello"]
|
|
131 :items ("One" "Two" "Three")])))
|
428
|
132
|
|
133 ;; label
|
|
134 (set-extent-begin-glyph
|
|
135 (make-extent (point) (point))
|
442
|
136 (make-glyph (setq label [label :pixel-width 150 :descriptor "Hello"])))
|
428
|
137
|
|
138 ;; string
|
|
139 (set-extent-begin-glyph
|
|
140 (make-extent (point) (point))
|
442
|
141 (make-glyph
|
|
142 (setq str
|
|
143 [string :data "Hello There"])))
|
428
|
144
|
|
145 ;; scrollbar
|
|
146 ;(set-extent-begin-glyph
|
|
147 ; (make-extent (point) (point))
|
|
148 ; (make-glyph [scrollbar :width 50 :height 20 :descriptor ["Hello"]]))
|
|
149
|
|
150 ;; generic subwindow
|
|
151 (setq sw (make-glyph [subwindow :pixel-width 50 :pixel-height 70]))
|
|
152 (set-extent-begin-glyph (make-extent (point) (point)) sw)
|
|
153
|
|
154 ;; layout
|
|
155 (setq layout
|
|
156 (make-glyph
|
442
|
157 `[layout :descriptor "The Layout"
|
|
158 :orientation vertical
|
|
159 :justify left
|
|
160 :border [string :data "Hello There Mrs"]
|
|
161 :items ([layout :orientation horizontal
|
|
162 :items (,radio-button1 ,radio-button2)]
|
|
163 ,edit-field ,toggle-button ,label ,str)]))
|
|
164 ;(set-glyph-face layout 'gui-element)
|
428
|
165 (set-extent-begin-glyph
|
|
166 (make-extent (point) (point)) layout)
|
434
|
167
|
442
|
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"])])
|
434
|
181 (setq test-toggle-widget nil)
|
|
182
|
|
183 (defun test-toggle (widget)
|
|
184 (set-extent-begin-glyph
|
|
185 (make-extent (point) (point))
|
|
186 (make-glyph (vector 'button
|
|
187 :descriptor "ok"
|
|
188 :style 'toggle
|
|
189 :selected `(funcall test-toggle-value
|
|
190 ,widget)
|
|
191 :callback `(funcall test-toggle-action
|
|
192 ,widget)))))
|
|
193
|
|
194 (defun test-toggle-action (widget &optional event)
|
|
195 (if widget
|
|
196 (message "Widget is t")
|
|
197 (message "Widget is nil")))
|
|
198
|
|
199 (defun test-toggle-value (widget)
|
|
200 (setq widget (not widget))
|
|
201 (not widget))
|