|
462
|
1 (require 'gnome)
|
|
|
2
|
|
|
3 (gtk-define-test
|
|
|
4 "GNOME Stock Pixmaps" gnome gnome-pixmaps nil
|
|
|
5 (let ((hbox nil)
|
|
|
6 (vbox nil)
|
|
|
7 (widget nil)
|
|
|
8 (label nil)
|
|
|
9 (i 0))
|
|
|
10 (mapc (lambda (b)
|
|
|
11 (if (= (% i 5) 0)
|
|
|
12 (progn
|
|
|
13 (setq hbox (gtk-hbutton-box-new))
|
|
|
14 (gtk-box-set-spacing hbox 5)
|
|
|
15 (gtk-container-add window hbox)))
|
|
|
16
|
|
|
17 (setq widget (gnome-stock-pixmap-widget-new window (car b))
|
|
|
18 vbox (gtk-vbox-new t 0)
|
|
|
19 label (gtk-label-new (cdr b)))
|
|
|
20 (gtk-container-add hbox vbox)
|
|
|
21 (gtk-container-add vbox widget)
|
|
|
22 (gtk-container-add vbox label)
|
|
|
23 (gtk-widget-show-all vbox)
|
|
|
24 (setq i (1+ i)))
|
|
|
25 gnome-stock-pixmaps)))
|
|
|
26
|
|
|
27 (gtk-define-test
|
|
|
28 "GNOME Stock Buttons" gnome gnome-buttons nil
|
|
|
29 (let ((hbbox nil)
|
|
|
30 (button nil)
|
|
|
31 (i 0))
|
|
|
32 (mapc (lambda (b)
|
|
|
33 (setq button (gnome-stock-button (car b)))
|
|
|
34 (gtk-signal-connect button 'clicked (lambda (obj data)
|
|
|
35 (message "Stock GNOME Button: %s" data))
|
|
|
36 (cdr b))
|
|
|
37 (if (= (% i 3) 0)
|
|
|
38 (progn
|
|
|
39 (setq hbbox (gtk-hbutton-box-new))
|
|
|
40 (gtk-button-box-set-spacing hbbox 5)
|
|
|
41 (gtk-container-add window hbbox)))
|
|
|
42
|
|
|
43 (gtk-container-add hbbox button)
|
|
|
44 (gtk-widget-show button)
|
|
|
45 (setq i (1+ i)))
|
|
|
46 gnome-stock-buttons)))
|
|
|
47
|
|
|
48 (gtk-define-test
|
|
|
49 "GNOME About" gnome gnome-about t
|
|
|
50 (setq window (gnome-about-new "XEmacs/GTK Test Application"
|
|
|
51 "1.0a"
|
|
|
52 "Copyright (C) 2000 Free Software Foundation"
|
|
|
53 '("William M. Perry <wmperry@gnu.org>"
|
|
|
54 "Ichabod Crane")
|
|
|
55 "This is a comment string... what wonderful commentary you have my dear!"
|
|
|
56 "")))
|
|
|
57
|
|
|
58 (gtk-define-test
|
|
|
59 "GNOME File Entry" gnome gnome-file-entry nil
|
|
|
60 (let ((button (gnome-file-entry-new nil "Test browse dialog...")))
|
|
|
61 (gtk-container-add window button)))
|
|
|
62
|
|
|
63 (gtk-define-test
|
|
|
64 "GNOME Color Picker" gnome gnome-color-picker nil
|
|
|
65 (let ((picker (gnome-color-picker-new))
|
|
|
66 (hbox (gtk-hbox-new nil 0))
|
|
|
67 (label (gtk-label-new "Please choose a color: ")))
|
|
|
68
|
|
|
69 (gtk-box-pack-start hbox label nil nil 2)
|
|
|
70 (gtk-box-pack-start hbox picker t t 2)
|
|
|
71 (gtk-container-add window hbox)
|
|
|
72 (gtk-widget-show-all hbox)))
|
|
|
73
|
|
|
74 (gtk-define-test
|
|
|
75 "GNOME Desktop Entry Editor" gnome gnome-dentry-edit nil
|
|
|
76 (let* ((notebook (gtk-notebook-new)))
|
|
|
77 (gnome-dentry-edit-new-notebook notebook)
|
|
|
78 (gtk-container-add window notebook)))
|
|
|
79
|
|
|
80 (gtk-define-test
|
|
|
81 "GNOME Date Edit" gnome gnome-date-entry nil
|
|
|
82 (let ((date (gnome-date-edit-new 0 t t))
|
|
|
83 button)
|
|
|
84 (gtk-box-pack-start window date t t 0)
|
|
|
85
|
|
|
86 (setq button (gtk-check-button-new-with-label "Show time"))
|
|
|
87 (gtk-signal-connect button 'clicked
|
|
|
88 (lambda (button date)
|
|
|
89 (let ((flags (gnome-date-edit-get-flags date)))
|
|
|
90 (if (gtk-toggle-button-get-active button)
|
|
|
91 (push 'show-time flags)
|
|
|
92 (setq flags (delq 'show-time flags)))
|
|
|
93 (gnome-date-edit-set-flags date flags))) date)
|
|
|
94 (gtk-toggle-button-set-active button t)
|
|
|
95 (gtk-box-pack-start window button nil nil 0)
|
|
|
96
|
|
|
97 (setq button (gtk-check-button-new-with-label "24 Hour format"))
|
|
|
98 (gtk-signal-connect button 'clicked
|
|
|
99 (lambda (button date)
|
|
|
100 (let ((flags (gnome-date-edit-get-flags date)))
|
|
|
101 (if (gtk-toggle-button-get-active button)
|
|
|
102 (push '24-hr flags)
|
|
|
103 (setq flags (delq '24-hr flags)))
|
|
|
104 (gnome-date-edit-set-flags date flags))) date)
|
|
|
105 (gtk-toggle-button-set-active button t)
|
|
|
106 (gtk-box-pack-start window button nil nil 0)
|
|
|
107
|
|
|
108 (setq button (gtk-check-button-new-with-label "Week starts on monday"))
|
|
|
109 (gtk-signal-connect button 'clicked
|
|
|
110 (lambda (button date)
|
|
|
111 (let ((flags (gnome-date-edit-get-flags date)))
|
|
|
112 (if (gtk-toggle-button-get-active button)
|
|
|
113 (push 'week-starts-on-monday flags)
|
|
|
114 (setq flags (delq 'week-starts-on-monday flags)))
|
|
|
115 (gnome-date-edit-set-flags date flags))) date)
|
|
|
116 (gtk-toggle-button-set-active button t)
|
|
|
117 (gtk-box-pack-start window button nil nil 0)))
|
|
|
118
|
|
|
119 (gtk-define-test
|
|
|
120 "GNOME Font Picker" gnome gnome-font-picker nil
|
|
|
121 (let ((hbox (gtk-hbox-new nil 5))
|
|
|
122 (fp (gnome-font-picker-new))
|
|
|
123 (label (gtk-label-new "Choose a font: "))
|
|
|
124 (button nil))
|
|
|
125 (gtk-box-pack-start hbox label t t 0)
|
|
|
126 (gtk-box-pack-start hbox fp nil nil 2)
|
|
|
127 (gnome-font-picker-set-title fp "Select a font...")
|
|
|
128 (gnome-font-picker-set-mode fp 'font-info)
|
|
|
129 (gtk-box-pack-start window hbox t t 0)
|
|
|
130
|
|
|
131 (setq button (gtk-check-button-new-with-label "Use font in label"))
|
|
|
132 (gtk-signal-connect button 'clicked
|
|
|
133 (lambda (button fp)
|
|
|
134 (gnome-font-picker-fi-set-use-font-in-label
|
|
|
135 fp (gtk-toggle-button-get-active button) 14))
|
|
|
136 fp)
|
|
|
137 (gtk-box-pack-start window button nil nil 0)
|
|
|
138
|
|
|
139 (setq button (gtk-check-button-new-with-label "Show size"))
|
|
|
140 (gtk-signal-connect button 'clicked
|
|
|
141 (lambda (button fp)
|
|
|
142 (gnome-font-picker-fi-set-show-size
|
|
|
143 fp (gtk-toggle-button-get-active button)))
|
|
|
144 fp)
|
|
|
145 (gtk-box-pack-start window button nil nil 0)))
|
|
|
146
|
|
|
147 (gtk-define-test
|
|
|
148 "GNOME Application" gnome gnome-app t
|
|
|
149 (setq window (gnome-app-new "XEmacs" "XEmacs/GNOME"))
|
|
|
150 (let ((menubar (gtk-menu-bar-new))
|
|
|
151 (contents nil)
|
|
|
152 ;(toolbar-instance (specifier-instance top-toolbar))
|
|
|
153 (toolbar nil)
|
|
|
154 (item nil)
|
|
|
155 (flushright nil))
|
|
|
156 (mapc (lambda (node)
|
|
|
157 (if (not node)
|
|
|
158 (setq flushright t)
|
|
|
159 (setq item (gtk-build-xemacs-menu node))
|
|
|
160 (gtk-widget-show item)
|
|
|
161 (if flushright (gtk-menu-item-right-justify item))
|
|
|
162 (gtk-menu-append menubar item)))
|
|
|
163 current-menubar)
|
|
|
164
|
|
|
165 (setq toolbar (gtk-toolbar-new 'horizontal 'both))
|
|
|
166 (mapc (lambda (x)
|
|
|
167 (let ((button (gtk-button-new))
|
|
|
168 (pixmap (gnome-stock-pixmap-widget-new toolbar x)))
|
|
|
169 (gtk-container-add button pixmap)
|
|
|
170 (gtk-toolbar-append-widget toolbar button (symbol-name x) nil)))
|
|
|
171 '(open save print cut copy paste undo spellcheck srchrpl mail help))
|
|
|
172
|
|
|
173 (setq contents (gtk-hbox-new nil 5))
|
|
|
174 (let ((hbox contents)
|
|
|
175 (vbox (gtk-vbox-new nil 5))
|
|
|
176 (frame nil)
|
|
|
177 (label nil))
|
|
|
178 (gtk-box-pack-start hbox vbox nil nil 0)
|
|
|
179
|
|
|
180 (setq frame (gtk-frame-new "Normal Label")
|
|
|
181 label (gtk-label-new "This is a Normal label"))
|
|
|
182 (gtk-container-add frame label)
|
|
|
183 (gtk-box-pack-start vbox frame nil nil 0)
|
|
|
184
|
|
|
185 (setq frame (gtk-frame-new "Multi-line Label")
|
|
|
186 label (gtk-label-new "This is a multi-line label.\nSecond line\nThird line"))
|
|
|
187 (gtk-container-add frame label)
|
|
|
188 (gtk-box-pack-start vbox frame nil nil 0)
|
|
|
189
|
|
|
190 (setq frame (gtk-frame-new "Left Justified Label")
|
|
|
191 label (gtk-label-new "This is a Left-Justified\nMulti-line label.\nThird line"))
|
|
|
192 (gtk-label-set-justify label 'left)
|
|
|
193 (gtk-container-add frame label)
|
|
|
194 (gtk-box-pack-start vbox frame nil nil 0)
|
|
|
195
|
|
|
196 (setq frame (gtk-frame-new "Right Justified Label")
|
|
|
197 label (gtk-label-new "This is a Right-Justified\nMulti-line label.\nFourth line, (j/k)"))
|
|
|
198 (gtk-label-set-justify label 'right)
|
|
|
199 (gtk-container-add frame label)
|
|
|
200 (gtk-box-pack-start vbox frame nil nil 0)
|
|
|
201
|
|
|
202 ;; Start a second row so that we don't make a ridiculously tall window
|
|
|
203 (setq vbox (gtk-vbox-new nil 5))
|
|
|
204 (gtk-box-pack-start hbox vbox nil nil 0)
|
|
|
205
|
|
|
206 (setq frame (gtk-frame-new "Line wrapped label")
|
|
|
207 label (gtk-label-new
|
|
|
208 (concat "This is an example of a line-wrapped label. It should not be taking "
|
|
|
209 "up the entire " ;;; big space to test spacing
|
|
|
210 "width allocated to it, but automatically wraps the words to fit. "
|
|
|
211 "The time has come, for all good men, to come to the aid of their party. "
|
|
|
212 "The sixth sheik's six sheep's sick.\n"
|
|
|
213 " It supports multiple paragraphs correctly, and correctly adds "
|
|
|
214 "many extra spaces. ")))
|
|
|
215 (gtk-label-set-line-wrap label t)
|
|
|
216 (gtk-container-add frame label)
|
|
|
217 (gtk-box-pack-start vbox frame nil nil 0)
|
|
|
218
|
|
|
219 (setq frame (gtk-frame-new "Filled, wrapped label")
|
|
|
220 label (gtk-label-new
|
|
|
221 (concat
|
|
|
222 "This is an example of a line-wrapped, filled label. It should be taking "
|
|
|
223 "up the entire width allocated to it. Here is a seneance to prove "
|
|
|
224 "my point. Here is another sentence. "
|
|
|
225 "Here comes the sun, do de do de do.\n"
|
|
|
226 " This is a new paragraph.\n"
|
|
|
227 " This is another newer, longer, better paragraph. It is coming to an end, "
|
|
|
228 "unfortunately.")))
|
|
|
229 (gtk-label-set-justify label 'fill)
|
|
|
230 (gtk-label-set-line-wrap label t)
|
|
|
231 (gtk-container-add frame label)
|
|
|
232 (gtk-box-pack-start vbox frame nil nil 0)
|
|
|
233
|
|
|
234 (setq frame (gtk-frame-new "Underlined label")
|
|
|
235 label (gtk-label-new (concat "This label is underlined!\n"
|
|
|
236 "This one is underlined in 日本語の入用quite a funky fashion")))
|
|
|
237 (gtk-label-set-justify label 'left)
|
|
|
238 (gtk-label-set-pattern label "_________________________ _ _________ _ _____ _ __ __ ___ ____ _____")
|
|
|
239 (gtk-container-add frame label)
|
|
|
240 (gtk-box-pack-start vbox frame nil nil 0))
|
|
|
241
|
|
|
242 (gtk-widget-show-all toolbar)
|
|
|
243 (gtk-widget-show-all menubar)
|
|
|
244 (gtk-widget-show-all contents)
|
|
|
245 (gnome-app-set-menus window menubar)
|
|
|
246 (gnome-app-set-toolbar window toolbar)
|
|
|
247 (gnome-app-set-contents window contents)))
|
