/[gtk-cffi]/gtk-cffi/gtk/builder.lisp
ViewVC logotype

Contents of /gtk-cffi/gtk/builder.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.5 - (show annotations)
Mon Dec 31 13:33:38 2012 UTC (15 months, 2 weeks ago) by rklochkov
Branch: MAIN
CVS Tags: HEAD
Changes since 1.4: +6 -6 lines
Backed to CFFI 10.7 (was version from git)
1 ;;;
2 ;;; builder.lisp -- GtkBuilder
3 ;;;
4 ;;; Copyright (C) 2012, Roman Klochkov <kalimehtar@mail.ru>
5 ;;;
6
7 (in-package :gtk-cffi)
8
9 (defclass builder (g-object) ())
10
11 (defcfun gtk-builder-new :pointer)
12
13 (defmethod gconstructor ((builder builder) &key &allow-other-keys)
14 (gtk-builder-new))
15
16 (defcfun gtk-builder-add-from-file :uint
17 (builder pobject) (filename :string) (g-error :pointer))
18
19 (defcfun gtk-builder-add-from-string :uint
20 (builder pobject) (string :string) (length gsize)
21 (g-error :pointer))
22
23 (defcfun gtk-builder-add-objects-from-file :uint
24 (builder pobject) (filename :string) (object-ids string-list)
25 (g-error :pointer))
26
27 (defcfun gtk-builder-add-objects-from-string :uint
28 (builder pobject) (string :string) (length gsize) (object-ids string-list)
29 (g-error :pointer))
30
31 (defgeneric add-from (builder &key filename string objects)
32 (:method
33 ((builder builder) &key filename string objects)
34 (with-g-error g-error
35 (when
36 (= 0
37 (if filename
38 (if objects
39 (gtk-builder-add-objects-from-file builder filename
40 objects g-error)
41 (gtk-builder-add-from-file builder filename g-error))
42 (if objects
43 (gtk-builder-add-objects-from-string
44 builder string (length string) objects g-error)
45 (gtk-builder-add-from-string
46 builder string (length string) g-error))))
47 (throw-g-error g-error)))))
48
49 (defcfun gtk-builder-connect-signals-full :void
50 (builder pobject) (func pfunction) (user-data :pointer))
51
52 (defcallback cb-find-defun :void ((builder :pointer) (object pobject)
53 (signal-name :string) (handler :string)
54 (connect-object pobject) (flags connect-flags)
55 (user-data :pointer))
56 (declare (ignore builder user-data connect-object))
57 (connect object (eval (read-from-string handler))
58 :signal signal-name
59 :after (not (null (find :after flags)))
60 :swapped (not (null (find :swapped flags)))))
61
62 (defgeneric connect-signals (builder &key func)
63 (:method ((builder builder) &key func)
64 (gtk-builder-connect-signals-full builder
65 (or func (callback cb-find-defun))
66 (null-pointer))))
67
68
69 (deffuns builder
70 (:get object pobject (name :string))
71 (:get objects (g-slist :elt pobject))
72 (:get type-from-name g-type (type-name :string)))
73
74 (defslots builder
75 translation-domain :string)
76
77 (defcfun gtk-builder-value-from-string :boolean
78 (builder pobject) (pspec pobject) (string :string) (value pobject)
79 (g-error :pointer))
80
81 (defcfun gtk-builder-value-from-string-type :boolean
82 (builder pobject) (g-type g-type) (string :string) (value pobject)
83 (g-error :pointer))
84
85 (defgeneric value-from-string (builder &key g-type param-spec string)
86 (:method ((builder builder) &key g-type param-spec string)
87 (let ((value (make-instance 'g-value)))
88 (with-g-error g-error
89 (unless (if param-spec
90 (gtk-builder-value-from-string builder param-spec string
91 value g-error)
92 (gtk-builder-value-from-string-type builder g-type string
93 value g-error))
94 (throw-g-error g-error)))
95 value)))
96
97
98
99
100
101
102

  ViewVC Help
Powered by ViewVC 1.1.5