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