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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.3 - (show annotations)
Sun Oct 7 12:02:10 2012 UTC (18 months, 2 weeks ago) by rklochkov
Branch: MAIN
CVS Tags: HEAD
Changes since 1.2: +3 -3 lines
Fixed examples. Changed cell properties for tree-column to be set as :attributes
Fixed double init in g-value.
1 (asdf:oos 'asdf:load-op :gtk-cffi)
2
3 (defpackage #:test-ex1
4 (:use #:common-lisp #:gtk-cffi #:g-object-cffi #:cffi))
5 (in-package #:test-ex1)
6
7 (cffi:defcallback hello :void ((widget pobject) (data pdata))
8 (format t "Превед ~a from ~a~%" data widget))
9
10 (gtk-init)
11
12 (defvar window)
13 (defvar button)
14
15 (setf window (make-instance 'window :name "Example 1"))
16
17 ;(setf (bg-pixmap window) "/usr/share/pixmaps/gqview.png")
18
19 ;(setf (property window :resize-mode) :immediate)
20
21 (setf (gsignal window "delete-event")
22 (let ((i 0))
23 (lambda (widget event)
24 (format t "delete event ~a~%" (incf i))
25 (format t "~& widget = ~a ~a~%" widget (name widget))
26 (format t "~& event = ~a~%" event)
27 (format t "~& child = ~a~%" (child widget))
28 ;(gobject-cffi::show-properties widget)
29 t)))
30
31 (setf (gsignal window :destroy) :gtk-main-quit)
32
33
34 ;(setf (border-width window) 25)
35
36 ;(setf (default-size window) '(400 100))
37
38 ;(setf button (make-instance 'button :label "gtk-ok" :type :stock))
39
40 (setf button (make-instance 'button :pointer (gtk-cffi::gtk-button-new-from-stock "gtk-ok")))
41
42 (setf (color button :type :bg) "red")
43
44 (setf (color button) "#0000ff")
45 (setf (font button) "Times New Roman Italic 24")
46
47 (setf (gsignal button :clicked :data "Медвед") (cffi:callback hello)
48 (gsignal button "clicked" :data window :swapped t) "gtk-widget-destroy")
49
50
51 (add window button)
52
53 (show button)
54
55 (show window)
56
57 (gtk-main)
58

  ViewVC Help
Powered by ViewVC 1.1.5