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