1;; guile-gnome
2;; Copyright (C) 2005 Andread Rottmann <rotty at debian dot org>
3;; Copyright (C) 2003,2004 Andy Wingo <wingo at pobox dot com>
4
5;; This program is free software; you can redistribute it and/or
6;; modify it under the terms of the GNU General Public License as
7;; published by the Free Software Foundation; either version 2 of
8;; the License, or (at your option) any later version.
9;;
10;; This program is distributed in the hope that it will be useful,
11;; but WITHOUT ANY WARRANTY; without even the implied warranty of
12;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13;; GNU General Public License for more details.
14;;
15;; You should have received a copy of the GNU General Public License
16;; along with this program; if not, contact:
17;;
18;; Free Software Foundation           Voice:  +1-617-542-5942
19;; 59 Temple Place - Suite 330        Fax:    +1-617-542-2652
20;; Boston, MA  02111-1307,  USA       gnu@gnu.org
21
22;;; Commentary:
23;;
24;;g-wrap specification for GDK.
25;;
26;;; Code:
27
28(define-module (gnome gw gdk-spec)
29  #:use-module (oop goops)
30  #:use-module (ice-9 optargs)
31  #:use-module (gnome gw support g-wrap)
32  #:use-module (gnome gw cairo-spec)
33  #:use-module (gnome gw pango-spec)
34  #:use-module (gnome gw support gobject)
35  #:use-module (gnome gw support defs))
36
37(define-class <gdk-wrapset> (<gobject-wrapset-base>)
38  #:id 'gnome-gdk
39  #:dependencies '(standard gnome-glib gnome-gobject gnome-cairo gnome-pango))
40
41(define-method (global-declarations-cg (self <gdk-wrapset>))
42  (list
43   (next-method)
44   "#include <gdk-pixbuf/gdk-pixbuf.h>\n"
45   "#include \"gdk-pixbuf-support.h\"\n"
46   "#include <gdk/gdk.h>\n"
47   "#include \"gdk-support.h\"\n"))
48
49(define-method (initializations-cg (self <gdk-wrapset>) err)
50  (list (next-method)
51        "if (!gdk_init_check (NULL, NULL))\n"
52        "  scm_misc_error (\"gdk-init\","
53        "                  \"GDK failed to initialize; is $DISPLAY set correctly?\","
54        "                  SCM_EOL);\n"
55        ))
56
57(define-class <gdk-event-type> (<gobject-classed-pointer-type>))
58
59(define-method (initialize (type <gdk-event-type>) initargs)
60  (next-method type (cons #:gtype-id (cons "GDK_TYPE_EVENT" initargs))))
61
62(define-method (unwrap-value-cg (type <gdk-event-type>)
63                                (value <gw-value>)
64                                status-var)
65  (let ((c-var (var value))
66        (scm-var (scm-var value)))
67    (unwrap-null-checked
68     value status-var
69     (list
70      "if (scm_c_gvalue_holds (" scm-var ", GDK_TYPE_EVENT))\n"
71      "  " c-var " = scm_c_gvalue_peek_boxed (" scm-var ");\n"
72      "else {\n"
73      "  " c-var " = NULL;\n"
74      `(gw:error ,status-var type ,(wrapped-var value))
75      "}\n"))))
76
77(define-method (wrap-value-cg (type <gdk-event-type>)
78                              (value <gw-value>)
79                              status-var)
80  (let ((c-var (var value))
81        (scm-var (scm-var value)))
82    (list
83     "if (" c-var " == NULL) {\n"
84     "  " scm-var " = SCM_BOOL_F;\n"
85     "} else {\n"
86     "  " scm-var " = scm_c_gvalue_new_from_boxed (GDK_TYPE_EVENT, " c-var ");\n"
87     "}\n")))
88
89(define-method (initialize (ws <gdk-wrapset>) initargs)
90  (next-method ws (cons #:module (cons '(gnome gw gdk) initargs)))
91
92  (add-type-alias! ws "GdkWChar" 'unsigned-int32)
93
94  (for-each
95   (lambda (ctype)
96     (let ((event (make <gdk-event-type>
97                    #:ctype ctype
98                    #:c-type-name (string-append ctype "*"))))
99       (add-type! ws event)
100       (add-type-alias! ws (string-append ctype "*") (name event))))
101   '("GdkEventAny"
102     "GdkEventKey"
103     "GdkEventButton"
104     "GdkEventScroll"
105     "GdkEventMotion"
106     "GdkEventExpose"
107     "GdkEventVisibility"
108     "GdkEventCrossing"
109     "GdkEventFocus"
110     "GdkEventConfigure"
111     "GdkEventProperty"
112     "GdkEventSelection"
113     "GdkEventDND"
114     "GdkEventProximity"
115     "GdkEventClient"
116     "GdkEventNoExpose"
117     "GdkEventWindowState"
118     "GdkEventSetting"))
119
120  ;; a hack now -- dunno what to do with this...
121  (add-type-alias! ws "GdkNativeWindow" 'unsigned-long)
122
123  (wrap-custom-boxed!
124   "GdkRectangle" "GDK_TYPE_RECTANGLE"
125   ;; wrap
126   (list scm-var " = " c-var " ? scm_gdk_rectangle_to_scm (" c-var ") : SCM_BOOL_F;\n")
127   ;; unwrap
128   (list c-var " = scm_scm_to_gdk_rectangle (" scm-var ");\n"))
129
130  (wrap-custom-boxed!
131   "GdkColor" "GDK_TYPE_COLOR"
132   ;; wrap
133   (list scm-var " = " c-var " ? scm_gdk_color_to_scm (" c-var ") : SCM_BOOL_F;\n")
134   ;; unwrap
135   (list c-var " = scm_scm_to_gdk_color (" scm-var ");\n"))
136
137  (wrap-opaque-pointer! ws "GdkPixbufFormat*")
138  (wrap-opaque-pointer! ws "GdkAtom")
139  (add-type-rule! ws "GdkAtom*" '(<gdk-atom> out))
140  (wrap-freeable-pointer! ws "GdkRegion" "gdk_region_destroy")
141
142  (wrap-instance! ws #:ctype "GdkDrawable" #:gtype-id "GDK_TYPE_DRAWABLE")
143  (add-type-alias! ws "GdkDrawable*" '<gdk-drawable>)
144  (add-type-alias! ws "GdkBitmap*" '<gdk-drawable>)
145
146  (load-defs-with-overrides ws "gnome/defs/gdk-pixbuf.defs")
147  (load-defs-with-overrides ws "gnome/defs/gdk.defs"))
148