chiark / gitweb /
~mdw / clg / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
String manually converted to utf8 in CMUCL, and a couple of bug fixes
[clg] / examples / testgtk.lisp
CommitLineData
560af5c5 1;; Common Lisp bindings for GTK+ v2.0
787721b6 2;; Copyright (C) 1999-2005 Espen S. Johnsen <espen@users.sf.net>
560af5c5 3;;
4;; This library is free software; you can redistribute it and/or
5;; modify it under the terms of the GNU Lesser General Public
6;; License as published by the Free Software Foundation; either
7;; version 2 of the License, or (at your option) any later version.
8;;
9;; This library is distributed in the hope that it will be useful,
10;; but WITHOUT ANY WARRANTY; without even the implied warranty of
11;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
12;; Lesser General Public License for more details.
13;;
14;; You should have received a copy of the GNU Lesser General Public
15;; License along with this library; if not, write to the Free Software
16;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
17
d01ac6fc 18;; $Id: testgtk.lisp,v 1.26 2005-04-17 21:52:17 espen Exp $
560af5c5 19
58d925ab 20(defpackage "TESTGTK"
21 (:use "COMMON-LISP" "GTK"))
704a1de4 22
58d925ab 23(in-package "TESTGTK")
704a1de4 24
25(defmacro define-toplevel (name (window title &rest initargs) &body body)
26 `(let ((,window nil))
560af5c5 27 (defun ,name ()
704a1de4 28 (unless ,window
f6ebddea 29 (setq ,window (make-instance 'window :title ,title ,@initargs :show-children t))
704a1de4 30 (signal-connect ,window 'destroy #'(lambda () (setq ,window nil)))
560af5c5 31 ,@body)
32
58d925ab 33 (when ,window
34 (if (not (widget-visible-p ,window))
35 (widget-show ,window)
36 (widget-hide ,window))))))
704a1de4 37
560af5c5 38
704a1de4 39(defmacro define-dialog (name (dialog title &optional (class 'dialog)
40 &rest initargs)
41 &body body)
42 `(let ((,dialog nil))
560af5c5 43 (defun ,name ()
704a1de4 44 (unless ,dialog
f6ebddea 45 (setq ,dialog (make-instance ,class :title ,title ,@initargs :show-children t))
704a1de4 46 (signal-connect ,dialog 'destroy #'(lambda () (setq ,dialog nil)))
47 ,@body)
560af5c5 48
58d925ab 49 (when ,dialog
50 (if (not (widget-visible-p ,dialog))
51 (widget-show ,dialog)
52 (widget-hide ,dialog))))))
560af5c5 53
54
704a1de4 55(defmacro define-simple-dialog (name (dialog title &rest initargs) &body body)
56 `(define-dialog ,name (,dialog ,title 'dialog ,@initargs)
bdc1babf 57 ,@body
58 (dialog-add-button ,dialog "gtk-close" #'widget-destroy :object t)))
560af5c5 59
60
560af5c5 61
62;;; Pixmaps used in some of the tests
63
64(defvar gtk-mini-xpm
196fe1e9 65 #("15 20 17 1"
560af5c5 66 " c None"
67 ". c #14121F"
68 "+ c #278828"
69 "@ c #9B3334"
70 "# c #284C72"
71 "$ c #24692A"
72 "% c #69282E"
73 "& c #37C539"
74 "* c #1D2F4D"
75 "= c #6D7076"
76 "- c #7D8482"
77 "; c #E24A49"
78 "> c #515357"
79 ", c #9B9C9B"
80 "' c #2FA232"
81 ") c #3CE23D"
82 "! c #3B6CCB"
83 " "
84 " ***> "
85 " >.*!!!* "
86 " ***....#*= "
87 " *!*.!!!**!!# "
88 " .!!#*!#*!!!!# "
89 " @%#!.##.*!!$& "
90 " @;%*!*.#!#')) "
91 " @;;@%!!*$&)'' "
92 " @%.%@%$'&)$+' "
93 " @;...@$'*'*)+ "
94 " @;%..@$+*.')$ "
95 " @;%%;;$+..$)# "
96 " @;%%;@$$$'.$# "
97 " %;@@;;$$+))&* "
98 " %;;;@+$&)&* "
99 " %;;@'))+> "
100 " %;@'&# "
101 " >%$$ "
102 " >= "))
103
104(defvar book-closed-xpm
196fe1e9 105 #("16 16 6 1"
560af5c5 106 " c None s None"
107 ". c black"
108 "X c red"
109 "o c yellow"
110 "O c #808080"
111 "# c white"
112 " "
113 " .. "
114 " ..XX. "
115 " ..XXXXX. "
116 " ..XXXXXXXX. "
117 ".ooXXXXXXXXX. "
118 "..ooXXXXXXXXX. "
119 ".X.ooXXXXXXXXX. "
120 ".XX.ooXXXXXX.. "
121 " .XX.ooXXX..#O "
122 " .XX.oo..##OO. "
123 " .XX..##OO.. "
124 " .X.#OO.. "
125 " ..O.. "
126 " .. "
127 " "))
128
129(defvar mini-page-xpm
196fe1e9 130 #("16 16 4 1"
560af5c5 131 " c None s None"
132 ". c black"
133 "X c white"
134 "o c #808080"
135 " "
136 " ....... "
137 " .XXXXX.. "
138 " .XoooX.X. "
139 " .XXXXX.... "
140 " .XooooXoo.o "
141 " .XXXXXXXX.o "
142 " .XooooooX.o "
143 " .XXXXXXXX.o "
144 " .XooooooX.o "
145 " .XXXXXXXX.o "
146 " .XooooooX.o "
147 " .XXXXXXXX.o "
148 " ..........o "
149 " oooooooooo "
150 " "))
151
152(defvar book-open-xpm
196fe1e9 153 #("16 16 4 1"
560af5c5 154 " c None s None"
155 ". c black"
156 "X c #808080"
157 "o c white"
158 " "
159 " .. "
160 " .Xo. ... "
161 " .Xoo. ..oo. "
162 " .Xooo.Xooo... "
163 " .Xooo.oooo.X. "
164 " .Xooo.Xooo.X. "
165 " .Xooo.oooo.X. "
166 " .Xooo.Xooo.X. "
167 " .Xooo.oooo.X. "
168 " .Xoo.Xoo..X. "
169 " .Xo.o..ooX. "
170 " .X..XXXXX. "
171 " ..X....... "
172 " .. "
173 " "))
174
175
176
177;;; Button box
178
196fe1e9 179(defun create-bbox-in-frame (class frame-label spacing width height layout)
704a1de4 180 (declare (ignore width height))
181 (make-instance 'frame
182 :label frame-label
183 :child (make-instance class
184 :border-width 5 :layout-style layout :spacing spacing
977a550d 185 :child (make-instance 'button :stock "gtk-ok")
186 :child (make-instance 'button :stock "gtk-cancel")
187 :child (make-instance 'button :stock "gtk-help"))))
704a1de4 188
189(define-toplevel create-button-box (window "Button Boxes")
190 (make-instance 'v-box
f6ebddea 191 :parent window :border-width 10 :spacing 10
704a1de4 192 :child (make-instance 'frame
193 :label "Horizontal Button Boxes"
194 :child (make-instance 'v-box
195 :border-width 10 :spacing 10
196 :children (mapcar
197 #'(lambda (args)
198 (apply #'create-bbox-in-frame
199 'h-button-box args))
200 '(("Spread" 40 85 20 :spread)
201 ("Edge" 40 85 20 :edge)
202 ("Start" 40 85 20 :start)
203 ("End" 40 85 20 :end)))))
204 :child (make-instance 'frame
205 :label "Vertical Button Boxes"
206 :child (make-instance 'h-box
207 :border-width 10 :spacing 10
208 :children (mapcar
209 #'(lambda (args)
210 (apply #'create-bbox-in-frame
211 'v-button-box args))
212 '(("Spread" 30 85 20 :spread)
213 ("Edge" 30 85 20 :edge)
214 ("Start" 30 85 20 :start)
215 ("End" 30 85 20 :end)))))))
196fe1e9 216
217
218;; Buttons
219
704a1de4 220(define-simple-dialog create-buttons (dialog "Buttons")
196fe1e9 221 (let ((table (make-instance 'table
704a1de4 222 :n-rows 3 :n-columns 3 :homogeneous nil
196fe1e9 223 :row-spacing 5 :column-spacing 5 :border-width 10
704a1de4 224 :parent dialog))
225 (buttons (loop
226 for n from 1 to 10
227 collect (make-instance 'button
228 :label (format nil "button~D" (1+ n))))))
229
196fe1e9 230 (dotimes (column 3)
231 (dotimes (row 3)
704a1de4 232 (let ((button (nth (+ (* 3 row) column) buttons))
233 (button+1 (nth (mod (+ (* 3 row) column 1) 9) buttons)))
196fe1e9 234 (signal-connect button 'clicked
235 #'(lambda ()
236 (if (widget-visible-p button+1)
237 (widget-hide button+1)
238 (widget-show button+1))))
33f468b7 239 (table-attach table button column (1+ column) row (1+ row)
f6ebddea 240 :options '(:expand :fill)))))))
560af5c5 241
242
243;; Calenadar
244
704a1de4 245(define-simple-dialog create-calendar (dialog "Calendar")
246 (make-instance 'v-box
f6ebddea 247 :parent dialog :border-width 10
704a1de4 248 :child (make-instance 'calendar)))
560af5c5 249
250
251;;; Check buttons
252
704a1de4 253(define-simple-dialog create-check-buttons (dialog "Check Buttons")
254 (make-instance 'v-box
f6ebddea 255 :border-width 10 :spacing 10 :parent dialog
704a1de4 256 :children (loop
257 for n from 1 to 3
258 collect (make-instance 'check-button
259 :label (format nil "Button~D" n)))))
560af5c5 260
261
262
263;;; Color selection
264
704a1de4 265(define-dialog create-color-selection (dialog "Color selection dialog"
266 'color-selection-dialog
f6ebddea 267 :allow-grow nil :allow-shrink nil
268 :show-children nil)
269 (with-slots (colorsel) dialog
270 (let ((button (make-instance 'check-button :label "Show Opacity")))
271 (dialog-add-action-widget dialog button
272 #'(lambda ()
273 (setf
274 (color-selection-has-opacity-control-p colorsel)
275 (toggle-button-active-p button)))))
276
277 (let ((button (make-instance 'check-button :label "Show Palette")))
278 (dialog-add-action-widget dialog button
279 #'(lambda ()
280 (setf
281 (color-selection-has-palette-p colorsel)
282 (toggle-button-active-p button)))))
704a1de4 283
284 (signal-connect dialog :ok
285 #'(lambda ()
286 (let ((color (color-selection-current-color colorsel)))
287 (format t "Selected color: ~A~%" color)
288 (setf (color-selection-current-color colorsel) color)
289 (widget-hide dialog))))
560af5c5 290
704a1de4 291 (signal-connect dialog :cancel #'widget-destroy :object t)))
560af5c5 292
560af5c5 293
294;;; Cursors
295
296(defun clamp (n min-val max-val)
297 (declare (number n min-val max-val))
298 (max (min n max-val) min-val))
299
aa9ceddc 300(defun set-cursor (spinner drawing-area label)
301 (let ((cursor
302 (glib:int-enum
303 (logand (clamp (spin-button-value-as-int spinner) 0 152) #xFE)
304 'gdk:cursor-type)))
305 (setf (label-label label) (string-downcase cursor))
306 (setf (widget-cursor drawing-area) cursor)))
307
308(defun cursor-expose (drawing-area event)
309 (declare (ignore event))
310 (multiple-value-bind (width height)
977a550d 311 (widget-get-size-allocation drawing-area)
aa9ceddc 312 (let* ((window (widget-window drawing-area))
313 (style (widget-style drawing-area))
314 (white-gc (style-white-gc style))
315 (gray-gc (style-bg-gc style :normal))
316 (black-gc (style-black-gc style)))
317 (gdk:draw-rectangle window white-gc t 0 0 width (floor height 2))
318 (gdk:draw-rectangle window black-gc t 0 (floor height 2) width
319 (floor height 2))
320 (gdk:draw-rectangle window gray-gc t (floor width 3)
321 (floor height 3) (floor width 3)
322 (floor height 3))))
323 t)
324
325(define-simple-dialog create-cursors (dialog "Cursors")
326 (let ((spinner (make-instance 'spin-button
327 :adjustment (adjustment-new
328 0 0
d01ac6fc 329 (1- (glib:enum-int :last-cursor 'gdk:cursor-type))
aa9ceddc 330 2 10 0)))
331 (drawing-area (make-instance 'drawing-area
332 :width-request 80 :height-request 80
4280ef98 333 :events '(:exposure :button-press)))
aa9ceddc 334 (label (make-instance 'label :label "XXX")))
335
336 (signal-connect drawing-area 'expose-event #'cursor-expose :object t)
337
338 (signal-connect drawing-area 'button-press-event
339 #'(lambda (event)
340 (case (gdk:event-button event)
510fbcc1 341 (1 (spin-button-spin spinner :step-forward))
342 (3 (spin-button-spin spinner :step-backward)))
aa9ceddc 343 t))
560af5c5 344
aa9ceddc 345 (signal-connect drawing-area 'scroll-event
346 #'(lambda (event)
347 (case (gdk:event-direction event)
510fbcc1 348 (:up (spin-button-spin spinner :step-forward))
349 (:down (spin-button-spin spinner :step-backward)))
aa9ceddc 350 t))
560af5c5 351
aa9ceddc 352 (signal-connect spinner 'changed
353 #'(lambda ()
354 (set-cursor spinner drawing-area label)))
560af5c5 355
aa9ceddc 356 (make-instance 'v-box
f6ebddea 357 :parent dialog :border-width 10 :spacing 5
aa9ceddc 358 :child (list
359 (make-instance 'h-box
360 :border-width 5
361 :child (list
362 (make-instance 'label :label "Cursor Value : ")
363 :expand nil)
364 :child spinner)
365 :expand nil)
366 :child (make-instance 'frame
aa9ceddc 367 :label "Cursor Area" :label-xalign 0.5 :border-width 10
368 :child drawing-area)
369 :child (list label :expand nil))
370
371 (widget-realize drawing-area)
372 (set-cursor spinner drawing-area label)))
560af5c5 373
374
375;;; Dialog
376
704a1de4 377(let ((dialog nil))
378 (defun create-dialog ()
379 (unless dialog
380 (setq dialog (make-instance 'dialog
381 :title "Dialog" :default-width 200
382 :button "Toggle"
383 :button (list "gtk-ok" #'widget-destroy :object t)
384 :signal (list 'destroy
385 #'(lambda ()
386 (setq dialog nil)))))
387
388 (let ((label (make-instance 'label
389 :label "Dialog Test" :xpad 10 :ypad 10 :visible t
390 :parent dialog)))
391 (signal-connect dialog "Toggle"
392 #'(lambda ()
393 (if (widget-visible-p label)
394 (widget-hide label)
395 (widget-show label))))))
560af5c5 396
704a1de4 397 (if (widget-visible-p dialog)
398 (widget-hide dialog)
399 (widget-show dialog))))
560af5c5 400
401
402;; Entry
403
704a1de4 404(define-simple-dialog create-entry (dialog "Entry")
405 (let ((main (make-instance 'v-box
406 :border-width 10 :spacing 10 :parent dialog)))
196fe1e9 407
704a1de4 408 (let ((entry (make-instance 'entry :text "hello world" :parent main)))
409 (editable-select-region entry 0 5) ; this has no effect when
410 ; entry is editable
411;; (editable-insert-text entry "great " 6)
412;; (editable-delete-text entry 6 12)
196fe1e9 413
613fb570 414 (let ((combo (make-instance 'combo-box-entry
704a1de4 415 :parent main
613fb570 416 :content '("item0"
417 "item1 item1"
418 "item2 item2 item2"
419 "item3 item3 item3 item3"
420 "item4 item4 item4 item4 item4"
421 "item5 item5 item5 item5 item5 item5"
422 "item6 item6 item6 item6 item6"
423 "item7 item7 item7 item7"
424 "item8 item8 item8"
425 "item9 item9"))))
426 (with-slots (child) combo
427 (setf (editable-text child) "hello world")
428 (editable-select-region child 0)))
704a1de4 429
430 (flet ((create-check-button (label slot)
431 (make-instance 'check-button
432 :label label :active t :parent main
433 :signal (list 'toggled
434 #'(lambda (button)
435 (setf (slot-value entry slot)
436 (toggle-button-active-p button)))
437 :object t))))
438
439 (create-check-button "Editable" 'editable)
440 (create-check-button "Visible" 'visibility)
f6ebddea 441 (create-check-button "Sensitive" 'sensitive)))))
560af5c5 442
560af5c5 443
96b68e83 444;; Expander
445
446(define-simple-dialog create-expander (dialog "Expander" :resizable nil)
447 (make-instance 'v-box
f6ebddea 448 :parent dialog :spacing 5 :border-width 5
96b68e83 449 :child (create-label "Expander demo. Click on the triangle for details.")
450 :child (make-instance 'expander
451 :label "Details"
452 :child (create-label "Details can be shown or hidden."))))
453
560af5c5 454
704a1de4 455;; File chooser dialog
560af5c5 456
704a1de4 457(define-dialog create-file-chooser (dialog "File Chooser" 'file-chooser-dialog)
c5502496 458 (file-chooser-add-filter dialog
459 (make-instance 'file-filter :name "All files" :pattern "*"))
460 (file-chooser-add-filter dialog
461 (make-instance 'file-filter :name "Common Lisp source code"
462 :patterns '("*.lisp" "*.lsp")))
463
704a1de4 464 (dialog-add-button dialog "gtk-cancel" #'widget-destroy :object t)
465 (dialog-add-button dialog "gtk-ok"
466 #'(lambda ()
842e5ffe 467 (if (slot-boundp dialog 'filename)
812dd869 468 (format t "Selected file: ~A~%" (file-chooser-filename dialog))
469 (write-line "No files selected"))
704a1de4 470 (widget-destroy dialog))))
560af5c5 471
472
3f315085 473;; Font selection dialog
474
475(define-toplevel create-font-selection (window "Font Button" :resizable nil)
476 (make-instance 'h-box
477 :parent window :spacing 8 :border-width 8
478 :child (make-instance 'label :label "Pick a font")
479 :child (make-instance 'font-button
480 :use-font t :title "Font Selection Dialog")))
481
560af5c5 482
483;;; Handle box
484
842e5ffe 485(define-toplevel create-handle-box (window "Handle Box Test" :border-width 20)
486 (make-instance 'v-box
487 :parent window
488 :child (create-label "Above")
489 :child (make-instance 'h-separator)
490 :child (make-instance 'h-box
491 :spacing 10
492 :child (list
493 (make-instance 'handle-box
494 :child (create-toolbar window)
495 :signal (list 'child-attached
496 #'(lambda (child)
497 (format t "~A attached~%" child)))
498 :signal (list 'child-detached
499 #'(lambda (child)
500 (format t "~A detached~%" child))))
501 :expand nil :fill :nil))
502 :child (make-instance 'h-separator)
503 :child (create-label "Below")))
704a1de4 504
58d925ab 505
506;;; Icon View
507
508#+gtk2.6
509(let ((file-pixbuf nil)
510 (folder-pixbuf nil))
511 (defun load-pixbufs ()
512 (unless file-pixbuf
513 (handler-case
514 (setf
515 file-pixbuf (gdk:pixbuf-load #p"clg:examples;gnome-fs-regular.png")
516 folder-pixbuf (gdk:pixbuf-load #p"clg:examples;gnome-fs-directory.png"))
517 (glib:glib-error (condition)
518 (make-instance 'message-dialog
519 :message-type :error :visible t
520 :text "<b>Failed to load an image</b>"
521 :secondary-text (glib:gerror-message condition)
522 :signal (list :close #'widget-destroy :object t))
523 (return-from load-pixbufs nil))))
524 t)
525
526 (defun fill-store (store directory)
527 (list-store-clear store)
528 (let ((dir #+cmu(unix:open-dir directory)
529 #+sbcl(sb-posix:opendir directory)))
530 (unwind-protect
531 (loop
532 as filename = #+cmu(unix:read-dir dir)
533 #+sbcl(let ((dirent (sb-posix:readdir dir)))
534 (unless (sb-grovel::foreign-nullp dirent)
535 (sb-posix:dirent-name dirent)))
536 while filename
537 unless (or (equal filename ".") (equal filename ".."))
538 do (let* ((pathname (format nil "~A~A" directory filename))
539 (directory-p
540 #+cmu(eq (unix:unix-file-kind pathname) :directory)
541 #+sbcl(sb-posix:s-isdir (sb-posix:stat-mode (sb-posix:stat pathname)))))
542 (list-store-append store
543 (vector
544 filename
545 (if directory-p folder-pixbuf file-pixbuf)
546 directory-p))))
547 #+cmu(unix:close-dir dir)
548 #+sbcl(sb-posix:closedir dir))))
549
550 (defun sort-func (store a b)
551 (let ((a-dir-p (tree-model-value store a 'directory-p))
552 (b-dir-p (tree-model-value store b 'directory-p))
553 (a-name (tree-model-value store a 'filename))
554 (b-name (tree-model-value store b 'filename)))
555 (cond
556 ((and a-dir-p (not b-dir-p)) :before)
557 ((and (not a-dir-p) b-dir-p) :after)
558 ((string< a-name b-name) :before)
559 ((string> a-name b-name) :after)
560 (t :equal))))
561
562 (defun parent-dir (dir)
563 (let ((end (1+ (position #\/ dir :from-end t :end (1- (length dir))))))
564 (subseq dir 0 end)))
565
566 (define-toplevel create-icon-view (window "Icon View demo"
567 :default-width 650
568 :default-height 400)
569 (if (not (load-pixbufs))
570 (widget-destroy window)
571 (let* ((directory "/")
572 (store (make-instance 'list-store
573 :column-types '(string gdk:pixbuf boolean)
574 :column-names '(filename pixbuf directory-p)))
575 (icon-view (make-instance 'icon-view
576 :model store :selection-mode :multiple
577 :text-column 'filename :pixbuf-column 'pixbuf))
578 (up (make-instance 'tool-button
579 :stock "gtk-go-up" :is-important t :sensitive nil))
580 (home (make-instance 'tool-button
581 :stock "gtk-home" :is-important t)))
582 (tree-sortable-set-sort-func store :default #'sort-func)
583 (tree-sortable-set-sort-column store :default :ascending)
584 (fill-store store directory)
585
586 (signal-connect icon-view 'item-activated
587 #'(lambda (path)
588 (when (tree-model-value store path 'directory-p)
589 (setq directory
590 (concatenate 'string directory (tree-model-value store path 'filename) "/"))
591 (fill-store store directory)
592 (setf (widget-sensitive-p up) t))))
593
594 (signal-connect up 'clicked
595 #'(lambda ()
596 (unless (string= directory "/")
597 (setq directory (parent-dir directory))
598 (fill-store store directory)
599 (setf
600 (widget-sensitive-p home)
601 (not (string= directory (namestring (truename #p"clg:")))))
602 (setf (widget-sensitive-p up) (not (string= directory "/"))))))
603
604 (signal-connect home 'clicked
605 #'(lambda ()
606 (setq directory (namestring (truename #p"clg:")))
607 (fill-store store directory)
608 (setf (widget-sensitive-p up) t)
609 (setf (widget-sensitive-p home) nil)))
610
611 (make-instance 'v-box
612 :parent window
613 :child (list
614 (make-instance 'toolbar :child up :child home)
615 :fill nil :expand nil)
616 :child (make-instance 'scrolled-window
617 :shadow-type :etched-in :policy :automatic
618 :child icon-view))))))
619
620
704a1de4 621;;; Image
560af5c5 622
40a3dac5 623(define-toplevel create-image (window "Image" :resizable nil)
704a1de4 624 (make-instance 'image :file #p"clg:examples;gtk.png" :parent window))
560af5c5 625
626
627;;; Labels
628
704a1de4 629(define-toplevel create-labels (window "Labels" :border-width 5 :resizable nil)
196fe1e9 630 (flet ((create-label-in-frame (frame-label label-text &rest args)
631 (list
632 (make-instance 'frame
633 :label frame-label
704a1de4 634 :child (apply #'make-instance 'label :label label-text :xpad 5 :ypad 5 args))
196fe1e9 635 :fill nil :expand nil)))
704a1de4 636 (make-instance 'h-box
637 :spacing 5 :parent window
638 :child-args '(:fill nil :expand nil)
639 :child (make-instance 'v-box
640 :spacing 5
641 :child (create-label-in-frame "Normal Label" "This is a Normal label")
642 :child (create-label-in-frame "Multi-line Label"
560af5c5 643"This is a Multi-line label.
644Second line
196fe1e9 645Third line")
704a1de4 646 :child (create-label-in-frame "Left Justified Label"
560af5c5 647"This is a Left-Justified
648Multi-line.
196fe1e9 649Third line"
704a1de4 650 :justify :left)
651 :child (create-label-in-frame "Right Justified Label"
560af5c5 652"This is a Right-Justified
653Multi-line.
196fe1e9 654Third line"
704a1de4 655 :justify :right))
656 :child (make-instance 'v-box
657 :spacing 5
658 :child (create-label-in-frame "Line wrapped label"
560af5c5 659"This is an example of a line-wrapped label. It should not be taking up the entire width allocated to it, but automatically wraps the words to fit. The time has come, for all good men, to come to the aid of their party. The sixth sheik's six sheep's sick.
196fe1e9 660 It supports multiple paragraphs correctly, and correctly adds many extra spaces. "
704a1de4 661 :wrap t)
662
663 :child (create-label-in-frame "Filled, wrapped label"
560af5c5 664"This is an example of a line-wrapped, filled label. It should be taking up the entire width allocated to it. Here is a seneance to prove my point. Here is another sentence. Here comes the sun, do de do de do.
665 This is a new paragraph.
196fe1e9 666 This is another newer, longer, better paragraph. It is coming to an end, unfortunately."
704a1de4 667 :justify :fill :wrap t)
668
669 :child (create-label-in-frame "Underlined label"
d01ac6fc 670(#+cmu glib:latin1-to-unicode #+sbcl identity
560af5c5 671"This label is underlined!
d01ac6fc 672