/[gtk-cffi]/gtk-cffi/examples/ex8.lisp
ViewVC logotype

Contents of /gtk-cffi/examples/ex8.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.3 - (show annotations)
Mon May 7 09:02:03 2012 UTC (23 months, 1 week ago) by rklochkov
Branch: MAIN
CVS Tags: HEAD
Changes since 1.2: +2 -2 lines
Added with-progress in extensions
Added GtkOrientable, GtkRange, GtkBuildable, & Cairo support in gdk (see examples/ex6)
Fixed all examples.
1 ;;; Converted from http://dmitry-vk.livejournal.com/
2
3 (asdf:oos 'asdf:load-op :gtk-cffi)
4 (asdf:oos 'asdf:load-op :closer-mop)
5
6 (defpackage #:test8
7 (:use #:common-lisp #:gtk-cffi #:g-object-cffi))
8 (in-package #:test8)
9
10 (defun main ()
11 (gtk-init)
12 (let* ((slots-model (make-instance 'list-store :columns '(:string)))
13 (window
14 (gtk-model
15 'window :width 400 :height 600
16 :title "Class browser"
17 :win-position :center
18 :signals '(:destroy :gtk-main-quit)
19 ('v-box
20 :expand nil
21 ('h-box
22 ('entry :id :search)
23 ('button :label "Search"
24 :signals
25 (list :clicked
26 (labels ((display-class-slots (class)
27 (format t "Displaying ~A~%" class)
28 (clear slots-model)
29 (closer-mop:finalize-inheritance class)
30 (loop
31 for slot in (closer-mop:class-slots class)
32 do (append-values slots-model
33 (list
34 (format nil "~S"
35 (closer-mop:slot-definition-name
36 slot)))))))
37 (lambda (button)
38 (declare (ignore button))
39 (let* ((class-name
40 (read-from-string
41 (text (object-by-id :search))))
42 (class (find-class class-name)))
43 (display-class-slots class)))))))
44 :expand t
45 ('scrolled-window
46 ('tree-view :model slots-model
47 :columns '("Slot name")))))))
48 (show window))
49 (gtk-main))
50
51 (main)

  ViewVC Help
Powered by ViewVC 1.1.5